Boid Watching

[Walt Decker]

Mar 12, 2022 13:14:17 GMT -5 Carl Gundel said:

Mar 12, 2022 13:02:55 GMT -5 Walt Decker said:

Seems like most LB users are deaf when one mentions API or 3rd party dlls. Why, I have no clue.

I think it might be because most people think of BASIC is being a language for casual programming, and they gravitate to it because they don't won't to think about the nuts and bolts of things.  This discussion might deserve a thread of its own.

On the other hand, an easy language that also allows for less abstract tools such as CALLDLL (or in the old school, PEEK, POKE, SYS, etc.) can provide a ramp for the beginner to become more of an expert as curiosity or need demand.

Yes, it might deserve a thread of its own.  However, those who would most benefit will not participate because "I don't understand API", "API scares me", "I'd rather use native LB" even though the coder will have to write 100 lines of additional code to make a substitute control work.

My go to RAD tool has PEEK and POKE.  I often use those in lieu of MID$, LEFT$ and RIGHT$ to look at ANSI strings and rapidly replace portions within the strings.

Walt, you forget how much you know and how little others do.

No, I do not forget.  What I know is a drop compared to what others, here and in other forums I visit, know.  The difference is, I like to know, at least in a general way, what it takes to make a list box work or edit control work.

As far as API being a necessary evil, it "ain't".  I think regarding API as an "evil" is one of the reasons folks here avoid it like the plague.  All of the LB statements that display something on the monitor, write something to a mass storage device, or output data to a printer or other device are wrappers for one or more API statements.  In most cases using API is faster and more versatile.

[bplus]

It's true, you're right! It just doesn't seem like Basic if you have to resort to API or dll's.

I always think that stuff for computer science guys for professional development. Who needs that baby Basic stuff anymore?

I do, I love babies I guess.

[Walt Decker]

It's true, you're right! It just doesn't seem like Basic if you have to resort to API or dll's.

That is a non-sequeter statement. Any statement in a tool is part of that tool. Liberty Basic itself uses API, DLLS, and SLLs. If the ability is available, why not use it when needed? Would you use a bunch of add statements to multiply 9 times 4 or a bunch of subtract statements to divide 120 by 5?

[bplus]

OK how 'bout this if API and dll's are Basic why don't they come with Just Basic?

But heck yes! use the tools if you got them and if not find a way around. Basically make dreams come true.

[Rod]

Back to Boids, which are proving to be really interesting. Now I am still exploring speed, my flocking code is still crap but this is proof of concept of sorting the boids and working a sorted list. I have the boids sorted in y within x order. This way I can process far fewer boids to find groups and just run down the list once. This demo simply gets the group average vector. I probably apply it incorrectly and I think the lead boid has too much influence but hey! I am no mathematician.

Now it is possible to have fast paced animation with lots of boids. Here I goto [draw] for maximum speed but it is fast enough even to introduce a timer. If you do try the timer bump the speed up to 2 or more.

