Boid Watching

[bplus]

Now with obstacles:

' Boids Restart #4 Obstacles  b+ 2022-03-17

' >>>>>>>>>>>>>>>>>>>>>  Escape Key will now call it Quits!

global H$, xmax, ymax, pi, deg, rad, nb, done
H$ = "gr"
xmax = 800 '<== actual drawing space desired
ymax = 600 '<=== actual drawing space desired
pi = acs(-1)
deg = 180 / pi ' radian 2 degree mult
rad = pi / 180 ' degree 2 radian mult
nb = 50 ' number of birds
no = 7 ' number of obstacles
done = 0

dim ox(no), oy(no), ord(no)  ' obstacle x, y, radius
dim bx(nb), by(nb), ba(nb), oldx(nb), oldy(nb), da(nb, nb), oldba(nb)  ' new  da = distance array

headMode = 1    ' on / off
' sway = pi/6     'just turn neighbor towards neighbor
hf = .1         ' % of 100 pixels distance .1 = 10

centerMode = 1  ' on / off
cf = .01       'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 30

open "Boids Restart #4 Obstacles" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill green"
for i = 1 to no
   ox(i) = rand(50, xmax-50) : oy(i) = rand(50, ymax-50) : ord(i) = rand(10, 60)
   #gr "color brown"
   #gr "backcolor brown"
   #gr "place ";ox(i);" ";oy(i);"; circlefilled ";ord(i)
next
for i = 1 to nb
   [testAgain]  ' don't start a bird inside an obstacle
   testx = rand(50, xmax - 50) ' start random screen x, y away from borders
   testy = rand(50, ymax - 50)
   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]
   wend
   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]
   wend
   bx(i) = testx : by(i) = testy : ba(i) = 2 * pi * rnd(0)       ' random headings
next

while done = 0
   scan
   for i = 1 to nb  ' find all the distances between birds
       scan
   for j = 1 to nb
       scan
       if j <> i then
           scan
           da(i, j) = distance(bx(i), by(i), bx(j), by(j))
           da(j, i) = da(i, j) ' symetric relationship
       end if
   next
   next

   for i = 1 to nb 'draw then update positions
       'erase old
       #gr "color green"
       #gr "backcolor green"
       #gr "place ";oldx(i);" ";oldy(i);"; circlefilled ";5
       call DrawArrow oldx(i), oldy(i), oldba(i), 15, "green"
       ' draw current
       #gr "color black"
       #gr "backcolor black"
       #gr "place ";bx(i);" ";by(i);"; circlefilled ";5
       call DrawArrow bx(i), by(i), ba(i), 15, "white"
       oldx(i) = bx(i) : oldy(i) = by(i) : oldba(i) = ba(i)

       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)
           end if
       wend

       ' in one ear and out the other
       if bx(i) > 0 then bx(i) = bx(i) mod xmax
       if by(i) > 0 then by(i) = by(i) mod ymax
       if bx(i) < 0 then bx(i) = xmax + bx(i)
       if by(i) < 0 then by(i) = ymax + by(i)

       for j = i + 1 to nb
           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
               if headMode and rnd(0) < hf then
                   ba(i) =  angleAve(ba(i), angleAve(ba(i), ba(j)))
                   ba(j) =  angleAve(angleAve(ba(i), ba(j)), ba(j))
               end if
           end if

           if dist > 20 and dist < 50 then
               'stickiness stay close to neighbors, close distance between
               if centerMode and rnd(0) < cf then
                   if bx(i) > bx(j) then
                       bx(i) = bx(i) - cf/10 * (bx(i) - bx(j))
                       bx(j) = bx(j) + cf/10 * (bx(i) - bx(j))
                   else
                       bx(i) = bx(i) + cf/10 * (bx(j) - bx(i))
                       bx(j) = bx(j) - cf/10 * (bx(j) - bx(i))
                   end if
                   if by(i) > by(j) then
                       by(i) = by(i) - cf/10 * (by(i) - by(j))
                       by(j) = by(j) + cf/10 * (by(i) - by(j))
                   else
                       by(i) = by(i) + cf/10 * (by(j) - by(i))
                       by(j) = by(j) - cf/10 * (by(j) - by(i))
                   end if
               end if
           end if
       next 'j
   next ' i
wend
wait

sub lButtonUp Handle$, mx, my  'must have handle and mouse x,y

end sub

sub charIn Handle$, c$
   if asc(c$) = 27 then call quit Handle$
end sub

'Need line: #gr "trapclose quit"
sub quit Handle$
   close #Handle$
   end
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Function Atan2(y,x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-pi to pi radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(1)) + lo
end function

function rMinus()  ' plus or minus 1 multiplier
   if rnd(0) < .5 then rMinus = -1 else rMinus = 1
end function

function distance(x1, y1, x2, y2)
   distance = sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)) ' I removed spaces on off change they might add to processing time
end function

Function angleAve (ra1, ra2) ' needs NormalRA
   ray1 = NormalRA(ra1): ray2 = NormalRA(ra2)
   rtn = (ray1 + ray2) / 2
   If ray1 > ray2 And ray1 - ray2 > pi Then
       rtn = NormalRA(rtn - pi)
   Else
       If ray2 > ray1 And ray2 - ray1 > pi Then rtn = NormalRA(rtn - pi)
   End If
   angleAve = rtn
End Function

Function NormalRA (ra) 'keep angle >=0 < 2*pi
   If ra >=  2*pi Then
       rtn = ra - 2*pi
   Else
       If ra < 0 Then rtn = ra + 2*pi Else rtn = ra
   End If
   NormalRA = rtn
End Function

Sub DrawArrow xc, yc, ra, lngth, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + .5 * lngth * Cos(ra)
   y1 = yc + .5 * lngth * Sin(ra)
   x2 = xc + .5 * lngth * Cos(ra - pi)
   y2 = yc + .5 * lngth * Sin(ra - pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra - .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra - .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra + .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra + .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
End Sub



[bplus]

Now with Predators!
' Boids Restart #5 Predators  b+ 2022-03-17

' >>>>>>>>>>>>>>>>>>>>>  Escape Key will now call it Quits!

global H$, xmax, ymax, pi, deg, rad, nb, done
H$ = "gr"
xmax = 800 '<== actual drawing space desired
ymax = 600 '<=== actual drawing space desired
pi = acs(-1)
deg = 180 / pi ' radian 2 degree mult
rad = pi / 180 ' degree 2 radian mult
nb = 50 ' number of birds
no = 7 ' number of obstacles
np = 3 'number of predators
done = 0

dim px(np), py(np), pa(np), oldpx(np), oldpy(np), oldpa(np) ' Predator radius is const 10 or so, twice a bird at least
dim ox(no), oy(no), ord(no)  ' obstacle x, y, radius
dim bx(nb), by(nb), ba(nb), oldx(nb), oldy(nb), da(nb, nb), oldba(nb)  ' new  da = distance array

headMode = 1    ' on / off
' sway = pi/6     'just turn neighbor towards neighbor
hf = .1         ' % of 100 pixels distance .1 = 10

centerMode = 1  ' on / off
cf = .01       'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 30

open "Boids Restart #5 Predators" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill green"
for i = 1 to no
   ox(i) = rand(50, xmax-50) : oy(i) = rand(50, ymax-50) : ord(i) = rand(10, 60)
   #gr "color brown"
   #gr "backcolor brown"
   #gr "place ";ox(i);" ";oy(i);"; circlefilled ";ord(i)
next
for i = 1 to nb
   [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]
   wend
   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]
   wend
   bx(i) = testx : by(i) = testy : ba(i) = 2 * pi * rnd(0)       ' random headings
