Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
screen 0 drawing
#1
working on a" drawing" program for screen mode 0.  There's no mixed-mode hijinks here it's just a simple means to draw screen-0 text based "graphics" with a mouse. This is a really early version and is a tool for another program so it's development is going to very much be a work in progress.  
I just thought it would to be fun to share so people could see how a program evolves when I don't plan it (in this case because it's really just a tool to make images for another program).

Nothing images get saved yet.
Code: (Select All)
'textdrawing..... very very early version
'by James D. Jarvis
'
'screen mode 0 graphics drawing
'this is ugly and incomplete but I flet it woudl be fun to share inprogress

'let's use a screen larger that text mode usually is to have room to draw an image and have some controls on a screen
Screen _NewImage(140, 40, 0)

Type texteltype
    char As String * 1
    fc As Integer
    bc As Integer
End Type


Dim Shared fklr, bklr
Dim Shared px, py, pup$, pdown$
Dim Shared cpos(255, 2)
Dim Shared maxtx, maxty


'maximum text x and maximum text y for the text graphics image
'hardcoded for now, eventually going be a user enetered value

maxtx = 32
maxty = 24


Dim Shared grid(maxtx, maxty, 3)
Dim Shared tgraphic(maxtx, maxty) As texteltype
Dim Shared traw$

'traw$ is just a test value for now as I experiment with ways to convert from string to image
'tgraphic stores the text graphic while in progress
traw$ = ""
traw$ = traw$ + Chr$(32 + xaxtx)
traw$ = traw$ + Chr$(32 + xaxty)
For x = 1 To maxtx
    For y = 1 To maxty
        tgraphic(x, y).char = " "
        tgraphic(x, y).fc = 0
        tgraphic(x, y).bc = 0
        traw$ = traw$ + tgraphic(x, y).char + Chr$(32) + Chr$(32)
    Next
Next


_ControlChr Off ' i want to be able to show those unprintables

'this builds a reference array for the characters beign draw so they can be selected by a mouse click
' and gets the charctaers drawn
cx = 131: cy = 5
For c = 1 To 255
    _Limit 512
    _PrintString (cx, cy), Chr$(c)
    cpos(c, 1) = cx
    cpos(c, 2) = cy
    cx = cx + 1
    If cx > 140 Then
        cx = 131
        cy = cy + 1

    End If
Next c

For x = 1 To maxtx
    For y = 1 To maxty
        grid(x, y, 1) = x
        grid(x, y, 2) = y + 5
    Next
Next
pdown$ = "yes" 'hmmmm.... not using this yet
px = 1: py = 1

pno = 34
pchar$ = Chr$(pno)
fklr = 15: bklr = 0

Do
    _Limit 60
    kk$ = InKey$
    Locate 2, 2
    Print px; ";"; py
    Color fklr, 0
    Locate 3, 3
    Print Chr$(219)
    Color bklr, bklr
    Locate 3, 5
    Print Chr$(219)
    Color 15, 0
    Locate 3, 7
    Print Chr$(pno)


    Do While _MouseInput
        x = _MouseX
        y = _MouseY
        'check for the mouse pointer in the image drawign area
        If x > 0 And x < maxtx + 1 And y > 5 And y < maxty + 5 Then
            If _MouseButton(1) Then
                Color fklr, bklr
                _PrintString (x, y), pchar$
                Color 15, 0
                tgraphic(x, y - 4).fc = fklr
                tgraphic(x, y - 4).bc = bklr
                tgraphic(x, y - 4).char = pchar$
            End If
        End If
        'check to see which charcter is clicked in the charcter selection area
        If x > 130 And x < 141 And y > 0 And y < 41 Then
            If _MouseButton(1) Then
                For cc = 1 To 255
                    If x = cpos(cc, 1) And y = cpos(cc, 2) Then
                        'refresh   the character selection display so the one selected is highlighted by blinking
                        For c = 1 To 255
                            _Limit 4000
                            _PrintString (cpos(c, 1), cpos(c, 2)), Chr$(c)
                        Next c
                        pno = cc
                        pchar$ = Chr$(pno)
                        Color 31, 8
                        _PrintString (x, y), pchar$
                        Color 15, 0
                    End If
                Next cc
            End If
        End If

    Loop

    Locate 1, 1: Print x, y
    'started to code drawign with the numerical keypad but the mosue really is better
    Select Case kk$
        Case "1", "!"

        Case "2", "@"
            If py < 8 Then py = py + 1
        Case "3", "#"
        Case "4", "$"
            If px > 1 Then px = px - 1
        Case "5", "%", " "
        Case "6", "^"
            If px < 8 Then px = px + 1
        Case "7", "&"
        Case "8", "*"
            If py > 1 Then py = py - 1
        Case "9", "("
        Case "u", "U"
        Case "d", "D"
        Case "c", "C" 'change the character
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            pno = pno + 1
            If pno > 255 Then pno = 1
            pchar$ = Chr$(pno)
            Color 31, 8
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            Color 15, 0

        Case "b", "B" 'change the background color
            bklr = bklr + 1
            If bklr > 15 Then bklr = 0
        Case "f", "F" 'change the foreground color
            fklr = fklr + 1
            If fklr > 31 Then fklr = 0
        Case " "

    End Select
    If kk$ >= "1" And kk$ <= "9" Or kk$ = " " Then
        Locate grid(px, py, 2), grid(px, py, 1)
        Color fklr, bklr
        Print pchar$
        Color 15, 0
    End If


