screen 0 drawing

[James D Jarvis]

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