drop-in FPS counter

[tsh73]

So you have a program that draws on a screen in a loop
And you want to know FPS (likely to check if your changes made it any faster)

Put this code in your drawing loop
   iter=iter+1
   if t1$<>time$("sec") then
       t1$=time$("sec")
       #gr "place 10 30; backcolor blue"
       #gr "\FPS ";iter;" "
       iter=0
   end if



[plus]

Test in old Boids code, taken from this thread justbasiccom.proboards.com/thread/78/object-paradigm

'Boid Watch 3.txt for JB 2.0 B+ 2018-05-04 fix up or update some details
'makeover of Boid Watching 2.txt for JB 2.0 B+ 2018-05-03
' posted http://justbasiccom.proboards.com/thread/78/object-paradigm
'makeover of Boid Watching
' posted in thread here: http://justbasiccom.proboards.com/thread/63/boids-floking-swarm-scool?page=2

'!!!!!!!!!!!!!!!!!!! extend object paradigm of critters > Watch 3: now more bird like
' make some not moving predator ie obstacles to avoid
' make some moving predators
' make it so we count all the new critters we create (global creatureCnt) up to (global const = maxCreatures)
' make it so we can create new creatures/obstacles/predators from mouse clicks
' make it so we can custom design a new creature by adding a modString to the newCreature creation sub
'  types of creatures boids now black/brown, predator still redish, obstacle blueish > now dark green tree-like

'''' Some kind of screwy thing is happening to cause all critters to bunch up top right corner
'''' or just the right side (I have since reversed the bunching).
'''' It shows up the worse it seems when spaceMode is ON = 1 ???
''''
'''' OK I give up and will go with the flow!
'''' I will start objects on left, let them flow across screen and exit stage right...
'''' and be recycled back at stage left... works nice! They will be increased in radius (and thus speed)
'''' with each recycle up to a max radius. New critters start as yellow to see how long they remain.

NoMainWin
global xmax, ymax, pi, mx, my, clickObject
xmax = 1200 : ymax = 700 : pi = acs(-1)

''''''''''''''''''''''''''''''''''''''' You control the NeighborBoid Here '''''''''''''''''''''''''

'You can click in a Predator (up to 3 for now) or Obstacle (up to 5 for now) anywhere on screen
' Toggle modes between click in Predator or Obstacle with the Spacebar.
' The Mode you are in, is reported in Top Left Corner.
' If you continue to Click in a mode beyond maxMouseObstacles (set at 5) or maxPredators (set at 3)
' you will just start relocating the Obstacles or Predators.

'''''''''''''''''''''  Boid behavior based on several modes

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

headMode = 1    ' on / off
sway = pi/6     'just turn neighbor towards neighbor
hf = .2         'heading factor how strong an influence  0 to 1

spaceMode = 1  ' on / off

noise = 0      'general randomness added to movements individualism, applied to critters only

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = 100
UpperLeftY = 40
Open "Boid Watch 3 Press: space to toggle obstacle/predator, o to obliterate obstacles, p to poison predators" For Graphics_nsb_nf As #g
#g "trapclose quit"
#g "setfocus"
#g "when leftButtonUp lButtonUp"
#g "when characterInput charIn"
#g "when mouseMove move"
#g "down"
#g "fill darkgreen"


'============ some of these are used in Main code, some just used for reference or calculations in procedures

Global maxBorderObstacles, maxMouseObstacles, maxCritters, maxPredators
Global borderObstacleCnt, mouseObstacleCnt, critterCnt, predatorCnt
Global mouseObstacleOffset, critterOffset, predatorOffset  'index offsets, all objects are referred to by index number


'non moving
maxBorderObstacles = 100  'create up to 100 obstacles to pen moving critters into screen view area
maxMouseObstacles = 5     'create obstacles inside pen, these you click in when in Click Obstacle Mode
maxObstacles = maxBorderObstacles + maxMouseObstacles

'moving
maxCritters = 30  'move away from obstacles and predators > now larger red bird-like
maxPredators = 3  'move away from obstacles, these you click in where ever when in Click Prey mode
maxMoving = maxCritters + maxPredators

'total
maxObjects = maxObstacles + maxMoving