next
for 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]
   wend
   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]
   wend
   px(i) = testx : py(i) = testy : pa(i) = 2 * pi * rnd(0)
next

while done = 0
   scan
   for i = 1 to nb  ' find all the distances between birds
       scan
       for j = 1 to nb
           scan
           if j <> i then
               scan
               da(i, j) = distance(bx(i), by(i), bx(j), by(j))
               da(j, i) = da(i, j) ' symetric relationship
           end if
       next
   next

   for i = 1 to np ' Predators are just like a birds
       'erase old
       #gr "color green"
       #gr "backcolor green"
       #gr "place ";oldpx(i);" ";oldpy(i);"; circlefilled ";10
       call DrawArrow oldpx(i), oldpy(i), oldpa(i), 30, "green"
       ' draw current
       #gr "color blue"
       #gr "backcolor blue"
       #gr "place ";px(i);" ";py(i);"; circlefilled ";10
       call DrawArrow px(i), py(i), pa(i), 30, "white"
       oldpx(i) = px(i) : oldpy(i) = py(i) : oldpa(i) = pa(i)

       s = rand(3, 7) ' 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)
           end if
       wend

       ' in one ear and out the other
       if px(i) > 0 then px(i) = px(i) mod xmax
       if py(i) > 0 then py(i) = py(i) mod ymax
       if px(i) < 0 then px(i) = xmax + px(i)
       if py(i) < 0 then py(i) = ymax + py(i)

       ' except predators don't flock
   next

   for i = 1 to nb 'draw then update positions of birds
       'erase old
       #gr "color green"
       #gr "backcolor green"
       #gr "place ";oldx(i);" ";oldy(i);"; circlefilled ";5
       call DrawArrow oldx(i), oldy(i), oldba(i), 15, "green"
       ' draw current
       #gr "color black"
       #gr "backcolor black"
       #gr "place ";bx(i);" ";by(i);"; circlefilled ";5
       call DrawArrow bx(i), by(i), ba(i), 15, "white"
       oldx(i) = bx(i) : oldy(i) = by(i) : oldba(i) = ba(i)

       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)
           end if
       wend

       j = 0
       while j < np
           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)
           end if
       wend

       ' in one ear and out the other
       if bx(i) > 0 then bx(i) = bx(i) mod xmax
       if by(i) > 0 then by(i) = by(i) mod ymax
       if bx(i) < 0 then bx(i) = xmax + bx(i)
       if by(i) < 0 then by(i) = ymax + by(i)

       for j = i + 1 to nb
           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
               if headMode and rnd(0) < hf then
                   ba(i) =  angleAve(ba(i), angleAve(ba(i), ba(j)))
                   ba(j) =  angleAve(angleAve(ba(i), ba(j)), ba(j))
               end if
           end if

           if dist > 20 and dist < 50 then
               'stickiness stay close to neighbors, close distance between
               if centerMode and rnd(0) < cf then
                   if bx(i) > bx(j) then
                       bx(i) = bx(i) - cf/10 * (bx(i) - bx(j))
                       bx(j) = bx(j) + cf/10 * (bx(i) - bx(j))
                   else
                       bx(i) = bx(i) + cf/10 * (bx(j) - bx(i))
                       bx(j) = bx(j) - cf/10 * (bx(j) - bx(i))
                   end if
                   if by(i) > by(j) then
                       by(i) = by(i) - cf/10 * (by(i) - by(j))
                       by(j) = by(j) + cf/10 * (by(i) - by(j))
                   else
                       by(i) = by(i) + cf/10 * (by(j) - by(i))
                       by(j) = by(j) - cf/10 * (by(j) - by(i))
                   end if
               end if
           end if
       next 'j
   next ' i
wend
wait

sub lButtonUp Handle$, mx, my  'must have handle and mouse x,y

end sub

sub charIn Handle$, c$
   if asc(c$) = 27 then call quit Handle$
end sub

'Need line: #gr "trapclose quit"
sub quit Handle$
   close #Handle$
   end
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Function Atan2(y,x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-pi to pi radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(1)) + lo
end function

function rMinus()  ' plus or minus 1 multiplier
   if rnd(0) < .5 then rMinus = -1 else rMinus = 1
end function

function distance(x1, y1, x2, y2)
   distance = sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)) ' I removed spaces on off change they might add to processing time
end function

Function angleAve (ra1, ra2) ' needs NormalRA
   ray1 = NormalRA(ra1): ray2 = NormalRA(ra2)
   rtn = (ray1 + ray2) / 2
   If ray1 > ray2 And ray1 - ray2 > pi Then
       rtn = NormalRA(rtn - pi)
   Else
       If ray2 > ray1 And ray2 - ray1 > pi Then rtn = NormalRA(rtn - pi)
   End If
   angleAve = rtn
End Function

Function NormalRA (ra) 'keep angle >=0 < 2*pi
   If ra >=  2*pi Then
       rtn = ra - 2*pi
   Else
       If ra < 0 Then rtn = ra + 2*pi Else rtn = ra
   End If
   NormalRA = rtn
End Function