Loop Until kk$ = Chr$(27)


traw$ = tgraphictostring$


'this secetion of code is just to see how the different subs are working, nothing good but it is a great example of
' how i code when i don't plan, constantly writing diagonostic routines to see if I'm hadnling things like i think I am
Color 15, 0
Cls
Locate 1, 1
Print traw$
Print "bye"

draw_tgraphic 10, 10
draw_tgraphic 30, 10

Function tgraphictostring$
    'not so keen on this yet
    tt$ = ""
    tt$ = tt$ + Chr$(32 + xaxtx)
    tt$ = tt$ + Chr$(32 + xaxty)
    For x = 1 To maxtx
        For y = 1 To maxty
            tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).fc)
        Next
    Next
    tgraphictostring$ = tt$
End Function

Function texttotgraphic (tt$)
    Print tt$
    maxtx = Asc(Mid$(tt$, 1, 1)) - 32
    maxty = Asc(Mid$(tt$, 2, 1)) - 32
    tsize = (maxtx * maxtx)
    x = 0: y = 1
    For c = 1 To tsize
        cc = c * 3
        x = x + 1
        If x > maxtx Then
            x = 1
            y = y + 1
        End If
        tgraphic(x, y).char = Mid$(tt$, cc, 1)
        tgraphic(x, y).fc = Asc(Mid$(tt$, cc + 1, 1)) - 32
        tgraphic(x, y).bc = Asc(Mid$(tt$, cc + 2, 1)) - 32
        Print tgraphic(x, y).char;
    Next c

End Function
Sub draw_tgraphic (XX, YY)
    'this works.... I think
    For x = 1 To maxtx
        For y = 1 To maxty
            Color tgraphic(x, y).fc, tgraphic(x, y).bc
            _PrintString (XX - 1 + x, YY - 1 + y), tgraphic(x, y).char
        Next
    Next
    Color 15, 0
End Sub
Reply
#2
How's your program coming along?

I didn't know "_PRINTSTRING" worked in "SCREEN 0" but it might be a bit of a hassle. I was going to ask you to check out my program "DRAW2004" but that was originally done in M$QB which is almost a totally new realm. Exclamation

Programming for proper mouse input could be PITA. Once I tried to fix B+ "lights on" program I think it was, changed it so it accepted mouse input but it was a real battle. The great problem is when there is an area of the program window that must accept the input, and the user holds one of the mouse buttons while dragging the cursor to outside that area. Kept fixing it and encountered another problem of retriggering left button which is very annoying in a game.

Maybe for a screen-drawing program, retriggering isn't too bad but what if you desired to put a toolbar somewhere on the screen? I've actually attempted it. I have a program that works acceptably but don't use it much because of this problem registering the mouse events.

If "SCREEN 0" weren't so fussy I would recommend a way to create glyphs with "PSET", because sometimes this programming system doesn't display glyphs for ASCII codes below 32 and for many unicodes. On Linux I desired very much to capture some characters for video games, that I found in "gucharmap" program. Most of them don't display and "_MAPUNICODE" doesn't work properly in graphics mode or not.
Reply
#3
As I recall, in Screen 0, or no Screen specified, all the x, y's are character cells columns and rows including mouse coordinates and _PrintString too? (Maybe not that one??) Pete's the expert on (Screen) Nothing LOL!

A quick experiment to confirm?

Yes! It's all in Char Cell "Locates"
Code: (Select All)
Do

    While _MouseInput: Wend ' poll mouse
    If _MouseButton(1) Then
        _Delay .2
        _PrintString (_MouseX, _MouseY), Str$(_MouseX) + "," + Str$(_MouseY)
    End If