'count current objects loaded
borderObstacleCnt = 0
mouseObstacleCnt = 0
predatorCnt = 0
critterCnt = 0

'starting indexs to control where certain types of objects are placed in arrays
mouseObstacleOffset = maxBorderObstacles
critterOffset = mouseObstacleOffset + maxMouseObstacles
predatorOffset = critterOffset + maxCritters

'for reference
'typeBorderObstacle = 0
'typeObstacle = 1
'typeCritter = 2
'typePredator = 3

'psuedo structure for all objects
dim type(maxObjects) 'see types above
dim x(maxObjects)
dim y(maxObjects)
dim r(maxObjects)  'radius
dim a(maxObjects)  'angle in radians
dim p(maxObjects)  'predator/obstacle mode = 1 when around a predator or obstacle else = 0
dim c$(maxObjects) 'color string predators are redish, critters are yellow to start then green up

'setup border objects, > now more natural trees
for x = 25 to xmax step 50
   call newObject "type=0,c=0 ";rand(40, 80);" 0, y=";rand(10,40);", r=";rand(10,40);", x=";rand(x-10, x + 40)
   call newObject "type=0,c=0 ";rand(40, 80);" 0, y=";rand(ymax-40,ymax-10);", r=";rand(10,40);", x=";rand(x-10, x + 40)
next
'for y = 75 to ymax step 50
'    call newObject "type=0,c =0 0 255, x=25, r=10, y=";y
'    call newObject "type=0,c =0 0 255, x=";xmax -25;", r=10, y=";y
'next
for i = 1 to maxCritters
   'test critter make green coming in from right side
   call newObject ""  'use all defaults!
next