Sub DrawArrow xc, yc, ra, lngth, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + .5 * lngth * Cos(ra)
   y1 = yc + .5 * lngth * Sin(ra)
   x2 = xc + .5 * lngth * Cos(ra - pi)
   y2 = yc + .5 * lngth * Sin(ra - pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra - .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra - .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra + .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra + .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
End Sub


[tsh73]

Interesting things you do here
I added FPS counter and removed (commented) some of checks that happens to be not needed
(or changed IF to MOD)
It looks like it works the same abeit a bit faster
so, from last complete program
OOPS
from last complete program with blue BG (you guys are frighteningly fast!)
' Boids Restart #3 Heading Where  b+ 2022-03-14

' >>>>>>>>>>>>>>>>>>>>>  Escape Key will now call it Quits!

global H$, xmax, ymax, pi, deg, rad, nb, speed, done, twoPi
H$ = "gr"
xmax = 800 '<== actual drawing space desired
ymax = 600 '<=== actual drawing space desired
pi = acs(-1)
twoPi=2*pi

deg = 180 / pi ' radian 2 degree mult
rad = pi / 180 ' degree 2 radian mult
nb = 50 ' number of birds
speed = 5
done = 0

dim bx(nb), by(nb), ba(nb), oldx(nb), oldy(nb), da(nb, nb), oldba(nb)  ' new  da = distance array
for i = 1 to nb
   bx(i) = rand(100, xmax - 100) ' start random screen x, y away from borders
   by(i) = rand(100, ymax - 100)
   ba(i) = 2 * pi * rnd(0)       ' random headings
next

headMode = 1    ' on / off
' sway = pi/6     'just turn neighbor towards neighbor
hf = .1         ' % of 100 pixels distance .1 = 10

centerMode = 1  ' on / off
cf = .01       'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 30

open "Boids Restart #3 Heading Where" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill blue"


while done = 0
   iter=iter+1
   if t1$<>time$("sec") then
       t1$=time$("sec")
       #gr "place 10 30; backcolor blue"
       #gr "\FPS ";iter;" "
       iter=0
   end if


   scan
   'for i = 1 to nb  ' find all the distances between birds
   for i = 1 to nb-1  ' find all the distances between birds
       scan
   'for j = 1 to nb
   for j = i to nb
       scan
       'if j <> i then
           scan
           da(i, j) = distance(bx(i), by(i), bx(j), by(j))
           da(j, i) = da(i, j) ' symetric relationship
       'end if
   next
   next

   for i = 1 to nb 'draw then update positions
       'erase old
       #gr "color blue"
       #gr "backcolor blue"
       #gr "place ";oldx(i);" ";oldy(i);"; circlefilled ";4
       call DrawArrow oldx(i), oldy(i), oldba(i), 15, "blue"
       ' draw current
       #gr "color black"
       #gr "backcolor black"
       #gr "place ";bx(i);" ";by(i);"; circlefilled ";4
       call DrawArrow bx(i), by(i), ba(i), 15, "white"
       oldx(i) = bx(i) : oldy(i) = by(i) : oldba(i) = ba(i)

       s = rand(3, 7) ' get some bird separation here?
       dx = s * cos(ba(i)) : dy = s * sin(ba(i))
       testx = bx(i) + dx : testy = by(i) + dy

       ' fix ba() for comparing
       'ba(i) = NormalRA(ba(i))

       ' in one ear and out the other
       'if testx > 0 then bx(i) = testx mod xmax
       'if testy > 0 then by(i) = testy mod ymax
       'if testx < 0 then bx(i) = xmax + testx
       'if testy < 0 then by(i) = ymax + testy

       bx(i) = (testx+ xmax) mod xmax
       by(i) = (testy+ ymax) mod ymax

       for j = i + 1 to nb
           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
               if headMode and rnd(0) < hf then
                   ba(i) =  angleAve(ba(i), ba(j))
                   ba(j) =  angleAve(ba(i), ba(j))
               end if
           end if

           if dist > 20 and dist < 50 then
               'stickiness stay close to neighbors, close distance between
               if centerMode and rnd(0) < cf then
                   bx(i) = bx(i) - cf/10 *(bx(i) - bx(j))
                   bx(j) = bx(j) + cf/10 *(bx(i) - bx(j))
                   'if bx(i) > bx(j) then
                   '    bx(i) = bx(i) - cf/10 * (bx(i) - bx(j))
                   '    bx(j) = bx(j) + cf/10 * (bx(i) - bx(j))
                   'else
                   '    bx(i) = bx(i) + cf/10 * (bx(j) - bx(i))
                   '    bx(j) = bx(j) - cf/10 * (bx(j) - bx(i))
                   'end if
                   by(i) = by(i) - cf/10 * (by(i) - by(j))
                   by(j) = by(j) + cf/10 * (by(i) - by(j))
                   'if by(i) > by(j) then
                   '    by(i) = by(i) - cf/10 * (by(i) - by(j))
                   '    by(j) = by(j) + cf/10 * (by(i) - by(j))
                   'else
                   '    by(i) = by(i) + cf/10 * (by(j) - by(i))
                   '    by(j) = by(j) - cf/10 * (by(j) - by(i))
                   'end if
               end if
           end if
       next 'j
   next ' i
wend
wait

sub lButtonUp Handle$, mx, my  'must have handle and mouse x,y

end sub

sub charIn Handle$, c$
   if asc(c$) = 27 then call quit Handle$
end sub

'Need line: #gr "trapclose quit"
sub quit Handle$
   close #Handle$
   end
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Function Atan2(y,x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-pi to pi radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(0)) + lo
end function

function rMinus()  ' plus or minus 1 multiplier
   if rnd(0) < .5 then rMinus = -1 else rMinus = 1
end function

function distance(x1, y1, x2, y2)
   distance = sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)) ' I removed spaces on off change they might add to processing time
end function

Function angleAve (ra1, ra2) ' needs NormalRA
   'ray1 = NormalRA(ra1): ray2 = NormalRA(ra2)
   'rtn = (ray1 + ray2) / 2
   'If ray1 > ray2 And ray1 - ray2 > pi Then
   '    rtn = NormalRA(rtn - pi)
   'Else
   '    If ray2 > ray1 And ray2 - ray1 > pi Then rtn = NormalRA(rtn - pi)
   'End If

   ray1 = (ra1 + twoPi) mod twoPi
   ray2 = (ra2 + twoPi) mod twoPi
   rtn = (ray1 + ray2) / 2
   if abs(ray1-ray2) > pi Then rtn = (rtn-pi + twoPi) mod twoPi

   angleAve = rtn
End Function

Function NormalRA (ra) 'keep angle >=0 < 2*pi
   If ra >=  2*pi Then
       rtn = ra - 2*pi
   Else
       If ra < 0 Then rtn = ra + 2*pi Else rtn = ra
   End If
   NormalRA = rtn
End Function