Loop Until Len(InKey$)

Everything you do with pixels, just reimagine as char cells. And if you are a simple person you will love all the color choices! ;-))
b = b + ...
Reply
#4
Here's the latest screen 0 version of the program. 

Code: (Select All)
'textdrawing..... still very early version
'by James D. Jarvis
'
'screen mode 0 graphics drawing
'this is ugly and incomplete but I flet it woudl be fun to share inprogress

'let's use a screen larger than standard text mode usually is to have room to draw an image and have some controls on a screen
Screen _NewImage(140, 40, 0)

Type texteltype
    char As String * 1
    fc As Integer
    bc As Integer
End Type


Dim Shared fklr, bklr
Dim Shared px, py, pup$, pdown$, showbar$
Dim Shared cpos(255, 2), bkpick(15, 2)
Dim Shared maxtx, maxty

'maximum text x and maximum text y for the text graphics image
'hardcoded for now, eventually going be a user enetered value
maxtx = 64
maxty = 24

Dim Shared grid(maxtx, maxty, 3)
Dim Shared tgraphic(maxtx, maxty) As texteltype
Dim Shared traw$


'traw$ is just a test value for now as I experiment with ways to convert from string to image
'tgraphic stores the text graphic while in progress
traw$ = ""
traw$ = traw$ + Chr$(32 + xaxtx)
traw$ = traw$ + Chr$(32 + xaxty)
For x = 1 To maxtx
    For y = 1 To maxty
        tgraphic(x, y).char = " "
        tgraphic(x, y).fc = 0
        tgraphic(x, y).bc = 0
        traw$ = traw$ + tgraphic(x, y).char + Chr$(32) + Chr$(32)
    Next
Next

_ControlChr Off ' i want to be able to show those unprintables

'this builds a reference array for the characters being drawn so they can be selected by a mouse click
' and gets theselectiongrid drawn in the first palce
cx = 131: cy = 5
For c = 1 To 255
    _Limit 512
    _PrintString (cx, cy), Chr$(c)
    cpos(c, 1) = cx
    cpos(c, 2) = cy
    cx = cx + 1
    If cx > 140 Then
        cx = 131
        cy = cy + 1
    End If
Next c
For b = 0 To 15
    bkpick(b, 2) = 3
    bkpick(b, 1) = b + 100
    Color b
    _PrintString (bkpick(b, 1), bkpick(b, 2)), Chr$(219)
Next b
Color 15
For x = 1 To maxtx
    For y = 1 To maxty
        grid(x, y, 1) = x
        grid(x, y, 2) = y + 5
    Next
Next
pdown$ = "yes" 'hmmmm.... not using this yet
px = 1: py = 1

pno = 34
pchar$ = Chr$(pno)
fklr = 15: bklr = 0
showbar$ = "yes"
draw_xbar
draw_ybar

