Zoom_Circle

[bplus]

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 Sub