Sub DrawArrow xc, yc, ra, lngth, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + .5 * lngth * Cos(ra)
   y1 = yc + .5 * lngth * Sin(ra)
   x2 = xc + .5 * lngth * Cos(ra - pi)
   y2 = yc + .5 * lngth * Sin(ra - pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra - .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra - .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra + .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra + .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
End Sub



[bplus]

Well this was flat out bone head mistake:
   scan
   'for i = 1 to nb  ' find all the distances between birds
   for i = 1 to nb-1  ' find all the distances between birds
       scan
   'for j = 1 to nb  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< bone head mistake should be i+1 to nb, it's why I listed both da(i, j) AND da(j, i)!
   for j = i to nb
       scan
       'if j <> i then  ' <<<<<<<<<<<< this should save time because don't need 0 we already know. course the decision to skip might slow things down
           scan
           da(i, j) = distance(bx(i), by(i), bx(j), by(j))
           da(j, i) = da(i, j) ' symetric relationship
       'end if
   next
   next

Who would guess that mod works on float like pi or TwoPi?!?
Function AngleAve (ra1, ra2) ' needs NormalRA
   'ray1 = NormalRA(ra1): ray2 = NormalRA(ra2)
   'rtn = (ray1 + ray2) / 2
   'If ray1 > ray2 And ray1 - ray2 > pi Then
   '    rtn = NormalRA(rtn - pi)
   'Else
   '    If ray2 > ray1 And ray2 - ray1 > pi Then rtn = NormalRA(rtn - pi)
   'End If
   twoPi = pi * 2
   ray1 = (ra1 + twoPi) mod twoPi
   ray2 = (ra2 + twoPi) mod twoPi
   rtn = (ray1 + ray2) / 2
   if abs(ray1-ray2) > pi Then rtn = (rtn-pi + twoPi) mod twoPi

   AngleAve = rtn
End Function


But AngleAve does seem to work correctly with tsh73 version:

' AngleAve DrawArrow NormalRA.txt b+ 2022-03-16
global XMAX, YMAX, pi
XMAX = 500 '<======================================== actual drawing space needed
YMAX = 500 '<======================================== actual drawing space needed
pi = acs(-1)

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (700 - YMAX) / 2   'or delete if YMAX is 700 or above

open "AngleAve DrawArrow NormalRA" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "down"

'_Title "Average of Angles" 'b+ 2022-03-14 this comes up in Boids
a1 = pi : a2 = 2 * pi
while 1
   scan
   #gr "fill black"
   #gr "color white"
   #gr "backcolor black"
   call ctext 30, "Red and Blue arrows are random, Yellow is their Average."
   call DrawArrow 250, 250, a1, 300, "red"
   call DrawArrow 250, 250, a2, 300, "blue"
   call DrawArrow 250, 250, AngleAve(a1, a2), 400, "yellow"
   a1 = Rnd(0) * 2 * pi: a2 = Rnd(0) * 2 * pi
   call pause 2000
wend
wait

sub ctext y, message$  'uses const XMAX and sub stext
   call stext (XMAX - len(message$) * 7) /2, y, message$
end sub

sub stext x, y, message$ 'note: have to reset fore or back color after ink
   #gr "place ";x;" ";y;";|";message$
end sub

sub lButtonUp Handle$, mx, my  'must have handle and mouse x,y
   call quit Handle$          '<=== H$ global window handle
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

sub quit Handle$
   close #Handle$
   end
end sub

'Function AngleAve (ra1, ra2) ' needs NormalRA
'    ray1 = NormalRA(ra1): ray2 = NormalRA(ra2)
'    rtn = (ray1 + ray2) / 2
'    If ray1 > ray2 And ray1 - ray2 > pi Then
'        rtn = NormalRA(rtn - pi)
'    Else
'        If ray2 > ray1 And ray2 - ray1 > pi Then rtn = NormalRA(rtn - pi)
'    End If
'    AngleAve = rtn
'End Function

' tsh73 version
Function AngleAve (ra1, ra2) ' needs NormalRA
   'ray1 = NormalRA(ra1): ray2 = NormalRA(ra2)
   'rtn = (ray1 + ray2) / 2
   'If ray1 > ray2 And ray1 - ray2 > pi Then
   '    rtn = NormalRA(rtn - pi)
   'Else
   '    If ray2 > ray1 And ray2 - ray1 > pi Then rtn = NormalRA(rtn - pi)
   'End If
   twoPi = pi * 2
   ray1 = (ra1 + twoPi) mod twoPi
   ray2 = (ra2 + twoPi) mod twoPi
   rtn = (ray1 + ray2) / 2
   if abs(ray1-ray2) > pi Then rtn = (rtn-pi + twoPi) mod twoPi

   AngleAve = rtn
End Function

Function NormalRA (ra) 'keep angle >=0 < 2*pi
   If ra >= 2*pi Then
       rtn = ra - 2*pi
   Else
       If ra < 0 Then rtn = ra + 2*pi Else rtn = ra
   End If
   NormalRA = rtn
End Function

Sub DrawArrow xc, yc, ra, lngth, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + .5 * lngth * Cos(ra)
   y1 = yc + .5 * lngth * Sin(ra)
   x2 = xc + .5 * lngth * Cos(ra - pi)
   y2 = yc + .5 * lngth * Sin(ra - pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra - .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra - .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra + .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra + .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
End Sub



OK how much time did that save alone without the distance bone head mistake?

[tsh73]

OK how much time did that save alone without the distance bone head mistake?

I acould onle say about whole thing.
Did you seen that FPS code?
without changes I got 9-10 FPS (had to add " " at the end to clear that 0)
After changes, about 14 FPS
(but it was fast machine. My home computer shows 4-5 FPS! So I better show time pre frame.)

[tsh73]

It really feels like a fish
Not quite this
www.youtube.com/watch?v=UNOKO0rFfgg

but feels really close at about 15 fps (decreased fish count for that )

[bplus]

Very interesting what JB & LB can do with Mod (Compares much better than with another Basic)
pi = 3.1415
for i = 10 to -10 step -1
print i, i mod 3,  3 * (i / 3 - int(i/3)), i mod pi, pi * (i/pi - int(i/pi)) ' find remainder
next


Attachments:

[bplus]

Looks like I have a bunch of FPS to check!

Update 1: Original code from Object Paradign (JB) ran at 3, 4, 5, maybe 6 FPS  on my system, mostly 4's

Boids Restart #5 Predators: I am getting 6,7,8 on my system mostly 7's before I incorporate tsh73 improvements.

The first is to fix that bonehead distance iteration over all birds twice! I am betting that will improve time allot!
j is never going to = i so don't need that extra If check.
   for i = 1 to nb-1  ' find all the distances between birds
       for j = i+1 to nb
           scan
           da(i, j) = distance(bx(i), by(i), bx(j), by(j))
           da(j, i) = da(i, j) ' symetric relationship
       next
   next

FPS now 9,10 split between





       ' in one ear and out the other
       'if px(i) > 0 then px(i) = px(i) mod xmax
       'if py(i) > 0 then py(i) = py(i) mod ymax
       'if px(i) < 0 then px(i) = xmax + px(i)
       'if py(i) < 0 then py(i) = ymax + py(i)

       ' JB&LB have better Mod function!
       px(i) = (px(i) + xmax) mod xmax
       py(i) = (py(i) + ymax) mod ymax



       ' in one ear and out the other
       'if bx(i) > 0 then bx(i) = bx(i) mod xmax
       'if by(i) > 0 then by(i) = by(i) mod ymax
       'if bx(i) < 0 then bx(i) = xmax + bx(i)
       'if by(i) < 0 then by(i) = ymax + by(i)

       ' JB&LB have better Mod function!
       bx(i) = (bx(i) + xmax) mod xmax
       by(i) = (by(i) + ymax) mod ymax


Not a big change in FPS, oddly as birds start to cluster into tighter groups the FPS rate goes down fro 9, 10 to 7, 6!

Maybe the next change will help that because it concerns tight grouping of birds...

           if dist > 20 and dist < 50 then
               'stickiness stay close to neighbors, close distance between
               if centerMode and rnd(0) < cf then
                   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 bx(i) > bx(j) then
                   '    bx(i) = bx(i) - cf/10 * (bx(i) - bx(j))
                   '    bx(j) = bx(j) + cf/10 * (bx(i) - bx(j))
                   'else
                   '    bx(i) = bx(i) + cf/10 * (bx(j) - bx(i))
                   '    bx(j) = bx(j) - cf/10 * (bx(j) - bx(i))
                   'end if


                   'if by(i) > by(j) then
                   '    by(i) = by(i) - cf/10 * (by(i) - by(j))
                   '    by(j) = by(j) + cf/10 * (by(i) - by(j))
                   'else
                   '    by(i) = by(i) + cf/10 * (by(j) - by(i))
                   '    by(j) = by(j) - cf/10 * (by(j) - by(i))
                   'end if
               end if
           end if


FPS still runs 10, 9 to start drifts down to 8,9 then 7,8 and occasional 6. Still is probably faster.

Here is AngleAve that tsh73 revised and now no longer need NormalRA function
Function AngleAve (ra1, ra2) ' tsh73 version no longer needs NormalRA
   twoPi = pi * 2
   ray1 = (ra1 + twoPi) mod twoPi
   ray2 = (ra2 + twoPi) mod twoPi
   rtn = (ray1 + ray2) / 2
   if abs(ray1-ray2) > pi Then rtn = (rtn-pi + twoPi) mod twoPi
   AngleAve = rtn
End Function

I don't see any more change in FPS but it eliminates a whole Function, nice!

[bplus]

OK here is Boids Restart #5 Predators with tsh73 revisions and some other code cleared out:
' Boids Restart #5 Predators with tsh73 revisions b+ 2022-03-17

' >>>>>>>>>>>>>>>>>>>>>  Escape Key will now call it Quits!

global H$, xmax, ymax, pi, deg, rad, nb, done
H$ = "gr"
xmax = 800 '<== actual drawing space desired
ymax = 600 '<=== actual drawing space desired
pi = acs(-1)
deg = 180 / pi ' radian 2 degree mult
rad = pi / 180 ' degree 2 radian mult
nb = 50 ' number of birds
no = 7 ' number of obstacles
np = 3 'number of predators
done = 0

dim px(np), py(np), pa(np), oldpx(np), oldpy(np), oldpa(np) ' Predator radius is const 10 or so, twice a bird at least
dim ox(no), oy(no), ord(no)  ' obstacle x, y, radius
dim bx(nb), by(nb), ba(nb), oldx(nb), oldy(nb), da(nb, nb), oldba(nb)  ' new  da = distance array

headMode = 1    ' on / off
' sway = pi/6     'just turn neighbor towards neighbor
hf = .1         ' % of 100 pixels distance .1 = 10

centerMode = 1  ' on / off
cf = .01       'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 30

open "Boids Restart #5 Predators with tsh73 revisions" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"  ' no click code yet but we're ready
#gr "when characterInput charIn"
#gr "down"
#gr "fill green"
for i = 1 to no
   ox(i) = rand(50, xmax-50) : oy(i) = rand(50, ymax-50) : ord(i) = rand(10, 60)
   #gr "color brown"
   #gr "backcolor brown"
   #gr "place ";ox(i);" ";oy(i);"; circlefilled ";ord(i)
next
for i = 1 to nb
   [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]
   wend
   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]
   wend
   bx(i) = testx : by(i) = testy : ba(i) = 2 * pi * rnd(0)       ' random headings
next
for 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]
   wend
   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]
   wend
   px(i) = testx : py(i) = testy : pa(i) = 2 * pi * rnd(0)