Do
    _Limit 60
    kk$ = InKey$
    Locate 2, 2
    Print px; ";"; py
    Color fklr, 0
    Locate 3, 3
    Print Chr$(219)
    Color bklr, bklr
    Locate 3, 5
    Print Chr$(219)
    Color 15, 0
    Locate 3, 7
    Print Chr$(pno)


    Do While _MouseInput
        x = _MouseX
        y = _MouseY
        'check for the mouse pointer in the image drawing area
        If x > 0 And x <= maxtx And y > 5 And y <= maxty + 5 Then
            If _MouseButton(1) Then
                Color fklr, bklr
                _PrintString (x, y), pchar$
                Color 15, 0
                tgraphic(x, y - 5).fc = fklr
                tgraphic(x, y - 5).bc = bklr
                tgraphic(x, y - 5).char = pchar$
                px = x
                py = y - 4
            End If
        End If
        'check to see which character is clicked in the character selection area or the background colorbar
        If x > 100 And x < 116 And y = 3 Then
            If _MouseButton(1) Then
                For b = 0 To 15
                    If x = bkpick(b, 1) Then
                        bklr = b
                    End If
                Next b
            End If
        End If
        If x > 130 And x < 141 And y > 0 And y < 41 Then
            If _MouseButton(1) Then
                For cc = 1 To 255
                    If x = cpos(cc, 1) And y = cpos(cc, 2) Then
                        'refresh   the character selection display so the one selected is highlighted by blinking
                        For c = 1 To 255
                            _Limit 4000
                            _PrintString (cpos(c, 1), cpos(c, 2)), Chr$(c)
                        Next c
                        pno = cc
                        pchar$ = Chr$(pno)
                        Color 31, 8
                        _PrintString (x, y), pchar$
                        Color 15, 0
                    End If
                Next cc
            End If
        End If

    Loop

    Locate 1, 1: Print x, y
    ' drawing with the numerical keypad is possible but the mouse really is better
    Select Case kk$
        Case "1", "!"
            If py < maxty Then py = py + 1
            If px > 1 Then px = px - 1

        Case "2", "@"
            If py < maxty Then py = py + 1
        Case "3", "#"
            If py < maxty Then py = py + 1
            If px > 1 Then px = px + 1

        Case "4", "$"
            If px > 1 Then px = px - 1
        Case "5", "%", " "
        Case "6", "^"
            If px < maxtx Then px = px + 1
        Case "7", "&"
            If py > 1 Then py = py - 1
            If px > 1 Then px = px - 1

        Case "8", "*"
            If py > 1 Then py = py - 1
        Case "9", "("
            If py > 1 Then py = py - 1
            If px < maxtx Then px = px + 1
        Case "u", "U"
        Case "d", "D"
        Case "c", "C" 'change the character
            'this just cycles through the character code
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            pno = pno + 1
            If pno > 255 Then pno = 1
            pchar$ = Chr$(pno)
            Color 31, 8
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            Color 15, 0

        Case "b", "B" 'change the background color
            bklr = bklr + 1
            If bklr > 15 Then bklr = 0
        Case "f", "F" 'change the foreground color
            fklr = fklr + 1
            If fklr > 31 Then fklr = 0
        Case " "
        Case "\" 'sizebar on and off
            If showbar$ = "yes" Then
                showbar$ = "no"
            Else
                showbar$ = "yes"
            End If
            draw_xbar
            draw_ybar
    End Select
    If kk$ >= "1" And kk$ <= "9" Or kk$ = " " Then
        Locate grid(px, py, 2), grid(px, py, 1)
        Color fklr, bklr
        Print pchar$
        Color 15, 0
    End If


Loop Until kk$ = Chr$(27)


traw$ = tgraphictostring$


'this secetion of code is just to see how the different subs are working, nothing good but it is a great example of
' how i code when i don't plan, constantly writing diagonostic routines to see if I'm hadnling things like i think I am
Color 15, 0
Cls
Locate 1, 1
Print traw$
Print "bye"

draw_tgraphic 10, 10
draw_tgraphic 30, 10

Function tgraphictostring$
    'not so keen on this yet
    tt$ = ""
    tt$ = tt$ + Chr$(32 + xaxtx)
    tt$ = tt$ + Chr$(32 + xaxty)
    For x = 1 To maxtx
        For y = 1 To maxty
            tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).fc)
        Next
    Next
    tgraphictostring$ = tt$
End Function

Function texttotgraphic (tt$)
    Print tt$
    maxtx = Asc(Mid$(tt$, 1, 1)) - 32
    maxty = Asc(Mid$(tt$, 2, 1)) - 32
    tsize = (maxtx * maxtx)
    x = 0: y = 1
    For c = 1 To tsize
        cc = c * 3
        x = x + 1
        If x > maxtx Then
            x = 1
            y = y + 1
        End If
        tgraphic(x, y).char = Mid$(tt$, cc, 1)
        tgraphic(x, y).fc = Asc(Mid$(tt$, cc + 1, 1)) - 32
        tgraphic(x, y).bc = Asc(Mid$(tt$, cc + 2, 1)) - 32
        Print tgraphic(x, y).char;
    Next c

End Function

Sub draw_xbar
    xby = 5
    Locate 5, 1
    For xbx = 1 To maxtx
        If xbx Mod 2 = 0 Then

            If showbar$ = "yes" Then
                _PrintString (xbx, xby), "-"
            Else
                _PrintString (xbx, xby), " "
            End If

        Else
            If showbar$ = "yes" Then
                _PrintString (xbx, xby), "+"
            Else
                _PrintString (xbx, xby), " "
            End If

        End If
    Next
End Sub
Sub draw_ybar
    xbx = maxtx + 1

    For xby = 1 To maxty
        If xby Mod 2 = 0 Then
            If showbar$ = "yes" Then
                _PrintString (xbx, xby + 5), "-"
            Else
                _PrintString (xbx, xby + 5), " "
            End If

        Else
            Locate 5 + b, maxtx + 1
            If showbar$ = "yes" Then
                _PrintString (xbx, xby + 5), "+"
            Else
                _PrintString (xbx, xby + 5), " "
            End If

        End If
    Next
End Sub

