_Title "Boid Watching 3 by bplus 2018-09-07" 'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'from Boid Watching.bas for QB64 version 2017 1106/82 B+ 2018-04-28
'from Boid Watching.txt for JB 2.0 B+ 2018-04-28
'from networking.bas SmallBASIC 0.12.9 [B+=MGA] 2017-04-14
' combined with
'Mouse school critter attract or repell.txt for JB 2.0 B+ 2018-04-26
' plus what I picked up generally from the videos
'2018-09-07 try a quick fix
'Boid behavior based on several modes
centerMode = 1 ' on / off
cf = .01 'centering factor how strong a pull from 0 to 1 .01 is week .1 pretty strong!
headMode = 1 ' on / off
sway
= _Pi / 6 'just turn neighbor towards neighborhf = .2 'heading factor how strong an influence 0 to 1
spaceMode = 1 ' on / off
spacing = 15 'space amount approx
noise = 10 'general randomness added to movements individualism
Boids = 50
newCritter i
drawLandscape
If distance
(x
(i
), y
(i
), x
(j
), y
(j
)) < 100 Then
'sway the neighbors towards each other
a(i) = a(i) - sway * hf
a(j) = a(j) + sway * hf
a(i) = a(i) + sway * hf
a(j) = a(j) - sway * hf
'stickiness stay close to neighbors, close distance between
x(i) = x(i) - cf * (x(i) - x(j))
x(j) = x(j) + cf * (x(i) - x(j))
x(i) = x(i) + cf * (x(j) - x(i))
x(j) = x(j) - cf * (x(j) - x(i))
y(i) = y(i) - cf * (y(i) - y(j))
y(j) = y(j) + cf * (y(i) - y(j))
y(i) = y(i) + cf * (y(j) - y(i))
y(j) = y(j) - cf * (y(j) - y(i))
'don't let them bunch up
' 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) nx = nx / nm
ny = ny / nm
' Regardless of momentum exchange, separate the balls along the lone connecting them.
x(j) = x(j) + .1 * spacing * nx
y(j) = y(j) + .1 * spacing * ny
x(i) = x(i) - .1 * spacing * nx
y(i) = y(i) - .1 * spacing * ny
nx = x(j) - x(i)
ny = y(j) - y(i)
nm
= Sqr(nx
^ 2 + ny
^ 2) nx = nx / nm
ny = ny / nm
'IF y(i) < 30 OR y(i) > ymax - 30 THEN a(i) = a(i) + sway
'out of sight
If x
(i
) < -1 * r
(i
) Or x
(i
) > xmax
+ r
(i
) Or y
(i
) < -1 * r
(i
) Or y
(i
) > ymax
+ r
(i
) Then 'start new newCritter i
If distance
(x
(i
), y
(i
), mx
, my
) < 75 Then predatorMode = 1
predatorMode = 0
'update points
x
(i
) = x
(i
) + 10 * Cos(a
(i
)) + Rnd * noise
- .5 * noise
y
(i
) = y
(i
) + 10 * Sin(a
(i
)) + Rnd * noise
- .5 * noise
drawBoid i
'mouse predator
'COLOR _RGB32(160, 0, 0)
'fcirc mx, my, 25
side = rand(2, 3)
x(index) = rand(xmax, xmax + 100)
y(index) = rand(20, ymax - 20)
a
(index
) = _D2R(rand
(100, 260)) x(index) = rand(-100, 0)
y(index) = rand(20, ymax - 20)
a
(index
) = _D2R(rand
(-80, 80))
x(index) = rand(20, xmax - 20)
y(index) = rand(-100, 0)
a
(index
) = _D2R(rand
(10, 170))
x(index) = rand(20, xmax - 20)
y(index) = rand(ymax, ymax + 100)
a
(index
) = _D2R(rand
(190, 350))
r(index) = rand(10, 12)
r
= rand
(10 + Int(z
(i
) * 40), 40 + Int(z
(i
) * 40))
'SUB critter (i)
' COLOR c&(i)
' 'fcirc x(i), y(i), r(i)
' IF predator THEN
' x1 = x(i) + .75 * r(i) * COS(a(i) - _PI(1 / 9) + _PI)
' y1 = y(i) + .75 * r(i) * SIN(a(i) - _PI(1 / 9) + _PI)
' x2 = x(i) + .75 * r(i) * COS(a(i) + _PI(1 / 9) + _PI)
' y2 = y(i) + .75 * r(i) * SIN(a(i) + _PI(1 / 9) + _PI)
' ELSE
' x1 = x(i) + .75 * r(i) * COS(a(i) - _PI(1 / 9))
' y1 = y(i) + .75 * r(i) * SIN(a(i) - _PI(1 / 9))
' x2 = x(i) + .75 * r(i) * COS(a(i) + _PI(1 / 9))
' y2 = y(i) + .75 * r(i) * SIN(a(i) + _PI(1 / 9))
' END IF
' COLOR _RGB32(255, 255, 255)
' ' fcirc x1, y1, .25 * r(i)
' 'fcirc x2, y2, .25 * r(i)
' IF predator THEN
' x3 = x1 + .125 * r(i) * COS(a(i) + _PI)
' y3 = y1 + .125 * r(i) * SIN(a(i) + _PI)
' x4 = x2 + .125 * r(i) * COS(a(i) + _PI)
' y4 = y2 + .125 * r(i) * SIN(a(i) + _PI)
' ELSE
' x3 = x1 + .125 * r(i) * COS(a(i))
' y3 = y1 + .125 * r(i) * SIN(a(i))
' x4 = x2 + .125 * r(i) * COS(a(i))
' y4 = y2 + .125 * r(i) * SIN(a(i))
' END IF
' COLOR _RGB32(0, 0, 0)
' ' fcirc x3, y3, .125 * r(i)
' 'fcirc x4, y4, .125 * r(i)
'END SUB
r
= Rnd * _Pi(1 / 4) 'flapping x1
= x
(i
) + z
(i
) * r
(i
) * Cos(a
(i
) + _Pi) y1
= y
(i
) + z
(i
) * r
(i
) * Sin(a
(i
) + _Pi) x2
= x
(i
) + z
(i
) * r
(i
) * Cos(a
(i
) + _Pi + w
+ r
) y2
= y
(i
) + z
(i
) * r
(i
) * Sin(a
(i
) + _Pi + w
+ r
) x3
= x
(i
) + z
(i
) * r
(i
) * Cos(a
(i
) + _Pi - w
- r
) y3
= y
(i
) + z
(i
) * r
(i
) * Sin(a
(i
) + _Pi - w
- r
)
x1
= x
(i
) + z
(i
) * r
(i
) * Cos(a
(i
)) y1
= y
(i
) + z
(i
) * r
(i
) * Sin(a
(i
)) x2
= x
(i
) + z
(i
) * r
(i
) * Cos(a
(i
) + w
+ r
) y2
= y
(i
) + z
(i
) * r
(i
) * Sin(a
(i
) + w
+ r
) x3
= x
(i
) + z
(i
) * r
(i
) * Cos(a
(i
) - w
- r
) y3
= y
(i
) + z
(i
) * r
(i
) * Sin(a
(i
) - w
- r
) filltri x(i), y(i), x1, y1, x2, y2, c(i)
filltri x(i), y(i), x1, y1, x3, y3, c(i)
' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
''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
rand%
= Int(Rnd * (hi%
- lo%
+ 1)) + lo%
distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
'the sky
midInk 0, 0, 128, 128, 128, 255, i / ymax
'the land
startH = ymax - 200
rr = 70: gg = 70: bb = 90
Xright = 0
y = startH
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
upDown
= (Rnd * .8 - .35) * (mountain
* .5) range = Xright + rand(15, 25) * 2.5 / mountain
lastx = Xright - 1
y = y + upDown
Line (lastx
, y
)-(X
, ymax
), , BF
'just lines weren't filling right lastx = X
Xright = range
rr = rand(rr - 15, rr): gg = rand(gg - 15, gg): bb = rand(bb - 25, bb)
startH = startH + rand(5, 20)
Sub midInk
(r1
, g1
, b1
, r2
, g2
, b2
, fr
) Color _RGB(r1
+ (r2
- r1
) * fr
, g1
+ (g2
- g1
) * fr
, b1
+ (b2
- b1
) * fr
)