Click Away Balls

[bplus]

Hey @Dav, 

Remember this one?

Code: (Select All)

_Title "Click Away Balls" '.bas v1.1
'new: speed increases, added timer, clicking bad choice restarts.
'by Dav, DEC/2020

'Click on balls in order, starting at 1 untill all gone,
'before the timer runs out.  Clicking wrong number restarts.

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

f = _LoadFont("arial.ttf", 30): _Font f
_PrintMode _KeepBackground

balls = 15: size = 40: speed = 3

ReDim 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 = 1 To balls
    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(Rnd * 255, Rnd * 255, Rnd * 255)
Next

curball = 1

gametime = Timer

timelimit = 30

Do
    Cls
    'compute ball movement
    For t = 1 To balls
        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
    'draw background
    t = Timer
    For x = 0 To w Step 4
        For y = 0 To h Step 4
            r = Sin(1.1 * t) * h2 - y + h2
            'PSET (x, y), _RGB(r, r - y, -r)
            Line (x, y)-Step(3, 3), _RGB(r, r - y, -r), BF
        Next
        t = t + .01
        GoSub GetMouseClick
    Next

    If gameover = 1 Then
        Play "o2l16cegagfefgabgc3l4"
        Sleep 3
        GoTo restart
    End If

    'draw balls
    For i = 1 To balls
        If BallShow(i) = 1 Then
            drawBall BallX(i), BallY(i), BallSize(i), BallC(i)
            _PrintString (BallX(i) - 15, BallY(i) - 15), 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

    'If click on one ball (no overlayed oned) remove it
    If found = 1 Then
        If firstball = curball Then
            'erase ball
            drawBall BallX(firstball), BallY(firstball), BallSize(firstball), BallC(firstball)
            BallShow(firstball) = 0
            Play "mbl32o2ceg"
            _Display: _Delay .05
            curball = curball + 1
            found = 0


        Else
            found = found + 1
            lastfound = firstball
        End If
    End If

    ''If click over several balls, remove top one
    'IF found > 1 THEN
    '    'BallShow(lastfound) = 0
    '    drawball BallX(lastfound), BallY(lastfound), BallSize(lastfound), 255, 200, 100
    '    _PRINTSTRING (BallX(lastfound) - 15, BallY(lastfound) - 15), STR$(lastfound)
    '    _DISPLAY: PLAY "mbl16o2fbfbl8f"
    '    found = 0
    '    _DELAY .5
    '    GOTO restart
    'END IF

    'check if all clicked
    anyleft = 0
    For c = 1 To balls
        If BallShow(c) = 1 Then anyleft = anyleft + 1
    Next
    If anyleft = 0 Then
        gameover = 1
    End If

    If Timer - gametime > timelimit Then
        Play "mbo1l4dl8ddl4dl8feeddc#l2d"
        Sleep 3
        GoTo restart
    End If

Loop

End

'==============
GetMouseClick:
'==============

mi = _MouseInput
If _MouseButton(1) = 0 Then done = 0
If _MouseButton(1) And done = 0 Then
    mx = _MouseX: my = _MouseY
    found = 0
    For m = 1 To balls
        If BallShow(m) = 1 Then
            If Sqr((mx - BallX(m)) ^ 2 + (my - BallY(m)) ^ 2) < BallSize(m) Then
                If found = 0 Then firstball = m
                found = found + 1
                If found > 1 Then
                    lastfound = m
                End If
            End If
        End If
    Next
    done = 1
End If

Return


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