Sub draw_tgraphic (XX, YY)
    'this works.... I think
    For x = 1 To maxtx
        For y = 1 To maxty
            Color tgraphic(x, y).fc, tgraphic(x, y).bc
            _PrintString (XX - 1 + x, YY - 1 + y), tgraphic(x, y).char
        Next
    Next
    Color 15, 0
End Sub
Reply
#5
here's the 256 color CMYK version that technically isn't really screen mode 0. There's some expanded functionality in here that will be wrapped into the original program eventually.

Code: (Select All)
'256 color CMYK version of  textdrawing still early in development
'by James D. Jarvis
'
'text graphics drawing
'this is ugly and incomplete but I felt it woudl be fun to share inprogress

'let's use a screen larger than standard text mode usually is to have room to draw an image and have some controls on a screen

' when you esc to quit a bunch of noise shows up on the program for now, don't worry about that now... I'm not.
Screen _NewImage(1140, 600, 256)

Type texteltype
    char As String * 1
    fc As Integer
    bc As Integer
End Type


Dim Shared fklr, bklr
Dim Shared px, py, pup$, pdown$, showbar$, pmode, themode$(4)
Dim Shared cpos(255, 2), bkpick(255, 2)
Dim Shared maxtx, maxty
Dim tchar, tfc, tbc
'added feature in this version
'setup drawing modes
themode$(1) = "all" 'all charcteristic of painted cell will change
themode$(2) = "colorfg" 'only foreground color will change
themode$(3) = "colorbg" 'only background colot will change
themode$(4) = "only CHR" 'onlt character will change
'maximum text x and maximum text y for the text graphics image
'hardcoded for now, eventually going be a user enetered value
maxtx = 64
maxty = 24

Dim Shared grid(maxtx, maxty, 3)
Dim Shared tgraphic(maxtx, maxty) As texteltype
Dim Shared traw$


'traw$ is just a test value for now as I experiment with ways to convert from string to image
'tgraphic stores the text graphic while in progress
traw$ = ""
traw$ = traw$ + Chr$(32 + xaxtx)
traw$ = traw$ + Chr$(32 + xaxty)
For x = 1 To maxtx
    For y = 1 To maxty
        tgraphic(x, y).char = " "
        tgraphic(x, y).fc = 0
        tgraphic(x, y).bc = 0
        traw$ = traw$ + tgraphic(x, y).char + Chr$(32) + Chr$(32)
    Next
Next

_ControlChr Off ' i want to be able to show those unprintables

'this builds a reference array for the characters being drawn so they can be selected by a mouse click
' and gets theselectiongrid drawn in the first palce
cx = 131: cy = 5
For c = 1 To 255
    _Limit 512
    _PrintString (cx * 8 - 7, cy * 16 - 15), Chr$(c)
    cpos(c, 1) = cx
    cpos(c, 2) = cy
    cx = cx + 1
    If cx > 140 Then
        cx = 131
        cy = cy + 1
    End If
Next c
xx = 0
yy = 3
For b = 0 To 255

    bkpick(b, 2) = yy
    bkpick(b, 1) = xx + 114
    xx = xx + 1
    If xx = 16 Then
        xx = 0
        yy = yy + 1
    End If
    Color b
    _PrintString (bkpick(b, 1) * 8 - 7, bkpick(b, 2) * 16 - 15), Chr$(219)
Next b
Color 15
For x = 1 To maxtx
    For y = 1 To maxty
        grid(x, y, 1) = x
        grid(x, y, 2) = y + 5
    Next
Next
pdown$ = "yes" 'hmmmm.... not using this yet
px = 1: py = 1

pno = 34
pchar$ = Chr$(pno)
fklr = 15: bklr = 0
showbar$ = "yes"
colorselect$ = "b"
pmode = 1

'yup i like cmyk colors, this will work fine in stabdard rgb by commenting out the next line
loadCMYK

'the following two lines call simple subs that draw a border to show the saize of the drawing area
'it can be turned on and off with the \ key
draw_xbar
draw_ybar