clickObject = 0  '0 for clicking in a stationary obstacle, 1 for clicking in a moving predator
while 1
   scan
   #g "discard"
   #g "fill darkgreen"
   for m = 1 to maxObstacles
       if x(m)<>0 and y(m)<>0 then
           call drawObject m
       end if
   next
   #g "color white"
   if clickObject then M$ = "Click: prey" else M$ = "Click: obstacle"
   #g "place ";10;" ";10;";|";M$

   'tsh73 drop in FPS counter
   iter=iter+1
   if t1$<>time$("sec") then
       t1$=time$("sec")
       #g "place 10 30";";|FPS ";iter;" "
       iter=0
   end if

   'draw the predators
   for p = predatorOffset + 1 to predatorOffset + maxPredators
       if x(p) <> 0 and y(p) <> 0 then
           p(p) = 0 'assume not near predator or obstacle
           for o = 1 to maxObstacles
               scan
               if x(o) <> 0 and y(o) <> 0 then
                   if distance(x(p), y(p), x(o), y(o)) < 50 then
                       'a(i) = a(i) - 2 * sway '* rdir()
                       a(p) = atan2(y(o) - y(p), x(o) - x(p)) - pi
                       p(i) = 1
                   end if
               end if
           next
           for o = predatorOffset + 1 to predatorOffset + maxPredators
               scan
               if x(o) <> 0 and y(o) <> 0 and o <> p then
                   if distance(x(p), y(p), x(o), y(o)) < 2 * (r(i) + r(o)) then
                       'a(i) = a(i) + 2 * sway '* rdir()
                       a(p) = atan2(y(o) - y(p), x(o) - x(p)) - pi
                       p(i) = 1
                   end if
               end if
           next
           x(p) = x(p) + r(p) * cos(a(p))
           y(p) = y(p) + r(p) * sin(a(p))
           if x(p) < -1 * r(p) or x(p) > xmax + r(p) + 150 or y(p) < -1 * r(p) or y(p) > ymax + r(p) then 'start new
               call newObject "type=3,i=";p;",r=25,c=";rand(180, 255);" 0 0"
           end if
           call drawObject p
       end if
   next
   for i = critterOffset + 1 to critterOffset + maxCritters 'big show of points and triangle
       scan
       if a(i) < 0 then a(i) = a(i) + 2 * pi
       if a(i) >= 2 * pi then a(i) = a(i) - 2 * pi
       for j = i + 1 to critterOffset + maxCritters
           scan
           if distance(x(i), y(i), x(j), y(j)) < 3 * (r(i) + r(j)) then

               'sway the neighbors towards each other
               if headMode then
                   if a(i) > a(j) then
                       a(i) = a(i) - sway * hf
                       a(j) = a(j) + sway * hf
                   else
                       a(i) = a(i) + sway * hf
                       a(j) = a(j) - sway * hf
                   end if
               end if

               'stickiness stay close to neighbors, close distance between
               if centerMode then
                   if x(i) > x(j) then
                       x(i) = x(i) - cf * (x(i) - x(j))
                       x(j) = x(j) + cf * (x(i) - x(j))
                   else
                       x(i) = x(i) + cf * (x(j) - x(i))
                       x(j) = x(j) - cf * (x(j) - x(i))
                   end if
                   if y(i) > y(j) then
                       y(i) = y(i) - cf * (y(i) - y(j))
                       y(j) = y(j) + cf * (y(i) - y(j))
                   else
                       y(i) = y(i) + cf * (y(j) - y(i))
                       y(j) = y(j) - cf * (y(j) - y(i))
                   end if
               end if

               'don't let them bunch up
               if spaceMode then
                   spacing = r(i) + r(j) + 2
                   ' The following is STATIC's adjustment of ball positions if overlapping
                   ' before calculation of new positions from collision
                   ' Displacement vector and its magnitude.  Thanks STxAxTIC !
                   nx = x(j) - x(i)
                   ny = y(j) - y(i)
                   nm = SQR(nx ^ 2 + ny ^ 2)
                   IF nm < spacing THEN
                       nx = nx / nm
                       ny = ny / nm
                       ' Regardless of momentum exchange, separate the balls along the line connecting them.
                       WHILE nm < spacing
                           scan
                           x(j) = x(j) + .3 * spacing * nx
                           y(j) = y(j) + .3 * spacing * ny
                           x(i) = x(i) - .3 * spacing * nx
                           y(i) = y(i) - .3 * spacing * ny
                           nx = x(j) - x(i)
                           ny = y(j) - y(i)
                           nm = SQR(nx ^ 2 + ny ^ 2)
                           nx = nx / nm
                           ny = ny / nm
                       wend
                   end if 'spacer
               end if 'space Mode
           end if 'distance
       next

       'all obstacles are predators as well as predators when close to one do a u-ee
       p(i) = 0 'assume not near predator or obstacle
       for o = 1 to maxObstacles
           scan
           if x(o) <> 0 and y(o) <> 0 then
               if distance(x(i), y(i), x(o), y(o)) < 50 then
                   a(i) = atan2(y(o) - y(i), x(o) - x(i)) - pi
                   p(i) = 1
               end if
           end if
       next
       for o = predatorOffset + 1 to predatorOffset + predatorCnt
           scan
           if x(o) <> 0 and y(o) <> 0 then
               if distance(x(i), y(i), x(o), y(o)) < 2 * (r(i) + r(o)) then
                   a(i) = atan2(y(o) - y(i), x(o) - x(i)) - pi
                   p(i) = 1
               end if
           end if
       next

       'out of sight
       if x(i) < -1 * r(i) or x(i) > xmax + r(i) + 150 or y(i) < -1 * r(i) or y(i) > ymax + r(i) then 'start new
           call newObject "i=";i
       end if

       'update points
       if p(i) then jump = 4 * r(i) else jump = r(i)
       x(i) = x(i) + jump * cos(a(i)) + rnd(0) * noise - .5 * noise
       y(i) = y(i) + jump * sin(a(i)) + rnd(0) * noise - .5 * noise

       call drawObject i
   next
   #g "flush"
   call pause 75
wend

'---------------- windows setup calls

sub quit H$
   close #H$
   end
end sub

sub lButtonUp H$, mx, my  'must have handle and mouse x,y
   'drop in an obstacle or a prey
   if clickObject then 'prey
       if predatorCnt >= maxPredators then predatorCnt = 0
       call newObject "type=3, c=";rand(160, 255);" 0 0, r=25, x=";mx;", y=";my
   else 'obstacle
       if mouseObstacleCnt >= maxMouseObstacles then mouseObstacleCnt = 0
       call newObject "type=1,c=0 ";rand(40, 80);" 0, y=";my;", r=";rand(10, 40);", x=";mx
   end if
