_Title "Boids Remake 2022-03" ' b+ 2022-03-19 ' from JB Boids Restart #6 Wings b+ 2022-03-19
Const xmax
= 1200, ymax
= 700, pi
= _Pi, nb
= 100, no
= 7, np
= 3 Const green
= _RGB32(0, 160, 0), blue
= _RGB32(0, 0, 160), black
= _RGB32(0, 0, 0), brown
= _RGB32(100, 80, 40) Dim As Long done
, headmode
, centermode
, i
, j
, testx
, testy
, iter
Dim As Single px
(np
), py
(np
), pa
(np
) ' Predator radius is const 10 or so, twice a bird at least Dim As Single ox
(no
), oy
(no
), ord
(no
) ' obstacle x, y, radius Dim As Single bx
(nb
), by
(nb
), ba
(nb
), da
(nb
, nb
) ' new da = distance array headmode = 1 ' on / off
hf = .3 ' % of 100 pixels distance .1 = 10
centermode = 0 ' on / off
cf = .2 'centering factor how strong a pull from 0 to 1 .01 is week .1 pretty strong!
For i
= 1 To no
' in array for redraw ox(i) = rand(90, xmax - 90): oy(i) = rand(90, ymax - 90): ord(i) = rand(25, 90)
testAgain: ' don't start a bird inside an obstacle
testx = rand(20, xmax - 20) ' start random screen x, y away from borders
testy = rand(20, ymax - 20)
j = 0
While j
< no
' note get strange results with For loop j = j + 1
If distance
(testx
, testy
, ox
(j
), oy
(j
)) < ord
(j
) + 10 Then GoTo testAgain
j = 0
While j
< i
- 1 'no bird crowds please note get strange results with For loop j = j + 1
If distance
(testx
, testy
, bx
(j
), by
(j
)) < 15 Then GoTo testAgain
bx
(i
) = testx: by
(i
) = testy: ba
(i
) = 2 * pi
* Rnd: bw
(i
) = Int(3 * Rnd) ' random headingsFor i
= 1 To np
' might be smarter to pack the smaller after the larger, ie do predators before birds testAgain2: ' don't start a predator inside an obstacle
testx = rand(40, xmax - 40) ' start random screen x, y away from borders
testy = rand(40, ymax - 40)
j = 0
While j
< no
' note get strange results with For loop j = j + 1
If distance
(testx
, testy
, ox
(j
), oy
(j
)) < ord
(j
) + 10 Then GoTo testAgain2
j = 0
While j
< nb
' give birds some space from predators too j = j + 1
If distance
(testx
, testy
, bx
(j
), by
(j
)) < 30 Then GoTo testAgain2
px
(i
) = testx: py
(i
) = testy: pa
(i
) = 2 * pi
* Rnd: pw
(i
) = Int(5 * Rnd) fcirc ox(i), oy(i), ord(i), brown
For i
= 1 To nb
- 1 ' find all the distances between birds For j
= i
+ 1 To nb
' fix bonehead error of doing this 2x's! thanks tsh73 for catch! da(i, j) = distance(bx(i), by(i), bx(j), by(j))
da(j, i) = da(i, j) ' symetric relationship
For i
= 1 To np
' Predators are just like a birds pw
(i
) = (1 + pw
(i
)) Mod 5 ' flapper wings or not DrawBird px(i), py(i), 15, pa(i), pw(i), blue
s
= Rnd * 4 + 3 ' get some bird separation here? px
(i
) = px
(i
) + s
* Cos(pa
(i
)): py
(i
) = py
(i
) + s
* Sin(pa
(i
)) j = 0
While j
< no
' note get strange results with For loop j = j + 1
If distance
(px
(i
), py
(i
), ox
(j
), oy
(j
)) < ord
(j
) + 23 Then ao
= _Atan2(oy
(j
) - py
(i
), ox
(j
) - px
(i
)) pa(i) = AngleAve(pa(i), ao - pi)
' JB&LB have better Mod function! tsh73 pointed it to me
px(i) = Mod2(px(i) + xmax, xmax)
py(i) = Mod2(py(i) + ymax, ymax)
' except predators don't flock
For i
= 1 To nb
'draw then update positions of birds ' draw current
bw
(i
) = (bw
(i
) + 1) Mod 4 ' flapper wings or not DrawBird bx(i), by(i), 8, ba(i), bw(i), black
s = rand(3, 7) ' get some bird separation here?
bx
(i
) = bx
(i
) + s
* Cos(ba
(i
)): by
(i
) = by
(i
) + s
* Sin(ba
(i
)) j = 0
While j
< no
' note get strange results with For loop j = j + 1
If distance
(bx
(i
), by
(i
), ox
(j
), oy
(j
)) < ord
(j
) + 13 Then ao
= _Atan2(oy
(j
) - by
(i
), ox
(j
) - bx
(i
)) ba(i) = AngleAve(ba(i), ao - pi)
j = 0
j = j + 1
If distance
(bx
(i
), by
(i
), px
(j
), py
(j
)) < 65 Then ao
= _Atan2(py
(j
) - by
(i
), px
(j
) - bx
(i
)) ba(i) = AngleAve(ba(i), ao - pi)
' JB&LB have better Mod function! tsh73 pointed it to me
bx(i) = Mod2(bx(i) + xmax, xmax)
by(i) = Mod2(by(i) + ymax, ymax)
dist = da(i, j)
If dist
< 50 Then ' birds are close enough to influence each other by visual 'sway the neighbors headings towards each other
ba(i) = AngleAve(ba(i), AngleAve(ba(i), ba(j)))
ba(j) = AngleAve(ba(j), AngleAve(ba(i), ba(j)))
'stickiness stay close to neighbors, close distance between
bx(i) = bx(i) - cf / 10 * (bx(i) - bx(j))
bx(j) = bx(j) + cf / 10 * (bx(i) - bx(j))
by(i) = by(i) - cf / 10 * (by(i) - by(j))
by(j) = by(j) + cf / 10 * (by(i) - by(j))
If dist
< 20 Then ' too close!!! bx(i) = bx(i) + .1 * (bx(i) - bx(j))
bx(j) = bx(j) - .1 * (bx(i) - bx(j))
by(i) = by(i) + .1 * (by(i) - by(j))
by(j) = by(j) - .1 * (by(i) - by(j))
rand&
= Int((hi
- lo
+ 1) * Rnd + lo
)
Function distance
(x1
, y1
, x2
, y2
) ' default single OK distance
= Sqr((x1
- x2
) * (x1
- x2
) + (y1
- y2
) * (y1
- y2
))
Function AngleAve
(ra1
, ra2
) ' default single OK Dim twoPi
, ray1
, ray2
, rtn
twoPi = pi * 2
ray1 = Mod2(ra1 + twoPi, twoPi)
ray2 = Mod2(ra2 + twoPi, twoPi)
rtn = (ray1 + ray2) / 2
If Abs(ray1
- ray2
) > pi
Then rtn
= Mod2
(rtn
- pi
+ twoPi
, twoPi
) AngleAve = rtn
Dim x1
, y1
, x2
, y2
, x3
, y3
x2
= xc
+ rr
* Cos(ra
- .9 * pi
) y2
= yc
+ rr
* Sin(ra
- .9 * pi
) x3
= xc
+ rr
* Cos(ra
+ .9 * pi
) y3
= yc
+ rr
* Sin(ra
+ .9 * pi
) ftri x1, y1, xc, yc, x2, y2, c
ftri x1, y1, xc, yc, x3, y3, c
x2
= xc
+ 2 * rr
* Cos(ra
- 1.57 * pi
) y2
= yc
+ 2 * rr
* Sin(ra
- 1.57 * pi
) x3
= xc
+ 2 * rr
* Cos(ra
+ 1.57 * pi
) y3
= yc
+ 2 * rr
* Sin(ra
+ 1.57 * pi
) ftri xc, yc, x2, y2, x3, y3, c
' this allows us to do floats including negative floats
rtn
= modulus
* (Abs(n
) / modulus
- Int(Abs(n
) / modulus
)) Mod2# = rtn
Radius
= Abs(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 Line (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
Line (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
Line (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
Line (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
Line (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF
_Blend a&
'<<<< new 2019-12-16 fix