Do
    _Limit 60
    kk$ = InKey$
    Locate 2, 2
    Print px; ";"; py
    Color fklr, 0
    Locate 3, 3
    Print Chr$(219)
    Color bklr, bklr
    Locate 3, 5
    Print Chr$(219)
    Color 15, 0
    Locate 3, 7
    Print Chr$(pno)


    Do While _MouseInput
        x = 1 + Int(_MouseX / 8)
        y = 1 + Int(_MouseY / 16)
        'check for the mouse pointer in the image drawing area
        If x > 0 And x <= maxtx And y > 5 And y <= maxty + 5 Then
            If _MouseButton(1) Then
                If pmode = 1 Then 'change all attributes
                    Color fklr, bklr
                    _PrintString (x * 8 - 7, y * 16 - 15), pchar$
                    tgraphic(x, y - 5).fc = fklr
                    tgraphic(x, y - 5).bc = bklr
                    tgraphic(x, y - 5).char = pchar$
                End If
                If pmode = 2 Then 'only change foreground color
                    Color fklr, tgraphic(x, y - 5).bc
                    _PrintString (x * 8 - 7, y * 16 - 15), tgraphic(x, y - 5).char
                    tgraphic(x, y - 5).fc = fklr
                End If
                If pmode = 3 Then 'only change background color
                    Color tgraphic(x, y - 5).fc, bklr
                    _PrintString (x * 8 - 7, y * 16 - 15), tgraphic(x, y - 5).char
                    tgraphic(x, y - 5).bc = bklr

                End If
                If pmode = 4 Then 'only change character
                    Color tgraphic(x, y - 5).fc, tgraphic(x, y - 5).bc
                    _PrintString (x * 8 - 7, y * 16 - 15), pchar$
                    tgraphic(x, y - 5).char = pchar$
                End If
                Color 15, 0
                px = x
                py = y - 5
            End If
        End If
        'check to see which character is clicked in the character selection area or the background colorbar
        If x > 113 And x < 130 And y > 2 And y < 19 Then
            If _MouseButton(1) Then
                For b = 0 To 255
                    If x = bkpick(b, 1) And y = bkpick(b, 2) Then
                        If colorselect$ = "b" Then bklr = b
                        If colorselect$ = "f" Then fklr = b
                    End If
                Next b
            End If
        End If
        If x > 130 And x < 141 And y > 0 And y < 41 Then
            If _MouseButton(1) Then
                For cc = 1 To 255
                    If x = cpos(cc, 1) And y = cpos(cc, 2) Then
                        'refresh   the character selection display so the one selected is highlighted by blinking
                        For c = 1 To 255
                            _Limit 4000
                            _PrintString (cpos(c, 1) * 8 - 7, cpos(c, 2) * 16 - 15), Chr$(c)
                        Next c
                        pno = cc
                        pchar$ = Chr$(pno)
                        Color 31, 8
                        _PrintString (x * 8 - 7, y * 16 - 15), pchar$
                        Color 15, 0
                    End If
                Next cc
            End If
        End If

    Loop

    Locate 1, 1: Print x, y
    ' drawing with the numerical keypad is possible but the mouse really is better
    Select Case kk$
        Case "1", "!"
            If py < maxty Then py = py + 1
            If px > 1 Then px = px - 1

        Case "2", "@"
            If py < maxty Then py = py + 1
        Case "3", "#"
            If py < maxty Then py = py + 1
            If px > 1 Then px = px + 1

        Case "4", "$"
            If px > 1 Then px = px - 1
        Case "5", "%", " "
        Case "6", "^"
            If px < maxtx Then px = px + 1
        Case "7", "&"
            If py > 1 Then py = py - 1
            If px > 1 Then px = px - 1

        Case "8", "*"
            If py > 1 Then py = py - 1
        Case "9", "("
            If py > 1 Then py = py - 1
            If px < maxtx Then px = px + 1
        Case "u", "U"
        Case "d", "D"
        Case "c", "C" 'change the character
            'this just cycles through the character code
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            pno = pno + 1
            If pno > 255 Then pno = 1
            pchar$ = Chr$(pno)
            Color 31, 8
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            Color 15, 0

        Case "b", "B" 'change the background color
            colorselect$ = "b"
        Case "f", "F" 'change the foreground color
            colorselect$ = "f"
        Case " "
        Case "\" 'sizebar on and off
            If showbar$ = "yes" Then
                showbar$ = "no"
            Else
                showbar$ = "yes"
            End If
            draw_xbar
            draw_ybar
        Case "p", "P" 'paint fill
            x = 1 + Int(_MouseX / 8)
            y = 1 + Int(_MouseY / 16)

            ppx = x: ppy = y - 5
            tchar$ = tgraphic(ppx, ppy).char
            tfc = tgraphic(ppx, ppy).fc
            tbc = tgraphic(ppx, ppy).bc
            paintit$ = "paint"
            For tx = ppx To maxtx
                For ty = ppy To maxty
                    If tchar$ = tgraphic(tx, ty).char And paintit$ = "paint" Then
                        tgraphic(tx, ty).char = pchar$
                        tgraphic(tx, ty).fc = fklr
                        tgraphic(tx, ty).bc = bklr
                        _PrintString (tx * 8 - 7, (ty + 5) * 16 - 15), pchar$
                    Else
                        paintit$ = "no"
                    End If
                Next
            Next
        Case "m", "M" 'change draw mode
            pmode = pmode + 1
            If pmode = 5 Then pmode = 1
            Locate 3, 15
            Print "                "
            Locate 3, 15
            Print themode$(pmode)


    End Select
    If kk$ >= "1" And kk$ <= "9" Or kk$ = " " Then
        Locate grid(px, py, 2), grid(px, py, 1)
        Color fklr, bklr
        Print pchar$
        Color 15, 0
    End If


