MouseyBalls, playing with balls using mouse (repel/attract)

[Dav]

Yep, I'm still playing with simple balls.  This demo shows how to attract/repel objects on the screen from the mouse pointer position.   I may use this method in a game.  Using the mouse, carve a path through the balls (right click), or draw them to the mouse (left click).  SPACE will reset the screen.  Uses hardware image for speed handling large number of balls.

- Dav

Code: (Select All)

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

'MOUSEYBALLS.BAS

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

'By Dav, OCT/2023



'Demo of attracting/repelling objects (balls) from mouse point.

'Uses hardware images for speed handling large number of objects.



'Use mouse clicks to interact with the balls on screen.

'LEFT click mouse to carve a path through the balls (repels from mouse point).

'RIGHT click to draw the balls back (attracts them to mouse point).

'SPACE will reset ball position on screen.

'That's it for now.  Have a ball.



Screen _NewImage(1000, 600, 32)



balls = 3000



Dim ballx(balls), bally(balls), balldir(balls)

Dim ballsize(balls), ballclr&(balls), ballimage&(balls)



For i = 1 To balls

    ballx(i) = Rnd * _Width

    bally(i) = Rnd * _Height

    ballsize(i) = Rnd * 10 + 5

    balldir(i) = Rnd * 10 * _Pi

    ballclr&(i) = _RGB(Rnd * 255, Rnd * 255, Rnd * 255)

Next



'make ball hardware images for speed

For i = 1 To balls

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

    _Dest temp&

    r = _Red32(ballclr&(i)): g = _Green32(ballclr&(i)): b = _Blue32(ballclr&(i))

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

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

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

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

            If clr > 0 Then PSet (x2, y2), _RGB(clr * r, clr * g, clr * b)

        Next

    Next

    ballimage&(i) = _CopyImage(temp&, 33)

    _FreeImage temp&

Next: _Dest 0

'stars

For x = 1 To 2000

    c = Rnd * 3

    Line (Rnd * _Width, Rnd * _Height)-Step(c, c), _RGBA(200, 200, 200, 25 + Rnd * 200), BF

Next: back& = _CopyImage(_Display, 33)



Do

    _PutImage (0, 0), back&



    While _MouseInput: Wend



    For i = 1 To balls



        dx = _MouseX - ballx(i)

        dy = _MouseY - bally(i)



        angle = Atn(dy / dx)

        If dx < 0 Then angle = angle + _Pi

        balldir(i) = angle



        dis = (dx ^ 2 + dy ^ 2) ^ .68

        speed = _Width / (dis + 1)



        If _MouseButton(1) Then

            ballx(i) = ballx(i) + speed * -Cos(balldir(i))

            bally(i) = bally(i) + speed * -Sin(balldir(i))

        ElseIf _MouseButton(2) Then

            ballx(i) = ballx(i) + speed * Cos(balldir(i))

            bally(i) = bally(i) + speed * Sin(balldir(i))

        Else

            balldir(i) = Rnd * 10 * _Pi

            ballx(i) = ballx(i) + Cos(balldir(i))

            bally(i) = bally(i) + Sin(balldir(i))

        End If



        If ballx(i) < ballsize(i) Then ballx(i) = ballsize(i)

        If ballx(i) > _Width - ballsize(i) Then ballx(i) = _Width - ballsize(i)

        If bally(i) < ballsize(i) Then bally(i) = ballsize(i)

        If bally(i) > _Height - ballsize(i) Then bally(i) = _Height - ballsize(i)



        _PutImage (ballx(i), bally(i)), ballimage&(i)



    Next



    keys = Inp(&H60)



    If keys = 57 Then

        For i = 1 To balls

            ballx(i) = Rnd * _Width

            bally(i) = Rnd * _Height

        Next

    End If



    _Limit 30

    _Display



Loop Until keys = 1



End