Inform now no longer works with QB64pe. I found the website that suppose to have the fix for it, but I am unable to download it. Seems there is some java script involved that my browser refuses to allow. Is there any way I can get that script so I can fix Inform so it will work?
A method to draw lines of variable thickness making use of rotozoom2
has routines to draw a line of any pixel thickness, outlined polygons, and filled polygons with a few different fill methods.,
I've made heavy use of B+'s code to get this working.
Code: (Select All)
_Title "Drawing with lines of variable thickness"
'by James D. Jarvis adapted using code by B+
' this uses RotoZoom2 to draw a line of any thickness.
'
Randomize Timer
Const xmax = 800
Const ymax = 600
Screen _NewImage(xmax, ymax, 32)
Function Rtan2 (x1, y1, x2, y2)
'get the angle (in radians) from x1,y1 to x2,y2
deltaX = x2 - x1
deltaY = y2 - y1
rtn = _Atan2(deltaY, deltaX)
If rtn < 0 Then Rtan2 = rtn + (2 * _Pi) Else Rtan2 = rtn
End Function
Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
rsqrd = r * r
y = -r
While y <= r
x = Sqr(rsqrd - y * y)
Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
y = y + 1
Wend
End Sub
'====================================================================
' draw a line of color klr and thickness thk
'====================================================================
Sub dline (x1, y1, x2, y2, klr As _Unsigned Long, thk)
storeDest& = _Dest
hyp = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) 'detrmine the length of the line
yy = 1 * thk
xx = Int(hyp + .9)
II& = _NewImage(xx, Int(yy + .5), 32)
_Dest II&
Line (0, 0)-(xx, yy), klr, BF 'draw the line in the temporary image buffer
centerx = (x1 + x2) / 2
centery = (y1 + y2) / 2
_Dest storeDest&
rotation = Rtan2(x1, y1, x2, y2) 'find the angle of the line in radians as rotozoom2 uses radians
RotoZoom2 centerx, centery, II&, 1, 1, rotation 'copy the line to it's position on the screen using rotozoom2
_FreeImage II&
End Sub
'This sub gives really nice control over displaying an Image.
Sub RotoZoom2 (centerX As Long, centerY As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
Dim px(3) As Single: Dim py(3) As Single
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + centerX: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + centerY
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
'====================================================================
' rotopoly2 draws a polygon wit variable line thickness
'====================================================================
Sub rotopoly2 (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long, thk)
x = 0
y = 0
For deg = turn To turn + 360 Step shapedeg
x2 = rr * Cos(0.01745329 * deg)
y2 = rr * Sin(0.01745329 * deg)
'If x <> 0 Then Line (cx + x, cy + y)-(cx + x2, cy + y2), klr
If x <> 0 Then dline cx + x, cy + y, cx + x2, cy + y2, klr, thk
x = x2
y = y2
circleBF (cx + x2), (cy + y2), (thk) \ 2, klr 'fills in the open gap at polygon line intersections
Next
End Sub
'====================================================================
' triploy draw a filled polygon by rendereing multiple triangles of the same color
'====================================================================
Sub tripoly (cx, cy, rr, shapedeg, turn, klr As _Unsigned Long)
storeDest& = _Dest
I& = _NewImage(3, 3, 32)
_Dest I&
Line (0, 0)-(_Width, _Height), klr, BF
x = 0
y = 0
_Dest storeDest&
For deg = turn To turn + 360 Step shapedeg
x2 = rr * Cos(0.01745329 * deg)
y2 = rr * Sin(0.01745329 * deg)
If x <> 0 Then _MapTriangle (0, 0)-(0, 2)-(2, 2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
x = x2
y = y2
Next
_FreeImage I&
End Sub
'====================================================================
'fillpoly creates filled polygons
'a temporary image is created and trignels for each segment of that tmeporary image are copied to the screen
'currently 7 modes are defined
'CF- color fill, HH - horizontal line fill, VV- vertical line fill
'AF - alternating segment color fill, AH & AV are alternationg horizonatl or vetical
'noise- creaes a fill of randomly colore points
'======================================================================
Sub fillpoly (cx, cy, rr, shapedeg, turn, klr1 As _Unsigned Long, klr2 As _Unsigned Long, thk, mode$)
storeDest& = _Dest
siz = (rr * Cos(0.01745329 * deg)) * 2
sx = siz / 2: sy = siz / 2
I& = _NewImage(siz, siz, 32)
_Dest I&
Select Case UCase$(mode$)
Case "CF", "AF"
Line (0, 0)-(siz, siz), klr2, BF
Case "HH", "AH"
For y = 0 To siz Step thk
Line (0, y)-(siz, y - 1 + thk / 2), klr2, BF
Next
Case "VV", "AV"
For x = 0 To siz Step thk
Line (x, 0)-(x - 1 + thk / 2, siz), klr2, BF
Next
Case "NOISE"
For y = 0 To siz
For x = 0 To siz
PSet (x, y), _RGB32(Rnd * 256, Rnd * 256, Rnd * 256)
Next x
Next y
End Select
x = 0
y = 0
_Dest storeDest&
sc = 0
For deg = turn To turn + 360 Step shapedeg
sc = sc + 1
x2 = rr * Cos(0.01745329 * deg)
y2 = rr * Sin(0.01745329 * deg)
If x <> 0 Then
Select Case UCase$(mode$)
Case "AF", "AH", "AV"
If (sc Mod 2) <> 0 Then _MapTriangle (sx, sy)-(sx + x, sy + y)-(sx + x2, sy + y2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
Case Else
_MapTriangle (sx, sy)-(sx + x, sy + y)-(sx + x2, sy + y2), I& To(cx, cy)-(cx + x, cy + y)-(cx + x2, cy + y2)
End Select
End If
x = x2
y = y2
Next
_FreeImage I&
If klr1 <> 0 Then rotopoly2 cx, cy, rr, shapedeg, turn, klr1, thk
End Sub
This example will not write to your drive. It is a high score hardware overlay, but I stripped out the file stuff.
The overlay is called repeatedly to mimic a flashing cursor. See CALL underline() sub.
What I find is the repeated call keeps copying a new image, one with the cursor showing, and one hidden. That's just 2 images, but since it keeps getting called, instead of switching images (I don;t no how of if that's possible) it just keeps making more of the same alternating screen copy images, which keeps multiplying the memory usage until other OS systems are affected.
You can monitor what I'm talking about by running Windows Task Manager with this code.
Now according to the wiki, I can't use _FREEIMAGE in the loop because I'm not changing screens. I do use it after the original screen is reactivated.
So is there a way to accomplish this flashing cursor effect in the hardware image without burning up the system's memory?
Code: (Select All)
$COLOR:32
REM Main
f1 = 22 ' Sets font size to 22 and calculates the max screen height and width for your desktop.
h = (_DESKTOPHEIGHT - 60) \ f1
w = _DESKTOPWIDTH \ (f1 / 1.66)
WIDTH w, h
_SCREENMOVE 0, 0
fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
font& = _LOADFONT(fontpath$, f1, "monospace")
_FONT font&
_DELAY .25
_RESIZE ON , _SMOOTH ' Allows resizing. Note: this is for slight adjustments. As of this version there is no compensatory function to change the font size during screen size changes.
DIM SHARED Overlay, g.population
g.population = 100000
lscr = hardware_left + 6
z3 = TIMER
WHILE -1
initials$ = "": i = 0: nxt = 0
COLOR , _RGB(24, 24, 24): t$ = " " ' Blank initials for redo. Okay to blank at start.
PSL hardware_top + 2 + rank * 2, lscr, t$
_DISPLAY
DO
_LIMIT 30
IF ABS(z3 - TIMER) > .3 THEN ' Flashing cursor
underline hardware_top + 2 + rank * 2, lscr + nxt, 0
_DISPLAY
z3 = TIMER
END IF
ky$ = UCASE$(INKEY$)
IF LEN(ky$) THEN
IF ky$ = CHR$(13) THEN
kflag = 3
ELSEIF ky$ = CHR$(8) AND LEN(initials$) THEN
kflag = 2
ELSEIF ky$ = CHR$(27) THEN
kflag = 4
ELSEIF ky$ >= "A" AND ky$ <= "Z" AND LEN(initials$) < 3 THEN
initials$ = initials$ + ky$
kflag = 1
ELSE
ky$ = "": kflag = 0
END IF
END IF
MID$(hsdata$(rank), 5, 3) = hsname$ + SPACE$(3 - LEN(hsname$))
OPEN "ascii-invaders-high-score.dat" FOR RANDOM AS #1 LEN = 25
FOR i = 1 TO 5
hs = hsdata$(i)
IF LEFT$(hs, 1) = "" THEN MID$(hs, 1, 2) = "0" + LTRIM$(STR$(i))
PUT #1, i, hs
NEXT
CLOSE #1
EXIT WHILE
WEND
bxy% = hardware_top + 1
COLOR Black, Yellow
t$ = " NAME SCORE DATE "
PSL bxy% + 1, bxx% + 1, t$
COLOR Yellow, 0
FOR i = 1 TO 5
t$ = hsdata$(i)
PSL bxy% + 1 + i * 2, bxx% + 2, t$
NEXT
_DISPLAY
RETURN
hiscore:
FOR i = 1 TO 5
IF VAL(score$) > VAL(highscore$(i)) THEN rank = i: EXIT FOR
NEXT
hsdata$(6) = SPACE$(25)
MID$(hsdata$(6), 10, 6) = score$
MID$(hsdata$(6), 18, 8) = MID$(DATE$, 1, 6) + MID$(DATE$, 9, 2)
highscore$(6) = score$
FOR i = 1 TO 6
FOR j = 1 TO 6
IF i <> j THEN
IF VAL(highscore$(i)) > VAL(highscore$(j)) THEN
SWAP highscore$(i), highscore$(j)
SWAP hsdata$(i), hsdata$(j)
END IF
END IF
NEXT
NEXT
FOR i = 1 TO 5
MID$(hsdata$(i), 1, 2) = "0" + LTRIM$(STR$(i))
NEXT
RETURN
END SUB
SUB PSLC (y!, x, t$)
_PRINTSTRING ((x - 1) * 8, (y! - 1) * 16), t$
END SUB
SUB PSL (y!, x, t$)
_PRINTSTRING ((x - 1) * _FONTWIDTH, (y! - 1) * _FONTHEIGHT), t$
Overlay_Hardware = _COPYIMAGE(Overlay, 33)
_PUTIMAGE (0, 0), Overlay_Hardware
END SUB
SUB underline (y, x, uflag)
STATIC ucnt
ucnt = -ucnt - 1
IF ucnt OR uflag THEN
LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), _RGB(24, 24, 24), BF
ELSE
LINE ((x - 1) * _FONTWIDTH, y * _FONTHEIGHT)-((x - 1) * _FONTWIDTH + 12, y * _FONTHEIGHT), Yellow, BF
END IF
Overlay_Hardware = _COPYIMAGE(Overlay, 33)
_PUTIMAGE (0, 0), Overlay_Hardware
END SUB
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
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: Keine-Scrollbalken2022-10-14.jpg]](https://i.ibb.co/Vq4jbJJ/Keine-Scrollbalken2022-10-14.jpg)
