A set of "Drawing" routines for text mode programs.
Lines , rectangles, circles, and polygons for text mode programs.
ciclechr, chrpoly, chrrect, chrline : draw shapes with characters as lines, allows for line thickness
textline,textsprite,cirlcetext,textpoly : draw shapes with a strign of text that will follow the lines drawn
Vprint,Color_print, Color_vprint: a couple extra print routines that usually require multiple lines
Code: (Select All)
'SCREEN MODE 0 "Graphics"
' by James D. Jarvis
'
'a set of text mode "drawing" routines for text mode screens
'
'===========================================================================
' Global variables and Main Program setup
'===========================================================================
Screen _NewImage(160, 40, 0) '<- routines will work in any size text screen
Dim Shared kbg, kff, aspect '<- need these for the subs
Dim Shared tpointr, tl$ '<- needs these for the subs
aspect = _Width / (_Height * 2) '<- needed in the subs
kbg = 0: kff = 15 'main bachground color and main foreground color
'===========================================================================
' Simple Demo of the drawing routines
'===========================================================================
_FullScreen
circlechr 50, 20, 6, 8, Chr$(219)
circlechr 50, 20, 4, 8, Chr$(178)
chrline 3, 3, 30, 30, 0.5, 3, Chr$(219)
chrpoly 60, 20, 10, 90, 45, 3, 0.5, "*"
chrrect 124, 4, 156, 16, 11, "X", "X"
chrrect 124, 18, 156, 22, 11, "@", "b"
vprint 70, 4, "Therefore"
color_print 125, 33, 12, 4, "Hello there"
color_vprint 123, 32, 0, 4, "Hello there"
textline 11, 11, 40, 21, 19, 12, "*-AA"
textline 100, 20, 3, 5, 12, 0, "theline"
textline 80, 10, 80, 33, 12, 0, "theline"
Input "Press ENTER to continue", A$
tx = 1: ty = 1
turn = 0
cl$ = "*"
Do
_Limit 5 'sorry that's so slow but even at 30 fps it's too fast to really see what going on
Cls
n = 0
For y = 1 To 40
chrline 1, y, _Width, y, 0.5, n, Chr$(176)
n = n + 1
If n = 16 Then n = 0
Next
Locate 1, 1: Print "TEXTSPRITE demo and some rotating polygons using textpoly"
Locate 3, 1: Print "press <esc> to exit>"
Locate 2, 1: Print "Have to slow this down on modern machines so you can see it."
circletext 50, 20, 10, 12, "I'M A CIRCLE OF TEXT! "
chrpoly 50, 20, 10, 3, 0, 13, 0, Chr$(219) 'make an unfilled pseudo-circle using chrpoly ortextpoly
textpoly 100, 20, 10, 60, turn, 12, 10, cl$
textpoly 100, 20, 5, 90, -turn, 12, 10, cl$
turn = turn + 3: cl$ = cl$ + Chr$(33 + Int(Rnd * 200)): If Len(cl$) > 200 Then cl$ = "*"
If turn > 360 Then turn = turn - 360
textsprite tx, ty, "0---0 ### # # ", 5, 11
_Display
tx = tx + 2
ty = ty + 1
If ty > _Height Then ty = 1
If tx > _Width Then tx = 1
kk$ = InKey$
Loop Until kk$ = Chr$(27)
End
'===========================================================================
' Text "Drawing" routines to draw lines, circles, rectangles, and polygons
'===========================================================================
Sub vprint (x, y, st$)
'print vertically down
slen = Len(st$)
n = 0
For yy = y To y + slen - 1
n = n + 1
If yy > 0 And yy <= _Height Then _PrintString (x, yy), Mid$(st$, n, 1)
Next
End Sub
Sub color_print (x, y, tfk, tbk, st$)
'printstring st$ at location x,y with foreground color tfk and background color tbk
Color tfk, tbk
_PrintString (x, y), st$
Color kff, kbg
End Sub
Sub color_vprint (x, y, tfk, tbk, st$)
'print vertically down with with foreground color tfk and background color tbk
Color tfk, tbk
vprint x, y, st$
Color kff, kbg
End Sub
Sub circlechr (cx As Long, cy As Long, r As Long, klr As _Unsigned Long, cc$)
'draw a filled circle using a ascii charcater of color klr
'the width is adjusted to be closer visibly to a circle as opposed to a oval due the size of charcaers displayed in text mode
rsqrd = (r + .3) * (r + .3)
Color klr, kbg
y = -r
While y <= r
x = Int(Sqr(rsqrd - y * y)) * aspect 'ascpect is global value created in the main program , yuo may have to change it for some screens
For tx = cx - x To cx + x
If tx > 0 And tx <= _Width And cy + y > 0 And cy + y <= _Height Then _PrintString (tx, cy + y), cc$
Next tx
y = y + 1
Wend
Color kff, kbg
End Sub
Sub chrpoly (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long, thk, cc$)
'draw a polygon using character cc$ in color klr
'the width is adjusted to be closer visibly to a circle as opposed to a oval due the size of charcaers displayed in text mode
'cx,cy is polygon center rr is the radius of the outermost points shapedeg is the angles to form the polygon turn
'turn is the degrees to rotate the whole shape klr is the kolor of the line thk is the thickness of the line 0.5 for 1 character thick lines (it's a radius)
'cc$ is the character to be used
For deg = turn To turn + 360 Step shapedeg
x2 = cx + (rr * Cos(0.01745329 * deg)) * aspect 'ascpect is global value created in the main program , yuo may have to change it for some screens
y2 = cy + rr * Sin(0.01745329 * deg)
If x > 0 Then chrline x, y, x2, y2, thk, klr, cc$
x = x2
y = y2
Next
End Sub
Sub chrrect (x1, y1, x2, y2, klr, cc$, mode$)
'draw a rectangle using character cc$ in color klr
' mode$ allows different sorts of rectangles F will be a filled rectangle, X and outline with diagonals from corener to corner and anyhtign else will be an outline
Select Case UCase$(mode$)
Case "F"
For y = y1 To y2
_PrintString (x1, y), String$((x2 + 1 - x1), Asc(cc$))
Next y
Case "X"
chrline x1, y1, x2, y1, 0.5, klr, cc$
chrline x1, y2, x2, y2, 0.5, klr, cc$
chrline x1, y1, x1, y2, 0.5, klr, cc$
chrline x2, y1, x2, y2, 0.5, klr, cc$
chrline x1, y1, x2, y2, 0.5, klr, cc$
chrline x1, y2, x2, y1, 0.5, klr, cc$
Case Else
chrline x1, y1, x2, y1, 0.5, klr, cc$
chrline x1, y2, x2, y2, 0.5, klr, cc$
chrline x1, y1, x1, y2, 0.5, klr, cc$
chrline x2, y1, x2, y2, 0.5, klr, cc$
End Select
End Sub
Sub chrline (x0, y0, x1, y1, r, klr, cc$)
'draw a line with a charcter CC$ in color klr in thickness r (it's a radius) use 0.5 for 1 character thick lines.
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
lineLow x1, y1, x0, y0, r, klr, cc$
Else
lineLow x0, y0, x1, y1, r, klr, cc$
End If
Else
If y0 > y1 Then
lineHigh x1, y1, x0, y0, r, klr, cc$
Else
lineHigh x0, y0, x1, y1, r, klr, cc$
End If
End If
End Sub
Sub lineLow (x0, y0, x1, y1, r, klr, cc$)
'internal routine used with chrline
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
d = (dy + dy) - dx
y = y0
For x = x0 To x1
circlechr x, y, r, klr, cc$
If d > 0 Then
y = y + yi
d = d + ((dy - dx) + (dy - dx))
Else
d = d + dy + dy
End If
Next x
End Sub
Sub lineHigh (x0, y0, x1, y1, r, klr, cc$)
'internal routine used with chrline
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
D = (dx + dx) - dy
x = x0
For y = y0 To y1
circlechr x, y, r, klr, cc$
If D > 0 Then
x = x + xi
D = D + ((dx - dy) + (dx - dy))
Else
D = D + dx + dx
End If
Next y
End Sub
Sub textline (x0, y0, x1, y1, Fklr, Bklr, cc$)
'use a string to write a line not just a single character. The string will be repeated until the line is finished
tl$ = cc$
tpointr = 0
If Abs(y1 - y0) < Abs(x1 - x0) Then
If x0 > x1 Then
tlinelow x1, y1, x0, y0, Fklr, Bklr
Else
tlinelow x0, y0, x1, y1, Fklr, Bklr
End If
Else
If y0 > y1 Then
tlineHigh x1, y1, x0, y0, Fklr, Bklr
Else
tlineHigh x0, y0, x1, y1, Fklr, Bklr
End If
End If
Color kff, kfg
End Sub
Sub tlinelow (x0, y0, x1, y1, Fklr, Bklr)
'internal routine used with textline
dx = x1 - x0
dy = y1 - y0
yi = 1
If dy < 0 Then
yi = -1
dy = -dy
End If
d = (dy + dy) - dx
y = y0
For x = x0 To x1
tpointr = tpointr + 1
If tpointr > Len(tl$) Then tpointr = 1
Color Fklr, Bklr
If x > 0 And x <= _Width And y > 0 And y <= _Height Then _PrintString (x, y), Mid$(tl$, tpointr, 1)
If d > 0 Then
y = y + yi
d = d + ((dy - dx) + (dy - dx))
Else
d = d + dy + dy
End If
Next x
End Sub
Sub tlineHigh (x0, y0, x1, y1, Fklr, bklr)
'internal routine used with textline
dx = x1 - x0
dy = y1 - y0
xi = 1
If dx < 0 Then
xi = -1
dx = -dx
End If
D = (dx + dx) - dy
x = x0
For y = y0 To y1
tpointr = tpointr + 1
If tpointr > Len(tl$) Then tpointr = 1
Color Fklr, bklr
If x > 0 And x <= _Width And y > 0 And y <= _Height Then _PrintString (x, y), Mid$(tl$, tpointr, 1)
If D > 0 Then
x = x + xi
D = D + ((dx - dy) + (dx - dy))
Else
D = D + dx + dx
End If
Next y
End Sub
Sub textsprite (x, y, sp$, wid, klr)
'print a single color text sprite
' chr$(32) or <space> is used in the empty spots in the sprite becaseu _printmode doesn't allow for the trasnparent backgrounds
'in text mode
'SP$ the sprite a normal spring
'wid the width of each line in the sprite
Color klr, kbg
siz = Len(sp$)
p = 0
For sy = 1 To siz
For sx = 1 To wid
p = p + 1
If (x - 1 + sx) > 0 And (x - 1 + sx) <= _Width And (y - 1 + sy) > 0 And (y - 1 + sy) <= _Height Then
If Mid$(sp$, p, 1) <> " " Then _PrintString (x - 1 + sx, y - 1 + sy), Mid$(sp$, p, 1)
End If
Next sx
Next sy
Color kff, kbg
End Sub
Sub circletext (cx As Long, cy As Long, r As Long, klr As _Unsigned Long, cc$)
'draw a filled circle using a string of color klr
'the width is adjusted to be closer visibly to a circle as opposed to a oval due the size of charcaers displayed in text mode
rsqrd = (r + .3) * (r + .3)
tl = Len(cc$)
Color klr, kbg
p = 0
y = -r
While y <= r
x = Int(Sqr(rsqrd - y * y)) * aspect 'ascpect is global value created in the main program , yuo may have to change it for some screens
For tx = cx - x To cx + x
If tx > 0 And tx <= _Width And cy + y > 0 And cy + y <= _Height Then
p = p + 1
If p > tl Then p = 1
_PrintString (tx, cy + y), Mid$(cc$, p, 1)
End If
Next tx
y = y + 1
Wend
Color kff, kbg
End Sub
Sub textpoly (cx, cy, rr, shapedeg, turn, fklr, bklr, cc$)
'draw a polygon using character cc$ in color klr
'the width is adjusted to be closer visibly to a circle as opposed to a oval due the size of charcaers displayed in text mode
For deg = turn To turn + 360 Step shapedeg
x2 = cx + (rr * Cos(0.01745329 * deg)) * aspect 'ascpect is global value created in the main program , yuo may have to change it for some screens
y2 = cy + rr * Sin(0.01745329 * deg)
If x > 0 Then textline x, y, x2, y2, fklr, bklr, cc$
x = x2
y = y2
Next
End Sub
I have a few questions about the use of _INTEGER64 and _UNSIGNED _INTEGER64.
According to the WIKI info, _UNSIGNED _INTEGER64 values can range from 0 to 18446744073709551615 on 64 bit computers and the 32 bit values are limited to the _INTEGER64 values of -9223372036854775808 to 9223372036854775807.
However, the WIKI page for _UNSIGNED doesn't mention any difference between 32 bit or 64 bit use.
Question :
Has the problem of not being able to use the higher values still apply to 32 bit systems?
The reason I ask is that I am currently running QB64pe 32bit on a Windows Vista Home Premium 32 bit Operating System and I'm able to get the higher values for an _UNSIGNED _INTEGER64 to work without any problems.
PLEASE NOTE : This all runs on a computer that IS CAPABLE of running a 64 bit OS installation. >> Processor : AMD Athlon(tm) 64X2 Dual Core Processor 5000+ 2.60 Ghz
More questions:
So, does this mean that ONLY the computer needs to be capable of 64 bit?
When QB64 does _UNSIGNED _INTEGER64 math, does it use the processor's internal math co-processor?
If I were using QB64pe 32 bit on a 32 bit Operating System which was running on a 32 bit processor (not capable of running a 64 bit OS) would I still be able to get the higher values for an _UNSIGNED _INTEGER64 variable?
Thanks in advance for any more detailed info that can be provided.
I've noticed an error now - QB64 3.3.0. In the case of "TAB", the editor doubles the "Using" as soon as one do something again after the correction.
It is also strange that sometimes an error message appears and sometimes not.
Just wondering as I am still trying to better understand collisions, if anyone here would be interested in shedding some light on this subject.
I'm currently trying to get my mind around the idea of angular collision responses. Specifically if a moving ball is to collide with odd angled surfaces (2D only). Looking into this, I've discovered yet again that my math skills are nearly zero, so this could perhaps be easy for others here. Or maybe it's difficult - I don't know.
Vectors are at play here and apparently the math involves multiplying vectors, which is new to me. The "dot product" seems to be the way to do this, rather than using degrees and more code. But honestly it's a bit confusing to me at this point.
So just to illustrate the idea...if the ball in this scenario was bouncing off these walls, would this be a nightmare to program? Or is this not as bad as it seems?
Code: (Select All)
Screen _NewImage(800, 600, 32)
Randomize Timer
Dim c1 As Long
c1 = _RGB(255, 255, 255)
x1 = 50
y1 = 50
flag = 0
While flag = 0
x2 = (Rnd * 80) + 80 + x1
If x2 > 750 Then
x2 = 750
flag = 1
End If
y2 = Rnd * 60 + 20
Line (x1, y1)-(x2, y2), c1
x1 = x2
y1 = y2
Wend
flag = 0
While flag = 0
y2 = (Rnd * 80) + 80 + y1
If y2 > 550 Then
y2 = 550
flag = 1
End If
x2 = 750 - (Rnd * 60 + 20)
Line (x1, y1)-(x2, y2), c1
x1 = x2
y1 = y2
Wend
flag = 0
While flag = 0
x2 = x1 - ((Rnd * 80) + 80)
If x2 < 50 Then
x2 = 50
flag = 1
End If
y2 = 550 - (Rnd * 60 + 20)
Line (x1, y1)-(x2, y2), c1
x1 = x2
y1 = y2
Wend
flag = 0
While flag = 0
y2 = y1 - ((Rnd * 80) + 80)
If y2 < 50 Then
y2 = 50
flag = 1
End If
x2 = Rnd * 60 + 20
If flag = 1 Then x2 = 50
Line (x1, y1)-(x2, y2), c1
x1 = x2
y1 = y2
Wend
I have now created a "Random Access" data structure (German: Direktzugriffsdatei). Seems to work. There are three records in the file.
But there is one point I don't understand: 137: If sentenceNumber > 0 And sentenceNumber < number of sentences + 1 Then
Why plus 1? The data sets do not start at zero, otherwise data set 1 would show that of data set 2. It is working.
I have to take a good look at the deletion of data records again. Let's see.
Oh yes, a problem with the output. Is there a way to add vertical scroll bars? Making the output bigger doesn't help. How are you supposed to keep track of 100 data sets?
Code: (Select All)
'Direktzugriffsdatei (Random Access) - 5. Okt. 2022
'Geaendert auf "Shared" Variable da sonst Probleme beim Lesen - 14. Okt. 2022
Option _Explicit
'Definition der Datenstruktur - Direktzugriff
Type MotorradModell
Modell As String * 20
Farbe As String * 10
Hubraum As String * 10
Kilowatt As String * 10
Fahrgewicht As String * 10
Preis As Double
End Type
'Global zur Verfuegung stellen, sonst wird es
'wirklich kompliziert
Dim Shared Motorrad As MotorradModell
Declare Sub Eingabe()
Declare Sub Lesen()
Declare Sub SatzLesen()
(Disclaimer: this is more a thought experiment or topic of discussion than a hard proposal!)
One thing I have wanted to see for a while is an IDE that lets you enter your program in the language / syntax of your choice, stores the program, variable names, and comments, in some sort of universal format or intermediate language, and can "render" the source code in a different language or with different variable naming conventions, depending on the user's preference. Maybe there's a dropdown you use to select the language (e.g. QB64, Python, JavaScript, etc.) and as soon as you do, the editor immediately translates or renders the source code into whatever you choose.
I know that this isn't necessarily as simple as it sounds where languages do not support the same features or paradigms - e.g. QB64 is statically typed and Python dynamically typed, QB is strictly procedural whereas Python can be OO or functional - but if a program sticks to the lowest common denominator of functions, or the IDE stores the maximum detail (e.g. explicit type declarations for QB which is stored under the hood, but ignored when using dynamically typed languages like Python & JavaScript) then perhaps it can work?
Or we could take the simple route and just support the features all languages have in common (e.g. strictly procedural) so people who are more familiar
with C/JavaScript syntax can use that, people who like Python can use that, and us BASIC lovers can do that.
Probably the biggest disconnect would be the static vs dynamic typing, so maybe the flavor of Python & JavaScript would be strongly typed (that is, instead of JavaScript we use TypeScript as the option, and is there a strongly typed compiled variant of Python? There would be now! LoL)
Since QB64 uses a source-to-source interrim compiler to first compile to C and then compiles to machine code, perhaps that can be leveraged to multi-language support. Isn't Cython a Python to C compiler?
Anyway, I just thought I would float the idea of a smart IDE that lets people work in whatever syntax they prefer. This would potentially increase the usefulness or the user base for QB64, or lead to a more universal platform for programming.
I'm sure once artificial intelligence gets intelligent enough, and deep learning gets deep enough, that there can be IDEs capable of translating code on the fly between any language or even paradigm. I have to find the link again, but I have even found & used a Web-based AI tool that translated code between languages and it produced working Python code from the JavaScript examples I fed it. Perhaps we could simply have an IDE that calls that Web service with the advanced AI to do the heavy lifting of translating code?
Anyway that's my thought for the day, which came out of another conversation we were having where Python came up... I figured I'd float the idea for discussion for y'all to shoot down or discuss, or as an idea for someone looking for a challenge!
The top code sets the variable "h" to equal the SCREEN() function. It is used so the screen position is read only once. The variable then checks two places in the code where this info is polled. Now the bottom code does exactly the same thing, but it calls the SCREEN() function THREE times. You'd probably think that's the slower way to do things, but it's actually about 5 times faster!
Code: (Select All)
ii = 0
FOR i = 0 TO LEN(a.ship) - 1
h = SCREEN(j, k + i)
IF h = ASC(g.flagship) OR h = g.m_asc THEN
IF h = ASC(g.flagship) THEN
ii = 1
EXIT FOR
ELSE
ii = 2
EXIT FOR
END IF
END IF
NEXT
Code: (Select All)
FOR i = 0 TO LEN(a.ship) - 1
IF SCREEN(j, k + i) = ASC(g.flagship) OR SCREEN(j, k + i) = g.m_asc THEN
IF SCREEN(j, k + i) = ASC(g.flagship) THEN
ii = 1
EXIT FOR
ELSE
ii = 2
EXIT FOR
END IF
END IF
NEXT
Pete
- Looking forward to an afterlife based on attendance.
![[Image: Using-verdoppelt-QB64-3-3-0.jpg]](https://i.ibb.co/gPSF6Sh/Using-verdoppelt-QB64-3-3-0.jpg)
![[Image: Keine-Scrollbalken2022-10-14.jpg]](https://i.ibb.co/Vq4jbJJ/Keine-Scrollbalken2022-10-14.jpg)
