+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Zoom_Circle (/showthread.php?tid=951)
Zoom_Circle - James D Jarvis - 10-06-2022
Zoom_Circle. A really simple program to get the angle on using angular headings control simple sprite movement.
Code: (Select All)
'Zoom Circle
'
'low end control example with angular navigation, dubious physics, and screenwrap
' w - accelerate
' s - decelerate
' a - turn to port
' d- tunr to starboard
'<esc> - end program
'
Screen _NewImage(800, 500, 32)
Dim Shared klr As _Unsigned Long
ppx = 400
ppy = 250
hdg = 90
hc = 0
mr = 0
fuel = 100000
tx = ppx + 3.5 * Sin(0.01745329 * hdg)
ty = ppy + 3.5 * Cos(0.01745329 * hdg)
Do
Cls
_Limit 30
Circle (ppx, ppy), 4, _RGB32(250, 250, 100) 'the zoom_circle saucer
Circle (tx, ty), 2, _RGB32(255, 255, 255) 'this nubbin is to show where the cricle is heading
ppx = ppx + mr * Sin(0.01745329 * hdg)
ppy = ppy + mr * Cos(0.01745329 * hdg)
kk$ = InKey$
Locate 1, 1: Print "Fuel : "; Int(fuel)
Locate 1, 20: Print "Velocity :"; Int(mr * 200)
_Display
Select Case kk$
Case "w"
If fuel > 0 Then
mr = mr + 0.05 * (100000 / fuel)
Circle (rrx, rry), 2, _RGB32(255, 255, 255)
fuel = fuel - 1
End If
Case "s"
If fuel > 0 Then
fuel = fuel - Sqr(mr / 0.05)
mr = mr - 0.05
If mr < 0 Then mr = 0
End If
Case "a"
If fuel > 0 Then
fuel = fuel - Sqr(Sqr(mr / 0.05))
hc = hc + 2
mr = mr * 0.995
End If
Case "d"
If fuel > 0 Then
fuel = fuel - Sqr(Sqr(mr / 0.05))
hc = hc - 2
mr = mr * .995
End If
End Select
hdg = hdg + hc
hc = hc * .75
If ppx < -4 Then ppx = 800
If ppx > 804 Then ppx = 0
If ppy < -4 Then ppy = 500
If ppy > 504 Then ppy = 0
tx = ppx + 3.5 * Sin(0.01745329 * hdg)
ty = ppy + 3.5 * Cos(0.01745329 * hdg)
Loop Until kk$ = Chr$(27)RE: Zoom_Cirlce - Pete - 10-06-2022
Well that was fun, but I couldn't get it to shoot. I really need it to shoot.
Pete
RE: Zoom_Cirlce - mnrvovrfc - 10-06-2022
(10-06-2022, 03:21 AM)James D Jarvis Wrote: Zoom_Circle. A really simple program to get the angle on using angular headings control simple sprite movement.(Boldfaced by me.)
Nice concept. @James D Jarvis J.D. change the topic name, it looks bad.
RE: Zoom_Cirlce - bplus - 10-06-2022
Wow 2nd time I made a post and forgot to save?
That was fun, cute little vehicle!
Learning to drive a bug is what I'd call it, here is a couple of mods:
Code: (Select All)
_Title "Learning to drive all over again, left/right mouse button to steer, mouse high = speedup, mouse low = slowdown"
' 2022-10-05 b+ mod of James D Jarvis ref https://staging.qb64phoenix.com/showthread.php?tid=951&pid=7476#pid7476
' Not completely satisfied with mouse high/low for acceleration but...
'low end control example with angular navigation, dubious physics, and screenwrap
' w - accelerate or mouse high up
' s - decelerate or mouse low on screen
' a - turn to port or mouse right, clockwise
' d - turn to starboard or left mouse, counter-clockwise
'<esc> - end program
'
Screen _NewImage(800, 500, 32)
Dim Shared klr As _Unsigned Long
ppx = 400
ppy = 250
hdg = 90
hc = 0
mr = 0
fuel = 100000
tx = ppx + 3.5 * Sin(0.01745329 * hdg)
ty = ppy + 3.5 * Cos(0.01745329 * hdg)
Cls ' now background is black bplus adds a blue track +++++++++++++++++++++++++++++
track& = _NewImage(_Width, _Height, 32)
fEllipse _Width / 2, _Height / 2, 350, 200, _RGB32(0, 0, 120)
fEllipse _Width / 2, _Height / 2, 300, 150, _RGB32(0, 0, 0)
_PutImage , 0, track& '===============================================================
Do
Cls
_PutImage , track&, 0 ' bplus adds a blue track and feed back for on/off traack and points ++++++++++++++
If Point(ppx, ppy) <> _RGB32(0, 0, 120) Then Sound 200, .1: points = points - 1 Else points = points + mr
Circle (ppx, ppy), 8, _RGB32(255, 255, 255) 'the zoom_circle saucer
Paint (ppx, ppy), _RGB32(180, 0, 0), _RGB32(255, 255, 255)
Circle (tx, ty), 3, _RGB32(255, 255, 255) 'this nubbin is to show where the cricle is heading
Paint (tx, ty), _RGB32(255, 255, 255), _RGB32(255, 255, 255) '===========================================
ppx = ppx + mr * Sin(0.01745329 * hdg)
ppy = ppy + mr * Cos(0.01745329 * hdg)
kk$ = InKey$
While _MouseInput: Wend ' bplus adds mouse controls +++++++++++++++++++++++++++++++
my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
If my < .25 * _Height Then kk$ = "w"
If my > .75 * _Height Then kk$ = "s"
If mb1 Then kk$ = "a"
If mb2 Then kk$ = "d" '============================================================
Locate 1, 1: Print "Fuel:"; Int(fuel)
Locate 1, 20: Print "Velocity:"; Int(mr * 200)
Locate 1, 40: Print "Points:"; points
_Display
Select Case kk$
Case "w"
If fuel > 0 Then
mr = mr + 0.05 * (100000 / fuel)
Circle (rrx, rry), 2, _RGB32(255, 255, 255)
fuel = fuel - 1
End If
Case "s"
If fuel > 0 Then
fuel = fuel - Sqr(mr / 0.05)
mr = mr - 0.05
If mr < 0 Then mr = 0
End If
Case "a"
If fuel > 0 Then
fuel = fuel - Sqr(Sqr(mr / 0.05))
hc = hc + 2
mr = mr * 0.995
End If
Case "d"
If fuel > 0 Then
fuel = fuel - Sqr(Sqr(mr / 0.05))
hc = hc - 2
mr = mr * .995
End If
End Select
hdg = hdg + hc
hc = hc * .75
If ppx < -4 Then ppx = 800
If ppx > 804 Then ppx = 0
If ppy < -4 Then ppy = 500
If ppy > 504 Then ppy = 0
tx = ppx + 3.5 * Sin(0.01745329 * hdg)
ty = ppy + 3.5 * Cos(0.01745329 * hdg)
_Limit 30
Loop Until kk$ = Chr$(27)
Sub fEllipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End SubRE: Zoom_Cirlce - James D Jarvis - 10-06-2022
Cool! Exactly why I posted a small simple bit of code. Experienced programmers can easily expand it and beginners can keep track of what is going on with the code.