end sub

sub charIn H$, c$
   'toggle clicking in an obstacle or a prey
   if c$ = " " then
       if clickObject then clickObject = 0 else clickObject = 1
   end if
   if c$ = "o" then 'obliterate obstacles
       for i = mouseObstacleOffset + 1 to mouseObstacleOffset + maxMouseObstacles
           x(i) = 0 : y(i) = 0
       next
   end if
   if c$ = "p" then 'poison all predators
       for i = predatorOffset + 1 to predatorOffset + maxPredators
           x(i) = 0 : y(i) = 0
       next
   end if
end sub

sub move H$, MouseX, MouseY
   mx = MouseX
   my = MouseY
end sub

'--------------- important subs for this program

sub newObject instructions$   '< psuedo OOP new Object, is Constructer the right term?
   'for reference
   'typeBorderObstacle = 0
   'typeObstacle = 1
   'typeCritter = 2
   'typePredator = 3
   'according to it's type we set the objects index,
   'if no type is instructed then type 2 = critter as default

   'read in the parameter arguments  instructions$ in form ? "type=1,x=3,r=10... "
   wi = 1
   while word$(instructions$, wi, ",") <> ""
       p$ = trim$(word$(word$(instructions$, wi, ","), 1, "="))
       v$ = trim$(word$(word$(instructions$, wi, ","), 2, "="))
       select case p$
           case "type" : t = val(v$) : tset = 1
           case "r"    : r = val(v$) : rset = 1
           case "x"    : x = val(v$) : xset = 1
           case "y"    : y = val(v$) : yset = 1
           case "a"    : a = val(v$) : aset = 1
           case "c"    : c$ = v$     : cset = 1
           case "i"    : i = val(v$) : iset = 1
       end select
       wi = wi + 1
   wend

   'use defaults if no argument is given, basic critter starts small and slow
   if tset = 0 then t = 2 'default critter
   if rset = 0 then r = rand(12, 16)
   if xset = 0 then x = rand(xmax-r, xmax + 100 + r) 'start at far left off screen
   if yset = 0 then y = rand(50, ymax - 50)
   if aset = 0 then a = pi/2 + pi * rnd(0)   'head them left generally onto screen
   b = rand(30, 80)
   if cset = 0 then c$ = b;" ";b*.5;" ";b*.25

   'assign an index number according to type, if find one the up the index cnt for type
   if iset = 0 then
       select case t
           case 0
               if borderObstacleCnt + 1 < maxBorderObstacles then
                   borderObstacleCnt = borderObstacleCnt + 1
                   index = borderObstacleCnt
               end if
           case 1
               if mouseObstacleCnt + 1 <= maxMouseObstacles then
                   mouseObstacleCnt = mouseObstacleCnt + 1
                   index = mouseObstacleOffset + mouseObstacleCnt
               end if
           case 2
               if critterCnt + 1 <= maxCritters then
                   critterCnt = critterCnt + 1
                   index = critterOffset + critterCnt
               end if
           case 3
               if predatorCnt + 1 <= maxPredators then
                   predatorCnt = predatorCnt + 1
                   index = predatorOffset + predatorCnt
               end if
       end select
   else
       index = i
   end if
   if index <> 0 then 'load object values into arrays
       type(index) = t
       r(index) = r
       x(index) = x
       y(index) = y
       a(index) =  a
       c$(index) = c$
   end if
end sub

sub drawObject i  'now more bird like!
   #g "color ";c$(i)
   #g "backcolor ";c$(i)
   if type(i) > 1 then
       'boids
       r = RND(0) * pi * .25 'flapping
       w = pi * .6
       IF p(i) THEN
           x1 = x(i) + r(i) * COS(a(i) + pi)
           y1 = y(i) + r(i) * SIN(a(i) + pi)
           x2 = x(i) + r(i) * COS(a(i) + pi + w + r)
           y2 = y(i) + r(i) * SIN(a(i) + pi + w + r)
           x3 = x(i) + r(i) * COS(a(i) + pi - w - r)
           y3 = y(i) + r(i) * SIN(a(i) + pi - w - r)
       ELSE
           x1 = x(i) + r(i) * COS(a(i))
           y1 = y(i) + r(i) * SIN(a(i))
           x2 = x(i) + r(i) * COS(a(i) + w + r)
           y2 = y(i) + r(i) * SIN(a(i) + w + r)
           x3 = x(i) + r(i) * COS(a(i) - w - r)
           y3 = y(i) + r(i) * SIN(a(i) - w - r)
       END IF
       call filltriangle x(i), y(i), x1, y1, x2, y2
       call filltriangle x(i), y(i), x1, y1, x3, y3
   else
       #g "place ";x(i);" ";y(i);"; circlefilled ";r(i)
   end if
