08-02-2022, 09:52 PM
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