Boid Watching

[bplus]

I did a search, no one has posted anything on Boids so I will, someone's got to do it!

It's kind of complicated but the space bar will toggle between obstacles = round circles that represent trees as viewed from above and
large red birds that are predators black birds want to avoid. o clears obstacles, p clears predators, spacebar toggles between placing predators and obstacles. So those are the instructions, enjoy bird watching

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



Yeah looking at the code, you might notice it is an experiment with Objects JB/LB style!

[tenochtitlanuk]

Fun. I'd noticed before that it was a Rosetta Code task with no LB entry. Boids On these tasks I get carried away with the fun of making it more sophisticated- and end up not bothering to cut it back to basics as an RC solution.

I look forward to examining your code- I'm a bit busy at the moment..

[bplus]

Thanks John, I didn't know RC had Boids, or I forgot

Some of those old comments at top no longer apply to code shown below.

[bplus]

OMG this looks like a piece of cake, Rosetta Code:

A Boids algorithm simulates the flocking behavior of birds. This task requires the creation of a graphical or purely textual simulation of a flock of birds navigating the cave with obstacles depicted below.

.......###############...............................................................
.......###############...............................................................
......#################..............................................................
O......###############...............................................................
OO.....###############...............................................................
OO.....###############....................#.........................#................
OO......#############...................#####...................#########............
OO......#############...................#####..................###########...........
OO.......###########...................#######................#############..........
OO.........#######......................#####................###############.........
OO............#.........................#####...............#################........
OO........................................#.................#################........
O...........................................................#################........
............................................................#################........
...........................................................###################.......
............................................................#################........
If you implement a purely textual simulation, this is a possible board representation, where "O" are the boids that should go toward the right, "#" are fixed walls that should be avoided by the boids, and "." is free space (using a space is also acceptable for free space, if you add some kind of frame around the board).

Forum editor distorts spacing above, really it's a nice neat rectangle.  Thanks tsh73

Should take tsh73 or Rod 15 minutes, take bplus a day to eliminate all the junk he added.

[bplus]

Oh that's better! thanks tsh73

[bplus]

Well this turned out harder than expected. I had to give plans for a Mod and just start over with probably unorthodox method.

Those dang birds keep slipping through the cracks = subscript out of range errors, so maybe over checking but got the thing to run for nearly an hour without error.

They do cover the whole rectangular island with 3 trees too!
' Try Rosetta Boid Challenge b+ 2022-03-04 modifying my Boid Watching code
' No mod here, this is complete makeover and I'm sure not what RC coders expect.

global xmax, ymax  ' screen limit
xmax = 85 : ymax = 16
dim board$(xmax, ymax), x(50), y(50), oldx(50), oldy(50) 'for the birds

global bird$, wall$, mt$ ' these are the map symbols
bird$ = "O" : wall$ = "#" : mt$ = "."

global nb, cx, cy, dx, dy, noise  'count birds, core bird x, y, and direction x, y,
' noise some randomness to flying formation
noise = .5

call loadBoard ' this sets up from RC challenge
call showBoard
while 1
   scan
   call showBirds
   call flock
   call pause 200
wend

