Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
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
Posts: 2,673
Threads: 325
Joined: Apr 2022
Reputation:
214
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
Posts: 3,885
Threads: 174
Joined: Apr 2022
Reputation:
201
10-13-2023, 10:40 PM
(This post was last modified: 10-13-2023, 10:42 PM by bplus.)
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
b = b + ...
Posts: 713
Threads: 117
Joined: Apr 2022
Reputation:
105
@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
|
