Ball Screensaver

[SMcNeill]

The little demo should speak for itself.   It's simple, but I was just having fun playing around with my balls for a bit this morning, since it seems everyone else has been doing the same thing around here lately. 

Code: (Select All)

Screen _NewImage(1024, 720, 32)

Randomize Timer

$Color:32



Type Ball_Type

    x As Integer 'position

    y As Integer

    xchange As Integer 'speed

    ychange As Integer

    size As Integer 'size

    c As _Unsigned Long 'color

End Type



Dim Balls(5000) As Ball_Type

'Init balls

For i = 0 To UBound(Balls)

    Balls(i).size = Int(Rnd * 10) + 1

    Select Case Int(Rnd * 2)

        Case 0: Balls(i).c = Red

        Case Else: Balls(i).c = Blue

    End Select

    Balls(i).x = Int(Rnd * _Width)

    Balls(i).y = Int(Rnd * _Height)

    Balls(i).xchange = Int(Rnd * 20) - 10

    Balls(i).ychange = Int(Rnd * 20) - 10

Next



t# = Timer(.01)

Do

    While _MouseInput: Wend

    Cls

    max = (Timer - t#) * 10

    If max >= 1000 Then max = 1000

    For i = 1 To max

        CircleFill Balls(i).x, Balls(i).y, Balls(i).size, Balls(i).c

        Balls(i).x = Balls(i).x + Balls(i).xchange

        Balls(i).y = Balls(i).y + Balls(i).ychange

        If _Hypot(Balls(i).x - _MouseX, Balls(i).y - _MouseY) < Balls(i).size Then

            Balls(i).xchange = -Balls(i).xchange

            Balls(i).ychange = -Balls(i).ychange

            Balls(i).c = Green

        End If

        If Balls(i).x < 0 Then

            Balls(i).x = 0

            Balls(i).xchange = -Balls(i).xchange

        End If

        If Balls(i).y < 0 Then

            Balls(i).y = 0

            Balls(i).ychange = -Balls(i).ychange

        End If

        If Balls(i).x >= _Width Then

            Balls(i).x = _Width

            Balls(i).xchange = -Balls(i).xchange

        End If

        If Balls(i).y >= _Height Then

            Balls(i).y = _Height

            Balls(i).ychange = -Balls(i).ychange

        End If

    Next

    _Limit 60

    _Display

Loop



Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    ' CX = center x coordinate

    ' CY = center y coordinate

    '  R = radius

    '  C = fill color

    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

Have fun and see how long it takes you to turn all the balls green.

[NakedApe]

Nice balls, Steve! Why do I feel like I need bug spray tho?    Going to green takes a long time...

[DANILIN]

Xonix? XoNiX ... XONIX !

https://qb64phoenix.com/forum/showthread...81#pid2981




but principles of XONIX decide ... maze

DAV: MazeBall - A tilt-like maze puzzle game

https://qb64phoenix.com/forum/showthread...0#pid28390

[vince]

would've expected a little more from Steve

[SMcNeill]

would've expected a little more from Steve

Steve was going to do more -- I was going to make a simply type of game where you use the cursor to try and bounce balls of the proper color to your goal.  I just got sidetracked and didn't have time to finish it all up, so I just turned that logic into a simple (color them GREEN) command, and said, "Meh!  It's a screensaver now!"

 

If there were only forty hours in a day, I might be able to get everything done that I'd like to do in a day's time!

[Pete]

Move to China. They are on a 9-9-6 schedule. Work is 9:00am to 9pm, 6 days a week. The younger generation is in protest of this, so it looks like while the Chinese exported Covid to us, we got even by exporting Snowflakes to them.

Pete

- Happy Snowflakes come from Canada.