Sub flock ' the birds are slipping through now and then (subscript out) so doing allot of checks
   savecx = cx: savecy = cy
   [test]
   cx = cx + dx: cy = cy + dy
   If cx < 1 Then dx = -1 * dx: cx = 1
   If cx > xmax Then dx = -1 * dx: cx = xmax
   If cy < 1 Then dy = -1 * dy: cy = 1
   If cy > ymax Then dy = -1 * dy: cy = ymax
   If board$(cx, cy) = wall$ Then
       cx = savecx: cy = savecy
       if rnd(0) > .5 then dx = -1 * dx
       if rnd(0) > .5 then dy = -1 * dy
       cx = cx + dx : cy = cy + dy

       'somethings sneaking out of range somewhere so we check again
       If cx < 1 Then dx = -1 * dx: cx = 1
       If cx > xmax Then dx = -1 * dx: cx = xmax
       If cy < 1 Then dy = -1 * dy: cy = 1
       If cy > ymax Then dy = -1 * dy: cy = ymax
   End If
   x(1) = cx: y(1) = cy

   'flock around the core
   idx = 1: r = 0
   Do
       r = r + 1
       For x = 0 To r
           y = Int(Sqr(r * r - x * x))
           xx = cx + x: yy = cy + y: have = 0
           If xx >= 1 and yy >= 1 and xx <= xmax And yy <= ymax Then ' point on board
               For j = 1 To idx 'already have?
                   If x(j) = xx And y(j) = yy Then have = -1: Exit For
               Next
               If have = 0 And rnd(0) > noise Then
                   If board$(xx, yy) = mt$ Then ' board$ is empty
                       idx = idx + 1
                       x(idx) = xx: y(idx) = yy
                       If idx = nb Then Exit Sub
                   End If
               End If
           End If
           xx = cx + x: yy = cy - y: have = 0
           If xx >= 1 and yy >= 1 and xx <= xmax And yy <= ymax Then ' point on board
               For j = 1 To idx
                   If x(j) = xx And y(j) = yy Then have = -1: Exit For
               Next
               If have = 0 And rnd(0) > noise Then
                   If board$(xx, yy) = mt$ Then ' board$ is empty
                       idx = idx + 1
                       x(idx) = xx: y(idx) = yy
                       If idx = nb Then Exit Sub
                   End If
               End If
           End If
           xx = cx - x: yy = cy + y: have = 0
           If xx >= 1 and yy >= 1 and xx <= xmax And yy <= ymax Then ' point on board
               For j = 1 To idx
                   If x(j) = xx And y(j) = yy Then have = -1: Exit For
               Next
               If have = 0 And rnd(0) > noise Then
                   If board$(xx, yy) = mt$ Then ' board$ is empty
                       idx = idx + 1
                       x(idx) = xx: y(idx) = yy
                       If idx = nb Then Exit Sub
                   End If
               End If
           End If
           xx = cx - x: yy = cy - y: have = 0
           If xx >= 1 and yy >= 1 and xx <= xmax And yy <= ymax Then ' point on board
               For j = 1 To idx
                   If x(j) = xx And y(j) = yy Then have = -1: Exit For
               Next
               If have = 0 And rnd(0) > noise Then
                   If board$(xx, yy) = mt$ Then ' board$ is empty
                       idx = idx + 1
                       x(idx) = xx: y(idx) = yy
                       If idx = nb Then Exit Sub
                   End If
               End If
           End If
       Next
   Loop Until idx = nb
End Sub

sub showBirds
   for i = 1 to nb
       if oldx(i) <> 0 and oldy(i) <> 0 then locate oldx(i), oldy(i) : Print "."; 'erase last bird
   next
   for i = 1 to nb
       if x(i) >= 1 and x(i) <= xmax and y(i) >=1 and y(i) <= ymax then
           if board$(x(i), y(i)) <> wall$ then
               locate x(i), y(i) : Print bird$;
               oldx(i) = x(i) : oldy(i) = y(i)
           end if
       end if
   next
end sub

sub showBoard
   locate 1, 1
   for y = 1 to 16
       for x = 1 to 85
           print board$(x, y);
       next
       print
   next
   for i = 1 to nb
       locate x(i), y(i) : Print bird$;
   next
end sub