next

while done = 0
   scan
   iter=iter+1  ' >>>> tsh73 drop in FPS counter
   if t1$<>time$("sec") then
       t1$=time$("sec")
       #gr "place 10 30; backcolor blue"
       #gr "\FPS ";right$("   "+str$(iter),3);" "
       iter=0
   end if
   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!
           scan
           da(i, j) = distance(bx(i), by(i), bx(j), by(j))
           da(j, i) = da(i, j) ' symetric relationship
       next
   next

   for i = 1 to np ' Predators are just like a birds
       'erase old
       #gr "color green"
       #gr "backcolor green"
       #gr "place ";oldpx(i);" ";oldpy(i);"; circlefilled ";10
       call DrawArrow oldpx(i), oldpy(i), oldpa(i), 30, "green"
       ' draw current
       #gr "color blue"
       #gr "backcolor blue"
       #gr "place ";px(i);" ";py(i);"; circlefilled ";10
       call DrawArrow px(i), py(i), pa(i), 30, "white"
       oldpx(i) = px(i) : oldpy(i) = py(i) : oldpa(i) = pa(i)
       s = rand(3, 7) ' 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)
           end if
       wend
       ' JB&LB have better Mod function! tsh73 pointed it to me
       px(i) = (px(i) + xmax) mod xmax
       py(i) = (py(i) + ymax) mod ymax
       ' except predators don't flock
   next

   for i = 1 to nb 'draw then update positions of birds
       'erase old
       #gr "color green"
       #gr "backcolor green"
       #gr "place ";oldx(i);" ";oldy(i);"; circlefilled ";5
       call DrawArrow oldx(i), oldy(i), oldba(i), 15, "green"
       ' draw current
       #gr "color black"
       #gr "backcolor black"
       #gr "place ";bx(i);" ";by(i);"; circlefilled ";5
       call DrawArrow bx(i), by(i), ba(i), 15, "white"
       oldx(i) = bx(i) : oldy(i) = by(i) : oldba(i) = ba(i)
       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)
           end if
       wend
       j = 0
       while j < np
           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)
           end if
       wend
       ' JB&LB have better Mod function! tsh73 pointed it to me
       bx(i) = (bx(i) + xmax) mod xmax
       by(i) = (by(i) + ymax) mod ymax

       for j = i + 1 to nb
           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
               if headMode and rnd(0) < hf then
                   ba(i) =  AngleAve(ba(i), AngleAve(ba(i), ba(j)))
                   ba(j) =  AngleAve(AngleAve(ba(i), ba(j)), ba(j))
               end if
           end if
           if dist > 20 and dist < 50 then
               'stickiness stay close to neighbors, close distance between
               if centerMode and rnd(0) < cf then
                   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))
               end if
           end if
       next 'j
   next ' i
wend
wait

sub charIn Handle$, c$
   if asc(c$) = 27 then call quit Handle$
end sub

sub quit Handle$
   close #Handle$
   end
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Function Atan2(y,x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-pi to pi radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(1)) + lo
end function

function distance(x1, y1, x2, y2)
   distance = sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)) ' I removed spaces on off change they might add to processing time
end function

Function AngleAve (ra1, ra2) ' tsh73 version no longer needs NormalRA
   twoPi = pi * 2
   ray1 = (ra1 + twoPi) mod twoPi
   ray2 = (ra2 + twoPi) mod twoPi
   rtn = (ray1 + ray2) / 2
   if abs(ray1-ray2) > pi Then rtn = (rtn-pi + twoPi) mod twoPi
   AngleAve = rtn
End Function

