11-10-2022, 05:08 PM
Fix Pete up!
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 + ...