sub loadBoard
       d$ =".......###############..............................................................."
   d$ =d$ +".......###############..............................................................."
   d$ =d$ +"......#################.............................................................."
   d$ =d$ +"O......###############..............................................................."
   d$ =d$ +"OO.....###############..............................................................."
   d$ =d$ +"OO.....###############....................#.........................#................"
   d$ =d$ +"OO......#############...................#####...................#########............"
   d$ =d$ +"OO......#############...................#####..................###########..........."
   d$ =d$ +"OO.......###########...................#######................#############.........."
   d$ =d$ +"OO.........#######......................#####................###############........."
   d$ =d$ +"OO............#.........................#####...............#################........"
   d$ =d$ +"OO........................................#.................#################........"
   d$ =d$ +"O...........................................................#################........"
   d$ =d$ +"............................................................#################........"
   d$ =d$ +"...........................................................###################......."
   d$ =d$ +"............................................................#################........"

   for i = 1 to 16
       s$ = mid$(d$, (i - 1) * 85 + 1, 85)
       for j = 1 to 85
           c$ = mid$(s$, j, 1)
           if c$ = bird$ then 'seperate the birds from the landscape
               nb = nb + 1
               x(nb) = j : y(nb) = i
               board$(j, i) = mt$
           else
               board$(j, i) = c$
           end if
       next
       print
   next
   cx = 1 : cy = 8 ' core bird
   dx = 1 : dy = 1 ' head east for starters
end sub

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



[tsh73]

surprisingly small flicker.
Intresting how they scatter after being sqweezed

[bplus]

Can GOSUB be contained in a SUB? I could cut allot of duplicate code in the above. If so, can I exit a sub from inside a GOSUB.

My guess is yes for former question if contained completely and no for latter question because GOSUB needs clean break with RETURN.

[tsh73]

It looks to be working for me, both questions
global k
for i = 1 to 10
call sub1
print i,k
next

end

sub sub1
   gosub [chk]
   print "after GOSUB",k
   exit sub
[chk]
   k=k+1
   if k = 5 then exit sub  'exit a sub fro withing gosub
   return
end sub



[bplus]

Thanks tsh73 saved me time testing, yes looks OK now < 140 LOC, less I think than anyone else at RC but they're probably doing it the hard way
C     549
Go    491
Java  350
Julia 244
Nim   397
Phix  650
Wren  971

JB/LB    138Phix is doing a whole 3D graphics thing in GUI, what can't do 2D text? , must be great to watch though!

A quick scan of Julia, does look a bit like this:



' Try Rosetta Boid Challenge b+ 2022-03-04 modifying my Boid Watching code
' 2022-03-05 Boids #2 - Roseeta Code.txt
' No mod here, this is complete makeover and I'm sure not what RC coders expect.
' 2022-03-06 Boids #2A - Rosetta Code.txt
' cut some redundant code in flock

global xmax, ymax  ' screen limit
xmax = 85 : ymax = 16
dim board$(xmax, ymax), x(50), y(50), oldx(50), oldy(50) 'for the birds

global bird$, wall$, mt$ ' these are the map symbols
bird$ = "O" : wall$ = "#" : mt$ = "."

global nb, cx, cy, dx, dy, noise  'count birds, core bird x, y, and direction x, y,
noise = .5 ' noise some randomness to flying formation

call loadBoard ' this sets up from RC challenge
call showBoard
while 1
   scan
   call showBirds
   call flock
   call pause 200
wend

Sub flock ' the birds are slipping through now and then (subscript out) so doing allot of checks
   savecx = cx: savecy = cy
   cx = cx + dx: cy = cy + dy
   gosub [Test]
   If board$(cx, cy) = wall$ Then
       cx = savecx: cy = savecy
       if rnd(0) > .5 then dx = -1 * dx
       if rnd(0) > .5 then dy = -1 * dy
       cx = cx + dx : cy = cy + dy
       gosub [Test]
   End If
   x(1) = cx: y(1) = cy
   idx = 1: r = 0 'flock around the core
   Do
       r = r + 1
       For x = 0 To r
           y = Int(Sqr(r * r - x * x))
           xx = cx + x: yy = cy + y: have = 0
           GoSub [CheckPoint]
           xx = cx + x: yy = cy - y: have = 0
           GoSub [CheckPoint]
           xx = cx - x: yy = cy + y: have = 0
           GoSub [CheckPoint]
           xx = cx - x: yy = cy - y: have = 0
           GoSub [CheckPoint]
       Next
   Loop Until idx = nb
   exit sub