Sub DrawArrow xc, yc, ra, lngth, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + .5 * lngth * Cos(ra)
   y1 = yc + .5 * lngth * Sin(ra)
   x2 = xc + .5 * lngth * Cos(ra - pi)
   y2 = yc + .5 * lngth * Sin(ra - pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra - .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra - .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra + .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra + .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
End Sub




I vote tsh73 get a pay raise

[Rod]

@ B+ really nice, again surprisingly fast. I have not had enough free time to participate but I show this code simply to evidence the power of sorting. The code runs on my machine with 100 boids at 133 FPS. My flocking code is non existent, I just merge vectors when they meet.

   b=100 'number of boids
   c=25 'cohesion pixels
   a=.1 'amount of influence 1=100%
   s=2 'speed pixels
   ww=1200
   wh=700
   dim b(b,8) 'x,y,dx,dy,image,index
   x=1 : y=2 : dx=3 : dy=4 : im=5 : ix=6 : iy=7 :i=8
   for n= 1 to b
       b(n,x)=int(rnd(0)*ww)
       b(n,y)=int(rnd(0)*wh)
       b(n,dx)=1-rnd(0)*2
       b(n,dy)=1-rnd(0)*2
       b(n,im)=n
       b(n,ix)=int(b(n,x)/c)
       b(n,iy)=int(b(n,y)/c)
       b(n,i)=100*b(n,ix)+b(n,iy)
   next

   'nomainwin
   WindowWidth = ww+30
   WindowHeight =wh+60
   UpperLeftX = int((DisplayWidth-WindowWidth)/2)
   UpperLeftY = int((DisplayHeight-WindowHeight)/2)
   open "Boids" for graphics_nsb as #1
   #1 "down : place 0 0 ; backcolor white ; color white ; boxfilled 10 10"
   #1 "place 0 10 ; backcolor black ; color black ; boxfilled 10 20"
   #1 "place 5 15 ; color cyan ; backcolor cyan ; circlefilled 4"
   #1 "place 5 5 ;color black ; backcolor black ; circlefilled 4 ; getbmp boid 0 0 10 20"
   #1 "down ; fill black ; color white ; trapclose [quit]"
   #1 "getbmp bac 0 0 ";ww;" ";wh;" ; background bac"
   for n = 1 to b
       #1 "addsprite b";n;" boid"
       #1 "spritexy b";n;" ";b(n,x);" ";b(n,y)
   next

   'timer 33,[draw]

   [draw]
   #1 "drawsprites"

   'boid list is kept in y within x order
   sort b(,1,b,8

   'work this ordered list finding near boids
   'boids are grouped by a grid defined by ww/c and wh/c
   bn=1
   while bn<b
       xx=b(bn,ix)
       yy=b(bn,iy)
       ddx=b(bn,dx)
       ddy=b(bn,dy)
       nn=bn
       'if the boid is in the same sector sum the vector
       while bn<b and yy=b(bn,iy)
           ddx=(ddx+b(bn,dx))/2
           ddy=(ddy+b(bn,dy))/2
           bn=bn+1
       wend

       'now run back through the same boids
       'applying the changes
       while nn<b and yy=b(nn,iy)
           'merge to average vector
           b(nn,dx)=(b(nn,dx)+ddx)/2
           b(nn,dy)=(b(nn,dy)+ddy)/2
           'normalise the vector
           b(nn,dx)=b(nn,dx)/(abs(b(nn,dx))+abs(b(nn,dy)))
           b(nn,dy)=b(nn,dy)/(abs(b(nn,dx))+abs(b(nn,dy)))

           'move boid
           b(nn,x)=b(nn,x)+b(nn,dx)*s
           b(nn,y)=b(nn,y)+b(nn,dy)*s
           'update index for sorting
           b(nn,ix)=int(b(nn,x)/c)
           b(nn,iy)=int(b(nn,y)/c)
           b(nn,i)=100*b(nn,ix)+b(nn,iy)
           'bounce off walls
           if b(nn,x)>ww then b(nn,x)=b(nn,x)-ww
           if b(nn,x)<0 then b(nn,x)=b(nn,x)+ww
           if b(nn,y)>wh then b(nn,y)=b(nn,y)-wh
           if b(nn,y)<0 then b(nn,y)=b(nn,y)+wh

           'if b(nn,x)>=ww then b(nn,dx)=b(nn,dx)*-1
           'if b(nn,y)>=wh then b(nn,dy)=b(nn,dy)*-1
           'if b(nn,x)<0 then b(nn,dx)=b(nn,dx)*-1
           'if b(nn,y)<0 then b(nn,dy)=b(nn,dy)*-1
           #1 "spritexy b";b(nn,im);"  ";b(nn,x);" ";b(nn,y)
           nn=nn+1
       wend
   wend
   iter=iter+1
   if t1$<>time$("sec") then
       t1$=time$("sec")
       #1 "place 10 30; backcolor blue"
       #1 "\FPS ";iter;" "
       iter=0
   end if
   scan
   goto [draw]


[quit]
   timer 0
   close #1
   end



[bplus]

More bird like with wings:
' Boids Restart #6 Wings b+ 2022-03-19

' >>>>>>>>>>>>>>>>>>>>>  Escape Key will now call it Quits!

global H$, xmax, ymax, pi, deg, rad, nb, done
H$ = "gr"
xmax = 600 '<== actual drawing space desired
ymax = 400 '<=== actual drawing space desired
pi = acs(-1)
deg = 180 / pi ' radian 2 degree mult
rad = pi / 180 ' degree 2 radian mult
nb = 25 ' number of birds
no = 4 ' number of obstacles
np = 2 'number of predators
done = 0

dim px(np), py(np), pa(np), oldpx(np), oldpy(np), oldpa(np), pw(np) ' Predator radius is const 10 or so, twice a bird at least
dim ox(no), oy(no), ord(no)  ' obstacle x, y, radius
dim bx(nb), by(nb), ba(nb), oldx(nb), oldy(nb), da(nb, nb), oldba(nb), bw(nb)  ' new  da = distance array

headMode = 1    ' on / off
' sway = pi/6     'just turn neighbor towards neighbor
hf = .1         ' % of 100 pixels distance .1 = 10

centerMode = 1  ' on / off
cf = .01       'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 30

open "Boids Restart #6 Wings" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"  ' no click code yet but we're ready
#gr "when characterInput charIn"
#gr "down"
#gr "fill green"
for i = 1 to no
   ox(i) = rand(90, xmax-90) : oy(i) = rand(90, ymax-90) : ord(i) = rand(25, 90)
   #gr "color brown"
   #gr "backcolor brown"
   #gr "place ";ox(i);" ";oy(i);"; circlefilled ";ord(i)
next
for i = 1 to nb
   [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]
   wend
   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]
   wend
   bx(i) = testx : by(i) = testy : ba(i) = 2 * pi * rnd(0) : bw(i) = int(3*rnd(0))      ' random headings
next
for 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]
   wend
   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]
   wend
   px(i) = testx : py(i) = testy : pa(i) = 2 * pi * rnd(0) : pw(i) = int(5*rnd(0))
next

