screen 0 drawing

[James D Jarvis]

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