Balls rain from the top, some bouce then sink away.

[Dav]

A lot faster using Hardware images!

- Dav

Code: (Select All)

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

'BALLRAIN2.BAS - v2 uses hardware images for speed

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

'Balls rain from the top, some drop, some bounce then sink away.

'For QB64 by Dav, SEP/2023



Screen _NewImage(1000, 600, 32)



balls = 500 'number of balls on screen, 200 is my laptop's comfort zone



Dim ballx(balls), bally(balls), ballxvel(balls), ballyvel(balls), ballsize(balls)

Dim ballred(balls), ballgrn(balls), ballblu(balls)

Dim ballImage&(balls)



'make random ball values

For b = 1 To balls

    ballx(b) = Rnd * (_Width) 'x position

    bally(b) = Rnd * -(_Height) 'y position

    ballxvel(b) = Int(Rnd * 7) 'x speed

    ballyvel(b) = Int(Rnd * 3) 'y speed

    ballsize(b) = Rnd * 35 + 10 'ball size

    ballred(b) = Rnd * 255 'red color

    ballgrn(b) = Rnd * 255 'green color

    ballblu(b) = Rnd * 255 'blue color

Next



'make ball hardware images

For b = 1 To balls

    temp& = _NewImage(ballsize(b) * 2, ballsize(b) * 2, 32)

    _Dest temp&

    'draw gradient ball

    x = _Width(temp&) / 2: y = _Height(temp&) / 2

    For y2 = y - ballsize(b) To y + ballsize(b)

        For x2 = x - ballsize(b) To x + ballsize(b)

            clr = (ballsize(b) - (Sqr((x2 - x) * (x2 - x) + (y2 - y) * (y2 - y)))) / ballsize(b)

            If clr > 0 Then PSet (x2, y2), _RGB(clr * ballred(b), clr * ballgrn(b), clr * ballblu(b))

        Next

    Next

    ballImage&(b) = _CopyImage(temp&, 33)

    _FreeImage temp&

Next



_Dest 0



Do

    Cls



    For b = 1 To balls



        If bally(b) < _Height - ballsize(b) Then



            ballx(b) = ballx(b) + ballxvel(b)

            bally(b) = bally(b) + ballyvel(b)



            If ballx(b) < ballsize(b) Or ballx(b) > _Width - ballsize(b) Then

                ballxvel(b) = -ballxvel(b)

            End If



            If bally(b) < ballsize(b) Or bally(b) > _Height - (ballsize(b) * 2) Then

                ballyvel(b) = -ballyvel(b)

            End If



            ballyvel(b) = ballyvel(b) + 3 'gravity value

            'ballxvel(b) = ballxvel(b) + (Rnd * 1.2 - Rnd * 1.2) 'x shake



            _PutImage (ballx(b), bally(b)), ballImage&(b)

        End If

    Next



    'see if balls done

    onscreen = 0

    For b = 1 To balls

        If bally(b) < _Height - ballsize(b) Then onscreen = 1

    Next

    If onscreen = 0 Then Exit Do



    _Display

    _Limit 24



Loop