QB64 Phoenix Edition
MouseyBalls, playing with balls using mouse (repel/attract) - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: MouseyBalls, playing with balls using mouse (repel/attract) (/showthread.php?tid=2089)

MouseyBalls, playing with balls using mouse (repel/attract) - Dav - 10-13-2023

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


RE: MouseyBalls, playing with balls using mouse (repel/attract) - SMcNeill - 10-13-2023

Here's a GL Ball for you to play with and get hypnotised by, @Dav 

Code: (Select All)
Screen _NewImage(600, 600, 32)

Type vec3

    x As Single

    y As Single

    z As Single

End Type

Do

    _Delay 0.05

Loop Until InKey$ <> ""



Sub _GL ()

    Dim center As vec3, vertex As vec3, radius

    center.x = 0

    center.y = 0

    center.z = 0

    radius = 1

    _glPointSize 5.0

    _glRotatef Timer * 30, 1, 2, 0

    _glBegin _GL_POINTS

    For theta = 0 To _Pi Step _Pi / 50

        For phi = 0 To _Pi(2) Step _Pi(2) / 100

            vertex.x = center.x + Sin(theta) * Cos(phi) * radius

            vertex.y = center.y + Sin(theta) * Sin(phi) * radius

            vertex.z = center.z + Cos(theta) * radius

            _glVertex3f vertex.x, vertex.y, vertex.z

        Next phi

    Next theta

    _glEnd

End Sub


RE: MouseyBalls, playing with balls using mouse (repel/attract) - bplus - 10-13-2023

I think I showed this before here but WTH it's a bplus classic ;-)

Mouse attraction and repulsion in School of Critters, notice how critters maintain a little distance between each other:
Code: (Select All)
_Title "Mouse school of critters - Click to toggle Mouse as Predator or Prey    by bplus 2018-04-27"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'from: Mouse school critters separated.txt for JB 2.0 B+ 2018-04-24
'2018-04-27 update for Predator / Prey Toggle with Click

Const xmax = 1200
Const ymax = 700
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 100, 40
Randomize Timer
Dim Shared qb(15)
qb(0) = &HFF000000
qb(1) = &HFF000088
qb(2) = &HFF008800
qb(3) = &HFF008888
qb(4) = &HFF880000
qb(5) = &HFF880088
qb(6) = &HFF888800
qb(7) = &HFFCCCCCC
qb(8) = &HFF888888
qb(9) = &HFF0000FF
qb(10) = &HFF00FF00
qb(11) = &HFF00FFFF
qb(12) = &HFFFF0000
qb(13) = &HFFFF00FF
qb(14) = &HFFFFFF00
qb(15) = &HFFFFFFFF

na = 50
Dim Shared x(na), y(na), v(na), r(na), c(na), predator
For i = 1 To na
    x(i) = rand(0, xmax)
    y(i) = rand(0, ymax)
    rr = Int(Rnd * 15)
    v(i) = rr * 1
    r(i) = rand(10, 30)
    c(i) = qb(rr)
Next

While 1
    Cls
    If InKey$ = "q" Then End
    For i = 1 To na
        m = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
        If mb Then
            While mb
                m = _MouseInput: mb = _MouseButton(1): mx = _MouseX: my = _MouseY
                _Limit 200
            Wend
            If predator Then predator = 0 Else predator = 1
        End If

        'radian angle to mouse
        ra = _Atan2(my - y(i), mx - x(i)) '  + pi kind of interesting too
        'draw it
        critter i, ra

        'separate critters for next frame and further down i line
        For j = i + 1 To na

            ' The following is STATIC's adjustment of ball positions if overlapping
            ' before calcultion of new positions from collision
            ' Displacement vector and its magnitude.  Thanks STxAxTIC !
            nx = x(j) - x(i)
            ny = y(j) - y(i)
            nm = Sqr(nx ^ 2 + ny ^ 2)
            If nm < 10 + r(i) + r(j) Then
                nx = nx / nm
                ny = ny / nm

                ' Regardless of momentum exchange, separate the balls along the lone connecting them.
                While nm < 10 + r(i) + r(j)

                    flub = 10 '  massively increased for JB to speed up code

                    x(j) = x(j) + flub * nx
                    y(j) = y(j) + flub * ny

                    x(i) = x(i) - flub * nx
                    y(i) = y(i) - flub * ny

                    nx = x(j) - x(i)
                    ny = y(j) - y(i)
                    nm = Sqr(nx ^ 2 + ny ^ 2)
                    nx = nx / nm
                    ny = ny / nm
                Wend
            End If
        Next
        If predator Then
            x(i) = x(i) + v(i) * Cos(ra + _Pi)
            y(i) = y(i) + v(i) * Sin(ra + _Pi)
        Else
            x(i) = x(i) + v(i) * Cos(ra)
            y(i) = y(i) + v(i) * Sin(ra)
        End If
    Next
    _Display
    _Limit 20
Wend

Sub critter (i, ra)
    Color c(i)
    fcirc x(i), y(i), r(i)
    If predator Then
        x1 = x(i) + .75 * r(i) * Cos(ra - _Pi(1 / 9) + _Pi)
        y1 = y(i) + .75 * r(i) * Sin(ra - _Pi(1 / 9) + _Pi)
        x2 = x(i) + .75 * r(i) * Cos(ra + _Pi(1 / 9) + _Pi)
        y2 = y(i) + .75 * r(i) * Sin(ra + _Pi(1 / 9) + _Pi)
    Else
        x1 = x(i) + .75 * r(i) * Cos(ra - _Pi(1 / 9))
        y1 = y(i) + .75 * r(i) * Sin(ra - _Pi(1 / 9))
        x2 = x(i) + .75 * r(i) * Cos(ra + _Pi(1 / 9))
        y2 = y(i) + .75 * r(i) * Sin(ra + _Pi(1 / 9))
    End If
    Color qb(15)
    fcirc x1, y1, .25 * r(i)
    fcirc x2, y2, .25 * r(i)
    If predator Then
        x3 = x1 + .125 * r(i) * Cos(ra + _Pi)
        y3 = y1 + .125 * r(i) * Sin(ra + _Pi)
        x4 = x2 + .125 * r(i) * Cos(ra + _Pi)
        y4 = y2 + .125 * r(i) * Sin(ra + _Pi)
    Else
        x3 = x1 + .125 * r(i) * Cos(ra)
        y3 = y1 + .125 * r(i) * Sin(ra)
        x4 = x2 + .125 * r(i) * Cos(ra)
        y4 = y2 + .125 * r(i) * Sin(ra)
    End If
    Color qb(0)
    fcirc x3, y3, .125 * r(i)
    fcirc x4, y4, .125 * r(i)
End Sub

'Steve McNeil's  copied from his forum   note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
    Dim subRadius As Long, RadiusError As Long
    Dim X As Long, Y As Long

    subRadius = Abs(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    If subRadius = 0 Then PSet (CX, CY): Exit Sub

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    Line (CX - X, CY)-(CX + X, CY), , 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), , BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    Wend
End Sub

Function rand% (lo%, hi%)
    rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function


RE: MouseyBalls, playing with balls using mouse (repel/attract) - Dav - 10-13-2023

@SMcNeill: That's slick.  The GL stuff is kind of a mystery to me still, been meaning to get to know it.  So if you have a _GL SUB, it's automatically run instead of main window code?  I'll do some reading up on it... 

@bplus: Oh yes, I do remember seeing that. Smartly done!

- Dav