Click Away Balls

[bplus]

OK now as your wins out number your losses more balls will be drawn into the background making it more difficult to find the slowest moving balls, plus the code is made more efficient by not redrawing background every loop, just _PutImage.

Code: (Select All)

_Title "Click Away Balls" ' 2022-05-13 needs arial.ttf font
' new: speed increases, added timer by Dav, DEC/2020
' 2022-05-13 fix so that lowest balls are drawn, overhaul code b+
' 2022-05-14 draw background once to an image, add balls in that image according to # wins over losses

' ===========================================================================================================

'       Click on balls in order, starting at 1 until all gone, before the timer runs out.

'        Hints: the lower the ball # the slower it moves, click into place ball is moving

' ===========================================================================================================

Randomize Timer
Screen _NewImage(800, 600, 32)
_Delay .25
_ScreenMove _Middle
_PrintMode _KeepBackground

balls = 15: size = 40: speed = 3
Dim BallX(balls), BallY(balls), BallDx(balls), BallDy(balls), BallSize(balls), BallShow(balls), BallC(balls) As _Unsigned Long
w = _Width: h = _Height: w2 = _Width / 2: h2 = _Height / 2

restart:

'Generate random ball data
For B = balls To 1 Step -1
    BallSize(B) = 40 + (Rnd * 30)
    BallX(B) = BallSize(B) + Rnd * (w - 2 * BallSize(B))
    BallY(B) = BallSize(B) + Rnd * (h - 2 * BallSize(B))
    a = Rnd * _Pi(2): Ballspeed = 2 + B
    BallDx(B) = Ballspeed * Cos(a)
    BallDy(B) = Ballspeed * Sin(a)
    BallShow(B) = 1
    BallC(B) = _RGB32(100 + Rnd * 150, 100 + Rnd * 150, 100 + Rnd * 150)
Next
If back& Then _FreeImage back&
back& = _NewImage(w, h, 32)
For x = 0 To w Step 4
    For y = 0 To h Step 4
        r = Sin(1.1 * t) * h2 - y + h2
        Line (x, y)-Step(3, 3), _RGB(r, r - y, -r), BF
    Next
t = t + .007  ' <<<<<<<<<<<< put this back in so the background is shaped
Next
For i = 1 To wins
    rx = Rnd * w: ry = Rnd * h: rr = 40 + (Rnd * 30)
    drawBall rx, ry, rr, _RGB32(Rnd * 155 + 100, Rnd * 155 + 100, Rnd * 155 + 100)
    Text rx - 15, ry - 15, 30, &HFFFFFFFF, Right$("0" + _Trim$(Str$(i + 15)), 2)
Next
_PutImage , 0, back&

' initialize
curBall = 1: gametime = Timer: timelimit = 35
Do
    Cls
    'compute ball movement
    For t = balls To 1 Step -1
        BallX(t) = BallX(t) + BallDx(t) 'move ball then make sure in bounds
        BallY(t) = BallY(t) + BallDy(t)
        If BallX(t) > w - BallSize(t) Then BallDx(t) = -BallDx(t): BallX(t) = w - BallSize(t)
        If BallX(t) < BallSize(t) Then BallDx(t) = -BallDx(t): BallX(t) = BallSize(t)
        If BallY(t) > h - BallSize(t) Then BallDy(t) = -BallDy(t): BallY(t) = h - BallSize(t)
        If BallY(t) < BallSize(t) Then BallDy(t) = -BallDy(t): BallY(t) = BallSize(t)
    Next

    ' curBall clicked
    While _MouseInput: Wend
    mb = _MouseButton(1): mx = _MouseX: my = _MouseY
    If mb Then
        If Sqr((mx - BallX(curBall)) ^ 2 + (my - BallY(curBall)) ^ 2) < BallSize(curBall) Then
            BallShow(curBall) = 0
            Play "mbl32o2ceg"
            curBall = curBall + 1
        End If
    End If

    'draw all stuff
    _PutImage , back&, 0
    For i = balls To 1 Step -1
        If BallShow(i) = 1 Then
            drawBall BallX(i), BallY(i), BallSize(i), BallC(i)
            Text BallX(i) - 15, BallY(i) - 15, 30, &HFFFFFFFF, Right$("0" + _Trim$(Str$(i)), 2)
        End If
    Next
    Locate 1, 1: Print "Click ball.."; curBall;
    Locate 2, 1: Print timelimit - Int(Timer - gametime);
    _Display
    _Limit 30

    ' game over ?
    If curBall > 15 Then ' success
        wins = wins + 1
        Play "o2l16cegagfefgabgc3l4"
        _Delay 2
        GoTo restart
    ElseIf Timer - gametime > timelimit Then ' fail
        wins = wins - 1
        Play "mbo1l4dl8ddl4dl8feeddc#l2d"
        _Delay 2
        GoTo restart
    End If
Loop

Sub drawBall (x, y, r, c As _Unsigned Long)
    Dim rred As Long, grn As Long, blu As Long, rr As Long, f
    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
    For rr = r To 0 Step -1
        f = 1 - rr / r
        fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)
    Next
End Sub

Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
    Dim Radius As Integer, RadiusError As Integer
    Dim X As Integer, Y As Integer
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub

Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
    Dim fg As _Unsigned Long, cur&, I&, multi, xlen
    fg = _DefaultColor
    cur& = _Dest
    I& = _NewImage(8 * Len(txt$), 16, 32)
    _Dest I&
    Color K, _RGBA32(0, 0, 0, 0)
    _PrintString (0, 0), txt$
    multi = textHeight / 16
    xlen = Len(txt$) * 8 * multi
    _PutImage (x, y)-Step(xlen, textHeight), I&, cur&
    Color fg
    _FreeImage I&
End Sub

EDIT: added a t increaser when making the background so more shaped as Dav originally had.