[Test]
   If cx < 1 Then dx = -1 * dx: cx = 1
   If cx > xmax Then dx = -1 * dx: cx = xmax
   If cy < 1 Then dy = -1 * dy: cy = 1
   If cy > ymax Then dy = -1 * dy: cy = ymax
return
[CheckPoint]
   If xx >= 1 and yy >= 1 and xx <= xmax And yy <= ymax Then ' point on board
       For j = 1 To idx 'already have?
           If x(j) = xx And y(j) = yy Then have = -1: Exit For
       Next
       If have = 0 And rnd(0) > noise Then
           If board$(xx, yy) = mt$ Then ' board$ is empty
               idx = idx + 1
               x(idx) = xx: y(idx) = yy
               If idx = nb Then Exit Sub
           End If
       End If
   End If
return
End Sub

sub showBirds
   for i = 1 to nb
       if oldx(i) <> 0 and oldy(i) <> 0 then locate oldx(i), oldy(i) : Print "."; 'erase last bird
   next
   for i = 1 to nb
       if x(i) >= 1 and x(i) <= xmax and y(i) >=1 and y(i) <= ymax then
           if board$(x(i), y(i)) <> wall$ then
               locate x(i), y(i) : Print bird$;
               oldx(i) = x(i) : oldy(i) = y(i)
           end if
       end if
   next
end sub

sub showBoard
   locate 1, 1
   for y = 1 to 16
       for x = 1 to 85
           print board$(x, y);
       next
       print
   next
   for i = 1 to nb
       locate x(i), y(i) : Print bird$;
   next
end sub

sub loadBoard
       d$ =".......###############..............................................................."
   d$ =d$ +".......###############..............................................................."
   d$ =d$ +"......#################.............................................................."
   d$ =d$ +"O......###############..............................................................."
   d$ =d$ +"OO.....###############..............................................................."
   d$ =d$ +"OO.....###############....................#.........................#................"
   d$ =d$ +"OO......#############...................#####...................#########............"
   d$ =d$ +"OO......#############...................#####..................###########..........."
   d$ =d$ +"OO.......###########...................#######................#############.........."
   d$ =d$ +"OO.........#######......................#####................###############........."
   d$ =d$ +"OO............#.........................#####...............#################........"
   d$ =d$ +"OO........................................#.................#################........"
   d$ =d$ +"O...........................................................#################........"
   d$ =d$ +"............................................................#################........"
   d$ =d$ +"...........................................................###################......."
   d$ =d$ +"............................................................#################........"
   for i = 1 to 16
       s$ = mid$(d$, (i - 1) * 85 + 1, 85)
       for j = 1 to 85
           c$ = mid$(s$, j, 1)
           if c$ = bird$ then 'seperate the birds from the landscape
               nb = nb + 1 : x(nb) = j : y(nb) = i : board$(j, i) = mt$
           else
               board$(j, i) = c$
           end if
       next
       print
   next
   cx = 1 : cy = 8 : dx = 1 : dy = 1 ' core bird head south east for starters
end sub

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




[Rod]

Some mindless boids, now need to study what B+ has been up to.

   dim boids(100,4) 'x,y,dx,dy
   x=1
   y=2
   dx=3
   dy=4
   for n= 1 to 100
       boids(n,x)=int(rnd(0)*800)
       boids(n,y)=int(rnd(0)*600)
       boids(n,dx)=4-rnd(0)*8
       boids(n,dy)=4-rnd(0)*8
   next

   'nomainwin
   WindowWidth =800
   WindowHeight =600
   UpperLeftX = int((DisplayWidth-WindowWidth)/2)
   UpperLeftY = int((DisplayHeight-WindowHeight)/2)
   open "Boids" for graphics_nsb as #1
   print #1, "down ; fill black ; color white ; trapclose [quit]"

   [draw]
   #1 "discard"
   for n=1 to 100
   #1 "color black ; set ";boids(n,x);" ";boids(n,y)
       boids(n,x)=boids(n,x)+boids(n,dx)
       boids(n,y)=boids(n,y)+boids(n,dy)
       if boids(n,x)>=800 then boids(n,dx)=boids(n,dx)*-1
       if boids(n,y)>=600 then boids(n,dy)=boids(n,dy)*-1
       if boids(n,x)<0 then boids(n,dx)=boids(n,dx)*-1
       if boids(n,y)<0 then boids(n,dy)=boids(n,dy)*-1
       #1 "color white ; set ";boids(n,x);" ";boids(n,y)
   next
   scan
   goto [draw]