Loop Until kk$ = Chr$(27)


traw$ = tgraphictostring$


'this secetion of code is just to see how the different subs are working, nothing good but it is a great example of
' how i code when i don't plan, constantly writing diagonostic routines to see if I'm hadnling things like i think I am
Color 15, 0
Cls
Locate 1, 1
Print traw$
Print "bye"

draw_tgraphic 10, 10
draw_tgraphic 30, 10

Function tgraphictostring$
    'not so keen on this yet
    tt$ = ""
    tt$ = tt$ + Chr$(32 + xaxtx)
    tt$ = tt$ + Chr$(32 + xaxty)
    For x = 1 To maxtx
        For y = 1 To maxty
            tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).fc)
        Next
    Next
    tgraphictostring$ = tt$
End Function

Function texttotgraphic (tt$)
    Print tt$
    maxtx = Asc(Mid$(tt$, 1, 1)) - 32
    maxty = Asc(Mid$(tt$, 2, 1)) - 32
    tsize = (maxtx * maxtx)
    x = 0: y = 1
    For c = 1 To tsize
        cc = c * 3
        x = x + 1
        If x > maxtx Then
            x = 1
            y = y + 1
        End If
        tgraphic(x, y).char = Mid$(tt$, cc, 1)
        tgraphic(x, y).fc = Asc(Mid$(tt$, cc + 1, 1)) - 32
        tgraphic(x, y).bc = Asc(Mid$(tt$, cc + 2, 1)) - 32
        Print tgraphic(x, y).char;
    Next c

End Function

Sub draw_xbar
    xby = 5
    Locate 5, 1
    For xbx = 1 To maxtx
        If xbx Mod 2 = 0 Then

            If showbar$ = "yes" Then
                _PrintString (xbx * 8 - 7, xby * 16 - 15), "-"
            Else
                _PrintString (xbx * 8 - 7, xby * 16 - 15), " "
            End If

        Else
            If showbar$ = "yes" Then
                _PrintString (xbx * 8 - 7, xby * 16 - 15), "+"
            Else
                _PrintString (xbx * 8 - 7, xby * 16 - 15), " "
            End If

        End If
    Next
End Sub
Sub draw_ybar
    xbx = maxtx + 1

    For xby = 1 To maxty
        If xby Mod 2 = 0 Then
            If showbar$ = "yes" Then
                _PrintString (xbx * 8 - 7, (xby + 5) * 16 - 15), "-"
            Else
                _PrintString (xbx * 8 - 7, (xby + 5) * 16 - 15), " "
            End If

        Else
            Locate 5 + b, maxtx + 1
            If showbar$ = "yes" Then
                _PrintString (xbx * 8 - 7, (xby + 5) * 16 - 15), "+"
            Else
                _PrintString (xbx * 8 - 7, (xby + 5) * 16 - 15), " "
            End If

        End If
    Next
End Sub

Sub draw_tgraphic (XX, YY)
    'this works.... I think
    For x = 1 To maxtx
        For y = 1 To maxty
            Color tgraphic(x, y).fc, tgraphic(x, y).bc
            _PrintString (XX - 1 + x, YY - 1 + y), tgraphic(x, y).char
        Next
    Next
    Color 15, 0
End Sub

