07-09-2022, 09:12 PM
(This post was last modified: 08-03-2022, 08:00 PM by 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.
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