Any pointers, criticism, even ridicule of my flocking code is welcome. Sorting has a few bad influences so still some bugs but it mostly works!

   pi = acs(-1)
   sway = pi/6/100
   b=50 'number of boids
   c=25 'cohesion pixels
   a=.2 'amount of influence 1=100%
   s=1 'speed pixels
   dim b(b,6) 'x,y,dx,dy,image,index
   x=1 : y=2 : dx=3 : dy=4 : im=5 : i=6
   for n= 1 to b
       b(n,x)=int(rnd(0)*790)
       b(n,y)=int(rnd(0)*590)
       b(n,dx)=1-rnd(0)*2
       b(n,dy)=1-rnd(0)*2
       b(n,im)=n
       b(n,i)=1000*b(n,x)+b(n,y)
   next

   nomainwin
   WindowWidth =830
   WindowHeight =660
   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 800 600 ; 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,6

   'work this ordered list finding near boids
   'start with first xy and look for near boids in y
   'work list till x is too far apart
   bn=1
   while bn<b
       nn=bn+1
       xx=b(bn,x)+c
       yy=b(bn,y)
       ddx=b(bn,dx)
       ddy=b(bn,dy)
       'knowing x limit check y limit
       while b(nn,x)<xx and nn<b
           if abs(b(nn,y)-yy)<c then
               'average the vector if close
               ddx=(ddx+b(nn,dx))/2
               ddy=(ddy+b(nn,dy))/2
           end if
           nn=nn+1
       wend

       'merge to average vector
       b(bn,dx)=(b(bn,dx)+ddx)/2+sway
       b(bn,dy)=(b(bn,dy)+ddy)/2-sway
       'move boid
       b(bn,x)=b(bn,x)+b(bn,dx)*s
       b(bn,y)=b(bn,y)+b(bn,dy)*s
       'update index for sorting
       b(bn,i)=1000*b(bn,x)+b(bn,y)
       'bounce off walls
       if b(bn,x)>=790 then b(bn,dx)=b(bn,dx)*-1
       if b(bn,y)>=590 then b(bn,dy)=b(bn,dy)*-1
       if b(bn,x)<10 then b(bn,dx)=b(bn,dx)*-1
       if b(bn,y)<10 then b(bn,dy)=b(bn,dy)*-1
       #1 "spritexy b";b(bn,im);"  ";b(bn,x);" ";b(bn,y)
       bn=bn+1
   wend
   'wait
   scan
   goto [draw]


[quit]
   timer 0
   close #1
   end



[Walt Decker]

I think your approach is incorrect. You are dealing with 3-d space. That is why a flock looks almost solid in the center and smoky toward the edges with a few outliers. You only need to check the outliers that are at the front of the flock. They are the ones that will encounter obstacles first and influence the density of the flock and its travel direction.

[bplus]

It is an interesting problem, related to AI agents and can simulate fish and bird groups when rightly coded.

Hmm... sorting is interesting idea.

I really like idea of going through list once, maybe find the distance of each bird to the other and base the amount of influence being inversely proportional to distance squared, just like gravity.

[bplus]

Here is a rework, now they don't all flow in any predictable direction and clusters aren't too tight.

' Boids Restart #2 Influence at a distance  b+ 2022-03-14

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

global H$, xmax, ymax, pi, deg, rad, nb, speed, done
H$ = "gr"
xmax = 1200 '<== actual drawing space desired
ymax = 700 '<=== actual drawing space desired
pi = acs(-1)
deg = 180 / pi ' radian 2 degree mult
rad = pi / 180 ' degree 2 radian mult
nb = 100 ' number of birds
speed = 5
done = 0