Sub loadCMYK
    'build a cmyk palete
    'this palete contains set of colors in 20 increment blocks (except for the last 15)
    klr = 0
    c = 0
    m = 0
    y = 0
    k = 0
    For klr = 0 To 255
        Select Case klr
            Case 1 TO 20 'lightest grey to black in 5% increments
                k = k + 5
                c = 0
                m = 0
                y = 0
            Case 21 TO 40 'cyan on white in 5% increments
                k = 0
                c = c + 5
                m = 0
                y = 0
            Case 41 TO 60 'magenta on white in 5% increments
                k = 0
                c = 0
                m = m + 5
                y = 0
            Case 61 TO 80 'yellow on white in 5% increments
                k = 0
                c = 0
                m = 0
                y = y + 5
            Case 81 TO 100 'cyan and magenta on white in 5% increments

                k = 0
                c = c + 5
                m = m + 5
                y = 0
            Case 101 TO 120 'cyan and yellow on white in 5% increments
                If klr = 101 Then c = 0
                k = 0
                c = c + 5
                m = 0
                y = y + 5
            Case 121 TO 140 'magenta and yellow on white in 5% increments
                If klr = 121 Then y = 0
                k = 0
                c = 0
                m = m + 5
                y = y + 5
            Case 121 TO 140 'cyan and magenta in 5% increments with 20% black
                If klr = 121 Then m = 0
                k = 20
                c = c + 5
                m = m + 5
                y = 0
            Case 141 TO 160 'cyan and yellow in 5% increments with 20% black
                If klr = 141 Then c = 0
                k = 20
                c = c + 5
                m = 0
                y = y + 5
            Case 161 TO 180 'magenta and yellow  in 5% increments  with 20% black, pink to red
                If klr = 161 Then y = 0
                k = 20
                c = 0
                m = m + 5
                y = y + 5
            Case 181 TO 200
                If klr = 181 Then m = 0
                k = 40
                c = c + 5
                m = m + 5
                y = 0
            Case 201 TO 220
                If klr = 201 Then c = 0
                k = 40
                c = c + 5
                m = 0
                y = y + 5
            Case 221 TO 240 'mauves
                If klr = 221 Then y = 0
                k = 40
                c = 0
                m = m + 5
                y = y + 5
            Case 241 TO 255 'tans and browns
                k = 10 + (klr - 240) * 4
                c = 0
                'm = 100
                m = klr - 200
                y = y + 5
        End Select
        pal_cmyk klr, c, m, y, k
    Next klr
End Sub
Sub pal_cmyk (pk, c, m, y, k)
    ' create a 256 color palette entry using CMYK
    ' CMYK process color Cyan, Magenta, Yellow, Black  each  expressed as a percent from 0 to 100
    r = 255 * (100 - c)
    r = (r / 100) * ((100 - k) / 100)
    g = 255 * (100 - m)
    g = (g / 100) * ((100 - k) / 100)
    b = 255 * (100 - y)
    b = (b / 100) * ((100 - k) / 100)
    _PaletteColor pk, _RGB32(r, g, b)
End Sub
Reply
#6
Line #306 of code posted just above.

tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).fc)

should be

tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).bc)

or alike?
Reply
#7
(08-03-2022, 05:09 AM)mnrvovrfc Wrote: Line #306 of code posted just above.

tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).fc)

should be

tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).bc)

or alike?

Thanks. That area of the code has been neglected by me and will be getting more attention as I work on ways to save and load.
Reply
#8
Quote:Programming for proper mouse input could be PITA. Once I tried to fix B+ "lights on" program I think it was, changed it so it accepted mouse input but it was a real battle. The great problem is when there is an area of the program window that must accept the input, and the user holds one of the mouse buttons while dragging the cursor to outside that area. Kept fixing it and encountered another problem of retriggering left button which is very annoying in a game.


Code: (Select All)
_Title "Screen 0 Mouse Demo 2: Its a Drag"
Do
    Cls
    Print "Go ahead and drag your mouse!"
    While _MouseInput: Wend ' poll mouse
    If _MouseButton(1) Then
        mdx = _MouseX: mdy = _MouseY
        While _MouseButton(1)
            While _MouseInput: Wend ' poll mouse
            mx = _MouseX: my = _MouseY
            Cls
            Print "Go ahead and drag your mouse!"
            If mdx < mx Then
                startX = mdx: endX = mx
            Else
                startX = mx: endX = mdx
            End If
            If mdy < my Then
                starty = mdy: endy = my
            Else
                starty = my: endy = mdy
            End If
            For x = startX To endX
                For y = starty To endy
                    Locate y, x: Print "X";
                Next
            Next
            _Display
            _Limit 600
        Wend
        For x = startX To endX
            For y = starty To endy
                Locate y, x: Print "X";
            Next
        Next
        _Display
        _Limit 600
    End If
Loop Until Len(InKey$)

Where is says:
    Cl
Code: (Select All)
    Cls
    Print "Go ahead and drag your mouse!"

That's were you'd redraw the screen image if you are painting X's over an area.
b = b + ...
Reply




Users browsing this thread: 1 Guest(s)