while done = 0
   scan
   #gr "color brown"
   #gr "backcolor brown"
   for i = 1 to no
       #gr "place ";ox(i);" ";oy(i);"; circlefilled ";ord(i)
   next
   iter=iter+1  ' >>>> tsh73 drop in FPS counter
   if t1$<>time$("sec") then
       t1$=time$("sec")
       #gr "color white"
       #gr "place 10 30; backcolor red"
       #gr "\FPS ";right$("   "+str$(iter),3);" "
       iter=0
   end if
   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!
           scan
           da(i, j) = distance(bx(i), by(i), bx(j), by(j))
           da(j, i) = da(i, j) ' symetric relationship
       next
   next

   for i = 1 to np ' Predators are just like a birds
       '   erase old
       '#gr "color green"
       '#gr "backcolor green"
       '#gr "place ";oldpx(i);" ";oldpy(i);"; circlefilled ";10
       'call DrawArrow oldpx(i), oldpy(i), oldpa(i), 30, "green"
       Call DrawBird oldpx(i), oldpy(i), 15, oldpa(i), pw(i), "green"

       ' draw current
       '#gr "color blue"
       '#gr "backcolor blue"
       '#gr "place ";px(i);" ";py(i);"; circlefilled ";10
       'call DrawArrow px(i), py(i), pa(i), 30, "white"
       pw(i) = (1 + pw(i)) mod 5 ' flapper wings or not
       Call DrawBird px(i), py(i), 15, pa(i), pw(i), "blue"
       oldpx(i) = px(i) : oldpy(i) = py(i) : oldpa(i) = pa(i)
       s = rand(3, 7) ' 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)
           end if
       wend
       ' JB&LB have better Mod function! tsh73 pointed it to me
       px(i) = (px(i) + xmax) mod xmax
       py(i) = (py(i) + ymax) mod ymax
       ' except predators don't flock
   next

   for i = 1 to nb 'draw then update positions of birds
       'erase old
       '#gr "color green"
       '#gr "backcolor green"
       '#gr "place ";oldx(i);" ";oldy(i);"; circlefilled ";5
       'call DrawArrow oldx(i), oldy(i), oldba(i), 15, "green"
       Call DrawBird oldx(i), oldy(i), 5, oldba(i), bw(i), "green"
       ' draw current
       '#gr "color black"
       '#gr "backcolor black"
       '#gr "place ";bx(i);" ";by(i);"; circlefilled ";5
       'call DrawArrow bx(i), by(i), ba(i), 15, "white"
       bw(i) = (bw(i) + 1) mod 3 ' flapper wings or not
       Call DrawBird bx(i), by(i), 5, ba(i), bw(i), "black"
       oldx(i) = bx(i) : oldy(i) = by(i) : oldba(i) = ba(i)
       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)
           end if
       wend
       j = 0
       while j < np
           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)
           end if
       wend
       ' JB&LB have better Mod function! tsh73 pointed it to me
       bx(i) = (bx(i) + xmax) mod xmax
       by(i) = (by(i) + ymax) mod ymax

       for j = i + 1 to nb
           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
               if headMode and rnd(0) < hf then
                   ba(i) =  AngleAve(ba(i), AngleAve(ba(i), ba(j)))
                   ba(j) =  AngleAve(AngleAve(ba(i), ba(j)), ba(j))
               end if
           end if
           if dist > 20 and dist < 50 then
               'stickiness stay close to neighbors, close distance between
               if centerMode and rnd(0) < cf then
                   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))
               end if
           end if
       next 'j
   next ' i
wend
wait

sub charIn Handle$, c$
   if asc(c$) = 27 then call quit Handle$
end sub

sub quit Handle$
   close #Handle$
   end
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Function Atan2(y,x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-pi to pi radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(1)) + lo
end function

function distance(x1, y1, x2, y2)
   distance = sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)) ' I removed spaces on off change they might add to processing time
end function

Function AngleAve (ra1, ra2) ' tsh73 version no longer needs NormalRA
   twoPi = pi * 2
   ray1 = (ra1 + twoPi) mod twoPi
   ray2 = (ra2 + twoPi) mod twoPi
   rtn = (ray1 + ray2) / 2
   if abs(ray1-ray2) > pi Then rtn = (rtn-pi + twoPi) mod twoPi
   AngleAve = rtn
End Function

Sub DrawArrow xc, yc, ra, lngth, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + .5 * lngth * Cos(ra)
   y1 = yc + .5 * lngth * Sin(ra)
   x2 = xc + .5 * lngth * Cos(ra - pi)
   y2 = yc + .5 * lngth * Sin(ra - pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra - .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra - .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   x2 = x1 + .2 * lngth * Cos(ra + .75 * pi)
   y2 = y1 + .2 * lngth * Sin(ra + .75 * pi)
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
End Sub

sub DrawBird xc, yc, rr, ra, wings, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + rr * Cos(ra)
   y1 = yc + rr * Sin(ra)
   x2 = xc + rr * Cos(ra - .83*pi)
   y2 = yc + rr * Sin(ra - .83*pi)
   x3 = xc + rr * Cos(ra + .83*pi)
   y3 = yc + rr * Sin(ra + .83*pi)
   call filltriangle x1, y1, xc, yc, x2, y2
   call filltriangle x1, y1, xc, yc, x3, y3
   if wings then
       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)
       call filltriangle xc, yc, x2, y2, x3, y3
   end if
end sub

'Fast Filled Triangle Sub by AndyAmaya
Sub filltriangle x1, y1, x2, y2, x3, y3
   'triangle coordinates must be ordered: where x1 < x2 < x3
   If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
   'swap x1, y1, with x3, y3
   If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
   'swap x2, y2 with x3, y3
   If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
   If x1 <> x3 Then slope1 = (y3 - y1) /(x3 - x1)
   'draw the first half of the triangle
   length = x2 - x1
   If length <> 0 Then
       slope2 = (y2 - y1)/(x2 - x1)
       For x = 0 To length
           #gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
       Next
   End If
   'draw the second half of the triangle
   y = length * slope1 + y1 : length = x3 - x2
   If length <> 0 Then
       slope3 = (y3 - y2) /(x3 - x2)
       For x = 0 To length
           #gr "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
       Next
   End If
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   #gr "line ";x2;" ";y2;" ";x1;" ";y1
   #gr "line ";x2;" ";y2;" ";x3;" ";y3
   #gr "line ";x3;" ";y3;" ";x2;" ";y2
   #gr "line ";x1;" ";y1;" ";x3;" ";y3
   #gr "line ";x3;" ";y3;" ";x1;" ";y1
End Sub



[tenochtitlanuk]

Haven't had time to much change my boids- but they now are attracted to the centre of the screen and the CofG of the flock. They lose energy if they bounce of the wall, and as time passes. So they end in swooping orbits round /near each other. And I've improved their world wit a photo I took a couple of days ago... I need a big slot of time to examine exactly what others have achieved- and how. Won't be soon..

[bplus]

@john T, beautiful picture!

I fixed the birds piling up on each other with Too Close! code, much improved I think.
' Boids Restart #6A Too close! b+ 2022-03-19

' >>>>>>>>>>>>>>>>>>>>>  Escape Key will now call it Quits!

global H$, xmax, ymax, pi, deg, rad, nb, done
H$ = "gr"
xmax = 700 '<== actual drawing space desired
ymax = 500 '<=== actual drawing space desired
pi = acs(-1)
deg = 180 / pi ' radian 2 degree mult
rad = pi / 180 ' degree 2 radian mult
nb = 30 ' number of birds
no = 3 ' number of obstacles
np = 2 'number of predators
done = 0

dim px(np), py(np), pa(np), oldpx(np), oldpy(np), oldpa(np), pw(np) ' Predator radius is const 10 or so, twice a bird at least
dim ox(no), oy(no), ord(no)  ' obstacle x, y, radius
dim bx(nb), by(nb), ba(nb), oldx(nb), oldy(nb), da(nb, nb), oldba(nb), bw(nb)  ' new  da = distance array

headMode = 1    ' on / off
' sway = pi/6     'just turn neighbor towards neighbor
hf = .3         ' % of 100 pixels distance .1 = 10

centerMode = 1  ' on / off
cf = .1       'centering factor how strong a pull from 0 to 1  .01 is week .1 pretty strong!

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 30