dim bx(nb), by(nb), ba(nb), oldx(nb), oldy(nb), da(nb, 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" for graphics_nsb_nf as #gr  '<======================= title
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"


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 white"
       #gr "backcolor white"
       #gr "place ";oldx(i);" ";oldy(i);"; circlefilled ";2
       ' draw current
       #gr "color black"
       #gr "backcolor black"
       #gr "place ";bx(i);" ";by(i);"; circlefilled ";2
       oldx(i) = bx(i) : oldy(i) = by(i)

       s = rand(1, 10) ' 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

       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
                   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(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
   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



[bplus]

There was a cartoon in the paper this morning. 3 birds are flying along and one bird says to the other, "I hope that other bird knows where we're going."

[tenochtitlanuk]

I'm coming into this a bit late, with little spare time, and as always I'm more interested in the appearance and flocking-rules than in speed. Can always save a series of images and play as an animated GIF...

This image shows how it displays- each boid as a circle and velocity-vector arrow. Now to implement the usual boid-rules..



The Boids Rules
Rule 1: Boids try to fly towards the centre of mass of neighbouring boids.
Rule 2: Boids try to keep a small distance away from other objects (including other boids).
Rule 3: Boids try to match velocity with near boids.
Lots of others to add- edge behaviour ( bounce or wrap). goal-setting, obstacles.

EDIT - present code- velocities not yet being changed, but looks good!

   '********************************************
   '**                                        **
   '**       tenochBoids2.bas   16/03/21      **
   '**                                        **
   '**    create a field of flocking boids    **
   '**                                        **
   '********************************************

   nomainwin

   WindowWidth  =620
   WindowHeight =620

   'Each boid represented in a csv string of x, y, vx, vy
   'x/y onscreen if in o...600. Velocity of 1 represents one pixel per cycle.

   N   =100
   dim boid$( N)



   open "Tenochtitlanuk Boids" for graphics_nsb as #wg

   #wg "trapclose quit"


   #wg "down ; size 10 ; fill 80 80 255"

   gosub [createBoidField]

   for H = 1 to N
       gosub [drawBoidField]
       gosub [updateBoidField]
   next H

   wait
'   __________________________________________________________

[createBoidField]
   for i =0 to N -1 '   create a random flock, all on-screen
       x           =600 *rnd( 1)
       y           =600 *rnd( 1)
       vx          = 10 *rnd( 1) -5
       vy          = 10 *rnd( 1) -5
       boid$( i)   =str$( x) +"," +str$( y) +"," +str$( vx) +"," +str$( vy)
   next i
   return

[drawBoidField]
   #wg "cls ; fill 80 80 255"
   for i =0 to N -1 '   draw current state of flock,
       call drawBoid boid$( i)
       scan
   next i
   return

[updateBoidField]
   for K =0 to N -1 '   create a random flock, all on-screen
       x       =val( word$( boid$( K), 1,","))
       y       =val( word$( boid$( K), 2,","))
       vx      =val( word$( boid$( K), 3,","))
       vy      =val( word$( boid$( K), 4,","))
       if x <=1 or x >=600 then vx =0 -vx
       if y <=1 or y >=600 then vy =0 -vy
       x           =x +vx
       y           =y +vy
       boid$( K)   =str$( x) +"," +str$( y) +"," +str$( vx) +"," +str$( vy)
       scan
   next K
   return

   sub drawBoid  i$    '   draw an individual boid
       #wg "color darkblue"
       #wg "size 10"
       x       =val( word$( i$, 1,","))
       y       =val( word$( i$, 2,","))
       #wg "set "; int( x); " "; int( y)
       vx      =val( word$( i$, 3,","))
       vy      =val( word$( i$, 4,","))
       magn    =( vx^2 +vy^2)^0.5
       dirn    =Atan2( vy, vx)
       nx      =x +vx
       ny      =y +vy
       #wg "color white"
       #wg "size 1"
       #wg "goto "; x -4 *vx; " "; y -4 *vy
   end sub

   Function Atan2( y, x)
   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

sub quit h$
       close #h$
       end
   end sub


[bplus]

Heh, heh, I redid my arrow drawing code to test angleAve (which turned out to be extremely powerful in getting all the birds flying in same direction in about a hundred or so loops).

Good idea tenochtitlanuk to show ba(i)'s that's the bird's heading in radian angle units.

AngleAve(a1, a2) might be interesting side note, I will translate to JB/LB my test code. It's not quite the same as averaging 2 numbers.

[bplus]

' 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

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]

With John's colors almost
' 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
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
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
   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 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

       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
                   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(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
   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
insert code here

[Rod]

@ B+, surprisingly fast, beautifully fluid. @john, neat display, just the n^n to overcome. Two best intellects on the case, we can't go wrong :)

[bplus]

Thanks Rod ,

I had an idea last night about reducing the heading influence factor with this:

               '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


So that bird heading i is not the same as bird heading j, both are just averaged more towards each other. The sway or swirl and flocking effect is still very strong and doesn't take long for most all to be grouped and going the same way, even with hf at .1!