Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
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.
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
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
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. 
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.
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
08-01-2022, 03:06 PM
(This post was last modified: 08-01-2022, 03:13 PM by bplus.)
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 + ...
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
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
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
08-02-2022, 09:58 PM
(This post was last modified: 08-03-2022, 12:11 PM by 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
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
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?
Posts: 660
Threads: 142
Joined: Apr 2022
Reputation:
58
08-03-2022, 12:13 PM
(This post was last modified: 08-03-2022, 12:13 PM by James D Jarvis.)
(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.
Posts: 3,965
Threads: 176
Joined: Apr 2022
Reputation:
219
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 + ...
|