[quit]
   close #1
   end



[bplus]

Heh heh! Gnats!

I should take the OP and make it study-able, the one for RC is basically a cheat (because individual birds are shifted as needed, not as they would fly). Nobody caught it or if they did, they were too polite to say. Yeah that's it. ;-)) The Original Post (OP) is real thing with predators as well as obstacles.

[Rod]

Still need obstacles, I have walls but need the trees. Also no idea how to influence direction of travel as yet. As I read it the goal is left to right passage. Oh and predators! Not sure it is going to be very fast in Liberty. I might try sprites to see if it gets a bit faster. But these boids do flock together. Problem is they slow down and drift to the edges.

b=25
dim b(b,4) 'x,y,dx,dy
   x=1
   y=2
   dx=3
   dy=4
   for n= 1 to b
       b(n,x)=int(rnd(0)*800)
       b(n,y)=int(rnd(0)*600)
       b(n,dx)=4-rnd(0)*8
       b(n,dy)=4-rnd(0)*8
   next

   'nomainwin
   WindowWidth =800
   WindowHeight =600
   UpperLeftX = int((DisplayWidth-WindowWidth)/2)
   UpperLeftY = int((DisplayHeight-WindowHeight)/2)
   open "Boids" for graphics_nsb as #1
   print #1, "down ; fill black ; color white ; trapclose [quit]"

   [draw]
   #1 "discard"
   for n=1 to b

       'erase old position
       #1 "color black ; set ";b(n,x);" ";b(n,y)

       'find all near boids to be influenced by
       for m=1 to b
           if n<>m  then
               dist=sqr((b(m,x)-b(n,x))*(b(m,x)-b(n,x))+(b(m,y)-b(n,y))*(b(m,y)-b(n,y)))
               if dist <20 and dist>5 then 'influence
                   b(n,dx)=(b(n,dx)+b(m,dx))/2
                   b(n,dy)=(b(n,dy)+b(m,dy))/2
               end if
               if dist <5 then 'too close
                   b(n,dx)=b(n,dx)*-.5
                   b(n,dy)=b(n,dy)*-.5
               end if
           end if
       next

       'move boid
       b(n,x)=b(n,x)+b(n,dx)
       b(n,y)=b(n,y)+b(n,dy)
       if b(n,x)>=800 then b(n,dx)=b(n,dx)*-1
       if b(n,y)>=600 then b(n,dy)=b(n,dy)*-1
       if b(n,x)<0 then b(n,dx)=b(n,dx)*-1
       if b(n,y)<0 then b(n,dy)=b(n,dy)*-1
       #1 "color white ; set ";b(n,x);" ";b(n,y)


   next
   scan
   goto [draw]


[quit]
   close #1
   end



[bplus]

Rod you are missing code, it starts =25 ??

I think I used swirl to fly away from border, obstacle or predator and towards the center of a forming flock. The bird can't do a 180 it has to turn gracefully. So I tracked the birds heading with RadianAngle = "a" added swirl = PI/6 (a negative swirl might be an improvement needed in OP).

So dx = speed * cos(a), dy = speed * sin(a) bird flight speed is constant. 

JB/LB does calculations OK speed wise, line, circles, points need speed but birds can become sprites.

[Rod]

Thanks, fixed post and will play with swirl. Definitely needs more speed to make it worth while. Will try sprites.