end sub

'----------------- supplementary handy subs

Function atan2(y, x) 'thanks Andy Amaya
   '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
  if atan2 < 0 then atan2 = atan2 + 2 * pi
End Function

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

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

function distance(x1, y1, x2, y2)
   distance = ( (x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
end function

function rdir()
   if rnd(0) < .5 then rdir = -1 else rdir = 1
end function


'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
           #g "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
           #g "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
       Next
   End If
   #g "line ";x1;" ";y1;" ";x2;" ";y2
   #g "line ";x2;" ";y2;" ";x1;" ";y1
   #g "line ";x2;" ";y2;" ";x3;" ";y3
   #g "line ";x3;" ";y3;" ";x2;" ";y2
   #g "line ";x1;" ";y1;" ";x3;" ";y3
   #g "line ";x3;" ";y3;" ";x1;" ";y1
End Sub



[Rod]

This is nowhere near realistic as B+ simulation. But this draws 500 boids at 30FPS on my machine. Mesmerizing!

   b=500 'number of boids
   c=25 'cohesion pixels
   s=3 '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)=ddx
           b(nn,dy)=ddy

           '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)

           'in and out
           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

   scan
   goto [draw]


[quit]
   timer 0
   close #1
   end



[tsh73]

I got 24-25 FPS on pretty fast machine. Just put counter code right after drawsprites.


   'FPS counter, put it right after drawsprites
   iter=iter+1
   if t1$<>time$("sec") then
       t1$=time$("sec")
       FPS=iter
       iter=0
   end if
   'since drawsprites will clear things, we need to draw FPS counter on each loop
   #1 "place 10 30; backcolor blue"
   #1 "\FPS ";FPS;" "


[plus]

FPS mostly 18 some 19 for Rod's, that's what 5 years of Windows updates will do to speed.

   b=500 'number of boids
   c=25 'cohesion pixels
   s=3 '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"
   'FPS counter, put it right after drawsprites
   iter=iter+1
   if t1$<>time$("sec") then
       t1$=time$("sec")
       FPS=iter
       iter=0
   end if
   'since drawsprites will clear things, we need to draw FPS counter on each loop
   #1 "place 10 30; backcolor blue"
   #1 "\FPS ";FPS;" "
   '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)=ddx
           b(nn,dy)=ddy

           '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)

           'in and out
           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

   scan
   goto [draw]


[quit]
   timer 0
   close #1
   end




Interesting how there are few rogue globs faster than the others until they finally run into another glob.

[Rod]

18 FPS is still fast enough for animation. My 30 FPS speed comes from a recently purchased PC, I am getting frustrated with the iMac M1 and spend much more time on this new Windows PC. The iMac running Just BASIC on Parallels only manages 8 or 9 FPS! But then I suppose the fact it runs at all is a miracle.

11th Gen Intel(R) Core(TM) i5-1135G7 @ 2.40GHz 2.42 GHz
32.0 GB (31.8 GB usable)
64-bit operating system, x64-based processor
Windows 11 Home

The machine has 8 cores, pity Just BASIC only ever uses one.

I think some boids look faster because they move left or right or up and down and not on the diagonal.

[plus]

Wow 8 cores and 31 plus GB, have room for a JB program or 2 Million.

[davidk64]

The version + posted 5-6 FPS, Rod's 28-29 FPS

Processor Intel(R) Core(TM) i7-10750H CPU @ 2.60GHz, 2592 Mhz, 6 Core(s), 12 Logical Processor(s)
Installed Physical Memory (RAM) 16.0 GB
OS Name Microsoft Windows 11 Home
System Model G7 7700