open "Boids Restart #6A Too Close!" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"  ' no click code yet but we're ready
#gr "when characterInput charIn"
#gr "down"
#gr "fill green"
for i = 1 to no
   ox(i) = rand(90, xmax-90) : oy(i) = rand(90, ymax-90) : ord(i) = rand(25, 90)
   #gr "color brown"
   #gr "backcolor brown"
   #gr "place ";ox(i);" ";oy(i);"; circlefilled ";ord(i)
next
for i = 1 to nb
   [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]
   wend
   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]
   wend
   bx(i) = testx : by(i) = testy : ba(i) = 2 * pi * rnd(0) : bw(i) = int(3*rnd(0))      ' random headings
next
for 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]
   wend
   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]
   wend
   px(i) = testx : py(i) = testy : pa(i) = 2 * pi * rnd(0) : pw(i) = int(5*rnd(0))
next

while done = 0
   scan
   #gr "color brown"
   #gr "backcolor brown"
   for i = 1 to no
       #gr "place ";ox(i);" ";oy(i);"; circlefilled ";ord(i)
   next
   iter=iter+1  ' >>>> tsh73 drop in FPS counter
   if t1$<>time$("sec") then
       t1$=time$("sec")
       #gr "color white"
       #gr "place 10 30; backcolor red"
       #gr "\FPS ";right$("   "+str$(iter),3);" "
       iter=0
   end if
   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!
           scan
           da(i, j) = distance(bx(i), by(i), bx(j), by(j))
           da(j, i) = da(i, j) ' symetric relationship
       next
   next

   for i = 1 to np ' Predators are just like a birds
       '   erase old
       Call DrawBird oldpx(i), oldpy(i), 15, oldpa(i), pw(i), "green"
       ' draw current
       pw(i) = (1 + pw(i)) mod 5 ' flapper wings or not
       Call DrawBird px(i), py(i), 15, pa(i), pw(i), "blue"
       oldpx(i) = px(i) : oldpy(i) = py(i) : oldpa(i) = pa(i)
       s = rand(3, 7) ' 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)
           end if
       wend
       ' JB&LB have better Mod function! tsh73 pointed it to me
       px(i) = (px(i) + xmax) mod xmax
       py(i) = (py(i) + ymax) mod ymax
       ' except predators don't flock
   next

   for i = 1 to nb 'draw then update positions of birds
       'erase old
       Call DrawBird oldx(i), oldy(i), 5, oldba(i), bw(i), "green"
       ' draw current
       bw(i) = (bw(i) + 1) mod 3 ' flapper wings or not
       Call DrawBird bx(i), by(i), 5, ba(i), bw(i), "black"
       oldx(i) = bx(i) : oldy(i) = by(i) : oldba(i) = ba(i)
       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)
           end if
       wend
       j = 0
       while j < np
           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)
           end if
       wend
       ' JB&LB have better Mod function! tsh73 pointed it to me
       bx(i) = (bx(i) + xmax) mod xmax
       by(i) = (by(i) + ymax) mod ymax

       for j = i + 1 to nb
           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
               if headMode and rnd(0) < hf then
                   ba(i) =  AngleAve(ba(i), AngleAve(ba(i), ba(j)))
                   ba(j) =  AngleAve(AngleAve(ba(i), ba(j)), ba(j))
               end if
           end if
           if dist > 20 and dist < 50 then
               'stickiness stay close to neighbors, close distance between
               if centerMode and rnd(0) < cf then
                   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))
               end if
           end if
           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))
           End If
       next 'j
   next ' i
wend
wait

sub charIn Handle$, c$
   if asc(c$) = 27 then call quit Handle$
end sub

sub quit Handle$
   close #Handle$
   end
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

Function Atan2(y,x)
   'Atan2 is a function which determines the angle between points
   'x1, y1 and x2, y2. The angle returned is in radians
   'The angle returned is always in the range of
   '-pi to pi radians (-180 to 180 degrees)
   '==============================================================
   'NOTE the position of Y and X arguments
   'This keeps Atan2 function same as other language versions
   '==============================================================
  If x = 0 Then
      If y < 0 Then
           Atan2 = -1.5707963267948967
       Else
           Atan2 = 1.5707963267948967
       End If
  Else
      chk = atn(y/x)
      If x < 0 Then
          If y < 0 Then
               chk = chk - 3.1415926535897932
           Else
               chk = chk + 3.1415926535897932
           End If
      End If
       Atan2 = chk
  End If
  'thanks Andy Amaya
End Function

function rand(lo, hi)
   rand = int((hi - lo + 1) * rnd(1)) + lo
end function

function distance(x1, y1, x2, y2)
   distance = sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)) ' I removed spaces on off change they might add to processing time
end function

Function AngleAve (ra1, ra2) ' tsh73 version no longer needs NormalRA
   twoPi = pi * 2
   ray1 = (ra1 + twoPi) mod twoPi
   ray2 = (ra2 + twoPi) mod twoPi
   rtn = (ray1 + ray2) / 2
   if abs(ray1-ray2) > pi Then rtn = (rtn-pi + twoPi) mod twoPi
   AngleAve = rtn
End Function

sub DrawBird xc, yc, rr, ra, wings, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   x1 = xc + rr * Cos(ra)
   y1 = yc + rr * Sin(ra)
   x2 = xc + rr * Cos(ra - .83*pi)
   y2 = yc + rr * Sin(ra - .83*pi)
   x3 = xc + rr * Cos(ra + .83*pi)
   y3 = yc + rr * Sin(ra + .83*pi)
   call filltriangle x1, y1, xc, yc, x2, y2
   call filltriangle x1, y1, xc, yc, x3, y3
   if wings then
       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)
       call filltriangle xc, yc, x2, y2, x3, y3
   end if
end sub

'Fast Filled Triangle Sub by AndyAmaya
Sub filltriangle x1, y1, x2, y2, x3, y3
   'triangle coordinates must be ordered: where x1 < x2 < x3
   If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
   'swap x1, y1, with x3, y3
   If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
   'swap x2, y2 with x3, y3
   If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
   If x1 <> x3 Then slope1 = (y3 - y1) /(x3 - x1)
   'draw the first half of the triangle
   length = x2 - x1
   If length <> 0 Then
       slope2 = (y2 - y1)/(x2 - x1)
       For x = 0 To length
           #gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
       Next
   End If
   'draw the second half of the triangle
   y = length * slope1 + y1 : length = x3 - x2
   If length <> 0 Then
       slope3 = (y3 - y2) /(x3 - x2)
       For x = 0 To length
           #gr "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
       Next
   End If
   #gr "line ";x1;" ";y1;" ";x2;" ";y2
   #gr "line ";x2;" ";y2;" ";x1;" ";y1
   #gr "line ";x2;" ";y2;" ";x3;" ";y3
   #gr "line ";x3;" ";y3;" ";x2;" ";y2
   #gr "line ";x1;" ";y1;" ";x3;" ";y3
   #gr "line ";x3;" ";y3;" ";x1;" ";y1
End Sub



[tenochtitlanuk]

Added a page to my LB site at boids page

[Rod]

Hey John, the code seems to have the rule code remmed out. Is that deliberate?