06-18-2022, 04:03 PM
This simple little demo shows how to take advantage of qb64 to implement "mixed mode graphics" in an otherwise text mode program. It uses a tiny graphics buffer to print pixels as characters in regular text mode.
There is also a means provided to use any graphics commands you wish and output that as regular text.
No silly trek animation this time, this is serious stuff. ;-)
There is also a means provided to use any graphics commands you wish and output that as regular text.
No silly trek animation this time, this is serious stuff. ;-)
Code: (Select All)
'text draw
'mixed mode screen 0
'"draw" with ascii characters in screen mode 0
'
Dim Shared dspace& 'this is the drawing space/canvas that allows mixed mode graphics routines to function
Randomize Timer
Screen 0
Dim Shared stwd, stht 'screen text width , screen text height
stwd = 80: stht = 50 'you can change these to the other appropriate sizes the demo wouldn't display the same however
Width stwd, stht
dspace& = _NewImage(stwd + 1, stht + 1, 256) 'this is tiny keep that in mind when writign to it directly
Color 4, 3
Tdraw "rect 1,1,80,3", "@"
Color 15, 0
Locate 2, 2: Print "Text Draw"
Locate 5, 2: Print "This is a text screen set to a width of 80 and height of 50"
Locate 7, 2: Print " Tdraw is a sub that allows you to do mixed-mode graphics."
Locate 9, 2: Print "Here's a circle (limited by text size of course)"
Tdraw "circle 40,25,10", "*"
Color 18, 0
Locate 40, 2: Print "Press any key to continue"
Do
_Limit 60
A$ = InKey$
Loop Until A$ <> ""
A$ = ""
Color 15, 0
Locate 9, 2: Print "Redrew the circle with a new character and color attributes"
Color 21, 2
Tdraw "circle 40,25,10", "."
Color 18, 0
Locate 40, 2: Print "Press any key to continue"
Do
_Limit 60
A$ = InKey$
Loop Until A$ <> ""
A$ = ""
Cls
Color 7, 2
Tdraw "rect 1,1,80,3", "@"
Color 15, 0
Locate 2, 2: Print "Text Draw"
Locate 5, 2: Print "This is a text screen set to a width of 80 and height of 50"
Locate 7, 2: Print " Tdraw is a sub that allows you to do mixed-mode graphics."
Locate 9, 2: Print "Here's a Rectangle"
Color 15, 0
Tdraw "rect 11,11,40,30", Chr$(178)
Color 18, 0
Locate 40, 2: Print "Press any key to continue"
Do
_Limit 60
A$ = InKey$
Loop Until A$ <> ""
A$ = ""
Color 15, 0
Locate 9, 2: Print "We just filled it."
Color 8, 0
Tdraw "fbox 12,12,39,29", Chr$(178)
Color 15, 0
Locate 9, 2: Print "Now a line of '+' was added "
Color 5, 0
Tdraw "line 12,12,39,29", "+"
Do
_Limit 60
A$ = InKey$
Loop Until A$ <> ""
A$ = ""
Cls
Color 27, 0
Tdraw "rect 1,1,80,3", "@"
Color 15, 0
Locate 2, 2: Print "Text Draw"
Locate 5, 2: Print "This is a text screen set to a width of 80 and height of 50"
Locate 7, 2: Print " Tdraw is a sub that allows you to do mixed-mode graphics."
Locate 9, 2: Print "the standard Draw command can be used."
Color 15, 0
Locate 1, 25
Tdraw "draw bm1,25r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5r3u5r3d5", "*"
Locate 40, 1: Print "You can use any drawing command ..."
Do
_Limit 60
A$ = InKey$
Loop Until A$ <> ""
A$ = ""
Cls
cleardraw
'using standard graphics commands
_Dest dspace& 'don't forget to set the destination to dpace& when doing this
For dot = 1 To 1000
PSet (Int(Rnd * 80), Int(Rnd * 50)), Int(Rnd * 32)
Next dot
_PrintMode _KeepBackground
Locate 1, 1: Print "GIANT TEXT"
_PrintMode _FillBackground
showdraw 1, 1, 80, 50, "#" 'this will scan and read the pixels dspace& and print them as the character defined
'showdraw resets the text and graphics control to the text screen
Color 15, 0
_Delay 2
For r = 1 To 20
_Limit 5
For x = 1 + r To 80 - r
For y = 0 + r To 51 - r
showdraw x, y, 80 - x, 50 - y, Chr$(33 + r)
Next y
Next x
Next r
Cls
_Delay 0.5
Color 4, 3
Tdraw "rect 1,1,80,3", "@"
Color 15, 0
Locate 2, 2: Print " Text Draw"
Locate 5, 2: Print "In Summary"
Locate 7, 2: Print "This is a text screen set to a width of 80 and height of 50"
Locate 9, 2: Print " Tdraw is a sub that allows you to do mixed-mode graphics."
Locate 11, 2: Print "Tdraw " + Chr$(34) + "circle 10,10,4" + Chr$(34) + "," + Chr$(34) + "#" + Chr$(34) + " 'draws a circle at 10,10 to radius 4"
Locate 13, 2: Print "Tdraw " + Chr$(34) + "line 2,2,35,10" + Chr$(34) + "," + Chr$(34) + "#" + Chr$(34) + " 'draws a line form 2,2 to 35,10"
Locate 15, 2: Print "Tdraw " + Chr$(34) + "rect 2,2,35,10" + Chr$(34) + "," + Chr$(34) + "#" + Chr$(34) + " 'draws an unfilled rectangle from 2,2 to 35,10"
Locate 17, 2: Print "Tdraw " + Chr$(34) + "fbox 2,2,35,10" + Chr$(34) + "," + Chr$(34) + "#" + Chr$(34) + " 'draws an filled rectangle from 2,2 to 35,10"
Locate 19, 2: Print "Tdraw " + Chr$(34) + "draw r4u2r4" + Chr$(34) + "," + Chr$(34) + "#" + Chr$(34) + "' allows use of the normal draw command, drawing r4u2r4 in the example here"
Locate 21, 2: Print "Tdraw " + Chr$(34) + "Pset 20,20" + Chr$(34) + "," + Chr$(34) + "*" + Chr$(34) + "'puts the character * at coordiate x,y"
Locate 23, 2: Print "To use standard graphic commands use '_dest dspace&' to draw in the graphical layer directly"
Locate 25, 2: Print "Showdraw 1,1,80,50," + Chr$(34) + "*" + Chr$(34) + "' renders dspace& to the screen for 1 to 80 by 1 to 50 using character * to show the results of writign directly to dspace&"
Locate 27, 2: Print "cleardraw 'cls in dspace& and returning graphics/text output to screen 0 in one command"
Sub Tdraw (dd$, c$)
'let's draw that text
'dd$ is the command c$ is the output character
'"circle x,y,r" "rect x1,y1,x2,y2" "line x1,y1,x2,y2" "fbox x1,y1,x2,y2" "draw <string>" "pset x,y" all valid to tdraw
dd$ = LCase$(dd$)
If Left$(dd$, 6) = "circle" Then
ch = 6
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma1 = ch - 1
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma2 = ch - 1
For ch = 7 To comma1
ta1$ = ta1$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma1 + 2 To comma2
ta2$ = ta2$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma2 + 2 To Len(dd$)
ta3$ = ta3$ + Mid$(dd$, ch, 1)
Next ch
tc1 = Val(ta1$)
tc2 = Val(ta2$)
tc3 = Val(ta3$)
_Dest dspace&
Cls
Circle (tc1, tc2), tc3, 15
_Source dspace&
_Dest 0
For x = 1 To stwd
For y = 1 To stht
tk = Point(x, y)
If tk > 0 Then
Locate y, x 'i still want to move the cursor positon
_PrintString (x, y), c$ ' using printstring so the screen doesn't scroll for text graphics
End If
Next y
Next x
_Source 0
End If
If Left$(dd$, 4) = "line" Then
ch = 4
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma1 = ch - 1
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma2 = ch - 1
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma3 = ch - 1
For ch = 5 To comma1
ta1$ = ta1$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma1 + 2 To comma2
ta2$ = ta2$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma2 + 2 To comma3
ta3$ = ta3$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma3 + 2 To Len(dd$)
ta4$ = ta4$ + Mid$(dd$, ch, 1)
Next ch
tc1 = Val(ta1$)
tc2 = Val(ta2$)
tc3 = Val(ta3$)
tc4 = Val(ta4$)
_Dest dspace&
Cls
Line (tc1, tc2)-(tc3, tc4), 15
_Source dspace&
_Dest 0
For x = 1 To stwd
For y = 1 To stht
tk = Point(x, y)
If tk > 0 Then
Locate y, x
_PrintString (x, y), c$ ' using printstring so the screen doesn't scroll for text graphics
End If
Next y
Next x
_Source 0
End If
If Left$(dd$, 4) = "rect" Then
ch = 4
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma1 = ch - 1
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma2 = ch - 1
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma3 = ch - 1
For ch = 5 To comma1
ta1$ = ta1$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma1 + 2 To comma2
ta2$ = ta2$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma2 + 2 To comma3
ta3$ = ta3$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma3 + 2 To Len(dd$)
ta4$ = ta4$ + Mid$(dd$, ch, 1)
Next ch
tc1 = Val(ta1$)
tc2 = Val(ta2$)
tc3 = Val(ta3$)
tc4 = Val(ta4$)
_Dest dspace&
Cls
Line (tc1, tc2)-(tc3, tc4), 15, B
_Source dspace&
_Dest 0
For x = 1 To stwd
For y = 1 To stht
tk = Point(x, y)
If tk > 0 Then
Locate y, x
_PrintString (x, y), c$ ' using printstring so the screen doesn't scroll for text graphics
End If
Next y
Next x
_Source 0
End If
If Left$(dd$, 4) = "fbox" Then
ch = 4
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma1 = ch - 1
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma2 = ch - 1
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma3 = ch - 1
For ch = 5 To comma1
ta1$ = ta1$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma1 + 2 To comma2
ta2$ = ta2$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma2 + 2 To comma3
ta3$ = ta3$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma3 + 2 To Len(dd$)
ta4$ = ta4$ + Mid$(dd$, ch, 1)
Next ch
tc1 = Val(ta1$)
tc2 = Val(ta2$)
tc3 = Val(ta3$)
tc4 = Val(ta4$)
_Dest dspace&
Cls
Line (tc1, tc2)-(tc3, tc4), 15, BF
_Source dspace&
_Dest 0
For x = 1 To stwd
For y = 1 To stht
tk = Point(x, y)
If tk > 0 Then
Locate y, x
_PrintString (x, y), c$ ' using printstring so the screen doesn't scroll for text graphics
End If
Next y
Next x
_Source 0
End If
If Left$(dd$, 4) = "draw" Then
td$ = Right$(dd$, Len(dd$) - 4)
_Dest dspace&
Cls
Draw td$
_Source dspace&
_Dest 0
For x = 0 To stwd
For y = 0 To stht
tk = Point(x, y)
If tk > 0 Then
Locate y, x
_PrintString (x, y), c$
End If
Next y
Next x
_Source 0
End If
If Left$(dd$, 4) = "pset" Then
ch = 4
Do
ch = ch + 1
A$ = Mid$(dd$, ch, 1)
Loop Until A$ = ","
comma1 = ch - 1
For ch = 5 To comma1
ta1$ = ta1$ + Mid$(dd$, ch, 1)
Next ch
For ch = comma1 + 2 To Len(dd$)
ta2$ = ta2$ + Mid$(dd$, ch, 1)
Next ch
tc1 = Val(ta1$)
tc2 = Val(ta2$)
_Dest dspace&
Cls
PSet (tc1, tc2), 15
_Source dspace&
_Dest 0
For x = 1 To stwd
For y = 1 To stht
tk = Point(x, y)
If tk > 0 Then
Locate y, x
_PrintString (x, y), c$ ' using printstring so the screen doesn't scroll for text graphics
End If
Next y
Next x
_Source 0
End If
End Sub
Sub cleardraw
'clear dspace& and reset output to text screen"
_Dest dspace&
Cls
_Dest 0
End Sub
Sub showdraw (x1, y1, x2, y2, c$)
'render from x1,y1 to x2,y2 from dspace& to the textscreen using c$ as the displayed character
_Source dspace&
_Dest 0
If x1 < 1 Then x1 = 1
If y1 < 1 Then x1 = 1
If y2 > stht Then y2 = stht
If x2 > stwd Then x2 = stwd
For x = x1 To x2
For y = y1 To y2
tk = Point(x, y)
Color tk, 0
Locate y, x
_PrintString (x, y), c$ ' using printstring so the screen doesn't scroll for text graphics
Next y
Next x
_Source 0
End Sub