Boids flocking simulation

[neil]

Here's a boids flocking simulation demo that works.
The algorithm is written in qbasic code but it compiled with FreeBasic after I added #lang "qb"
Maybe someone could do something with it to make it better. The Screen 1 resolution is too small.

Code: Select all

#lang "qb"
DECLARE SUB restartValues ()
DECLARE SUB drawObstacle (obstacle AS ANY)
DECLARE SUB drawObstacles ()
DECLARE SUB initializeObstacles ()
DECLARE SUB setVectorMagnitude (a AS ANY, m AS SINGLE)
DECLARE SUB calculateVectorSubstraction (a AS ANY, b AS ANY)
DECLARE SUB calculateVectorDivision (a AS ANY, value AS SINGLE)
DECLARE SUB calculateVectorNormalization (inputVector AS ANY, normalizedVector AS ANY)
DECLARE SUB calculateNormalizedVector (inputVector AS ANY, normalizedVector AS ANY)
DECLARE FUNCTION getVectorMagnitude! (a AS ANY)
DECLARE FUNCTION getDistanceBetweenPoints! (a AS ANY, b AS ANY)
DECLARE SUB updateBoidPosition (boid AS ANY)
DECLARE SUB computeBoidForces (boid AS ANY)
DECLARE SUB updateBoidNeighbors (boid AS ANY)
DECLARE SUB updateBoid (boid AS ANY)
DECLARE SUB updateBoids ()
DECLARE SUB drawBoid (boid AS ANY)
DECLARE SUB drawBoids ()
DECLARE SUB delay (seconds#)
DECLARE SUB initializeBoids ()

DEFINT A-Z
RANDOMIZE TIMER

CONST SCREENWIDTH = 319
CONST SCREENHEIGHT = 199
CONST NUMOBSTACLES = 7
CONST OBSTACLERADIUS = 10!
CONST OBSTACLEACTIONRADIUS = 38!
CONST NUMBOIDS = 50
CONST NEIGHBORRADIUS = 26!
CONST MAXSPEED = 3!
CONST CROWDRADIUS = 6!

TYPE TVector
 x AS SINGLE
 y AS SINGLE
END TYPE

TYPE TBoid
 id AS INTEGER
 position AS TVector
 prevPosition AS TVector
 prevPrevPosition AS TVector
 movement AS TVector
 totalNeighbours AS INTEGER
END TYPE

TYPE TObstacle
 position AS TVector
END TYPE

DIM SHARED neighbours(NUMBOIDS, NUMBOIDS) AS INTEGER
DIM SHARED boids(NUMBOIDS) AS TBoid
DIM SHARED obstacles(NUMOBSTACLES) AS TObstacle

SCREEN 1

CALL initializeBoids
CALL initializeObstacles

DO UNTIL key$ = "n"
  CLS
  FOR i = 0 TO 500
    CALL updateBoids
    CALL drawBoids
    CALL drawObstacles
    CALL delay(.03)
  NEXT i

  LOCATE 1, 1
  PRINT "Continue(Yes/No/Restart)"
  LOCATE 1, 25
  INPUT key$
  key$ = LCASE$(LEFT$(key$, 1))
  IF key$ = "r" THEN
    CALL restartValues
  END IF
LOOP

END

SUB calculateVectorDivision (a AS TVector, value AS SINGLE)
  a.x = a.x / value
  a.y = a.y / value
END SUB

SUB calculateVectorNormalization (inputVector AS TVector, normalizedVector AS TVector)
  magnitude! = getVectorMagnitude(inputVector)
  IF magnitude! > 0! THEN
    normalizedVector.x = inputVector.x / magnitude!
    normalizedVector.y = inputVector.y / magnitude!
  ELSE
    normalizedVector.x = inputVector.x
    normalizedVector.y = inputVector.y
  END IF
END SUB

SUB calculateVectorSubstraction (a AS TVector, b AS TVector)
  a.x = a.x - b.x
  a.y = a.y - b.y
END SUB

SUB computeBoidForces (boid AS TBoid)
  DIM neighbor AS TBoid
  DIM obstacle AS TObstacle
  DIM normalizedVector AS TVector
  DIM distanceVector AS TVector
  DIM cohesionVector AS TVector
  cohesionVector.x = 0
  cohesionVector.y = 0
  cohesionCount! = 0!

  FOR idx = 0 TO boid.totalNeighbours - 1
    neighborId = neighbours(boid.id, idx)
    neighbor = boids(neighborId)
    distance! = getDistanceBetweenPoints(boid.position, neighbor.position)
   
    ' Calculate the alignment between the boid and its neighbors
    IF ((distance! > 0) AND (distance! < NEIGHBORRADIUS)) THEN
      CALL calculateVectorNormalization(neighbor.movement, normalizedVector)
      CALL calculateVectorDivision(normalizedVector, distance!)
      boid.movement.x = boid.movement.x + normalizedVector.x
      boid.movement.y = boid.movement.y + normalizedVector.y
    END IF

    ' Calculate the cohesion force
    IF ((distance! > 0) AND (distance! < NEIGHBORRADIUS)) THEN
      cohesionVector.x = cohesionVector.x + neighbor.position.x
      cohesionVector.y = cohesionVector.y + neighbor.position.y
      cohesionCount! = cohesionCount! + 1!
    END IF

    ' Calculate the separation force
    IF ((distance! > 0!) AND (distance! < CROWDRADIUS)) THEN
      distanceVector.x = boid.position.x
      distanceVector.y = boid.position.y
      CALL calculateVectorSubstraction(distanceVector, neighbor.position)
      CALL calculateVectorNormalization(distanceVector, normalizedVector)
      CALL calculateVectorDivision(normalizedVector, distance!)
      boid.movement.x = boid.movement.x + normalizedVector.x
      boid.movement.y = boid.movement.y + normalizedVector.y
    END IF
  NEXT idx

  IF cohesionCount! > 0! THEN
    CALL calculateVectorDivision(cohesionVector, cohesionCount!)
    CALL calculateVectorSubstraction(cohesionVector, boid.position)
    CALL setVectorMagnitude(cohesionVector, .05)
    boid.movement.x = boid.movement.x + cohesionVector.x
    boid.movement.y = boid.movement.y + cohesionVector.y
  END IF

  ' Calculate force to avoid obstacles
  FOR id = 0 TO NUMOBSTACLES - 1
    obstacle = obstacles(id)
    distance! = getDistanceBetweenPoints(boid.position, obstacle.position)
    IF ((distance! > 0!) AND (distance! < OBSTACLEACTIONRADIUS)) THEN
      distanceVector.x = boid.position.x
      distanceVector.y = boid.position.y
      CALL calculateVectorSubstraction(distanceVector, obstacle.position)
      CALL calculateVectorNormalization(distanceVector, normalizedVector)
      CALL calculateVectorDivision(normalizedVector, distance!)
      boid.movement.x = boid.movement.x + 8! * normalizedVector.x
      boid.movement.y = boid.movement.y + 8! * normalizedVector.y
    END IF
  NEXT id

  ' Create noise movement
  boid.movement.x = boid.movement.x + (.35 * ((RND(1) * 2!) - 1!))
  boid.movement.y = boid.movement.y + (.35 * ((RND(1) * 2!) - 1!))

  ' Limit the movement
  magnitude! = getVectorMagnitude(boid.movement)
  IF magnitude! > MAXSPEED THEN
    ratio! = MAXSPEED / magnitude!
    boid.movement.x = boid.movement.x * ratio!
    boid.movement.y = boid.movement.y * ratio!
  END IF
END SUB

SUB delay (seconds#)
  start# = TIMER
  DO
  LOOP UNTIL (TIMER - start#) >= seconds#
END SUB

SUB drawBoid (boid AS TBoid)
  LINE (boid.prevPrevPosition.x, boid.prevPrevPosition.y)-(boid.prevPosition.x, boid.prevPosition.y), 0
  IF (ABS(boid.prevPosition.x - boid.position.x) < (SCREENWIDTH - MAXSPEED - 1)) AND (ABS(boid.prevPosition.y - boid.position.y) < (SCREENHEIGHT - MAXSPEED - 1)) THEN
    LINE (boid.prevPosition.x, boid.prevPosition.y)-(boid.position.x, boid.position.y), 1
  END IF
END SUB

SUB drawBoids
  FOR id = 0 TO NUMBOIDS - 1
    CALL drawBoid(boids(id))
  NEXT id
END SUB

SUB drawObstacle (obstacle AS TObstacle)
  CIRCLE (obstacle.position.x, obstacle.position.y), OBSTACLERADIUS, 2
  'CIRCLE (obstacle.position.x, obstacle.position.y), OBSTACLEACTIONRADIUS, 3
  'PSET (obstacle.position.x, obstacle.position.y), 3
END SUB

SUB drawObstacles
  FOR id = 0 TO NUMOBSTACLES - 1
    CALL drawObstacle(obstacles(id))
  NEXT id
END SUB

FUNCTION getDistanceBetweenPoints! (a AS TVector, b AS TVector)
  getDistanceBetweenPoints = SQR((a.x - b.x) ^ 2 + (a.y - b.y) ^ 2)
END FUNCTION

FUNCTION getVectorMagnitude! (a AS TVector)
  getVectorMagnitude = SQR((a.x ^ 2) + (a.y ^ 2))
END FUNCTION

SUB initializeBoids
  FOR id = 0 TO NUMBOIDS - 1
    boids(id).id = id
    boids(id).position.x = INT(RND * (SCREENWIDTH + 1))
    boids(id).position.y = INT(RND * (SCREENHEIGHT + 1))
    boids(id).prevPosition.x = boids(id).position.x
    boids(id).prevPosition.y = boids(id).position.y
    boids(id).prevPrevPosition.x = boids(id).position.x
    boids(id).prevPrevPosition.y = boids(id).position.y
    boids(id).movement.x = .5 * ((RND(1) * 2!) - 1!)
    boids(id).movement.y = .5 * ((RND(1) * 2!) - 1!)
    boids(id).totalNeighbours = 0
  NEXT id
END SUB

SUB initializeObstacles
  FOR id = 0 TO NUMOBSTACLES - 1
    obstacles(id).position.x = INT(RND * (SCREENWIDTH - (OBSTACLERADIUS * 2!) + 1!) + OBSTACLERADIUS)
    obstacles(id).position.y = INT(RND * (SCREENHEIGHT - (OBSTACLERADIUS * 2!) + 1!) + OBSTACLERADIUS)
  NEXT id
END SUB

SUB restartValues
  CALL initializeBoids
  CALL initializeObstacles
END SUB

SUB setVectorMagnitude (a AS TVector, m AS SINGLE)
  magnitude! = getVectorMagnitude(a)
  IF magnitude! > 0! THEN
    ratio! = m / magnitude!
    a.x = a.x * ratio!
    a.y = a.y * ratio!
  END IF
END SUB

SUB updateBoid (boid AS TBoid)
  CALL updateBoidNeighbors(boid)
  CALL computeBoidForces(boid)
  CALL updateBoidPosition(boid)
END SUB

SUB updateBoidNeighbors (boid AS TBoid)
  numNeighbors% = 0
  FOR id = 0 TO NUMBOIDS - 1
    IF id <> boid.id THEN
      IF (ABS(boids(id).position.x - boid.position.x) < NEIGHBORRADIUS) AND (ABS(boids(id).position.y - boid.position.y) < NEIGHBORRADIUS) THEN
	neighbours(boid.id, numNeighbors%) = id
	numNeighbors% = numNeighbors% + 1
      END IF
    END IF
  NEXT id
  boid.totalNeighbours = numNeighbors%
END SUB

SUB updateBoidPosition (boid AS TBoid)
  boid.prevPrevPosition.x = boid.prevPosition.x
  boid.prevPrevPosition.y = boid.prevPosition.y
  boid.prevPosition.x = boid.position.x
  boid.prevPosition.y = boid.position.y
  boid.position.x = (boid.position.x + boid.movement.x + SCREENWIDTH) MOD SCREENWIDTH
  boid.position.y = (boid.position.y + boid.movement.y + SCREENHEIGHT) MOD SCREENHEIGHT
END SUB

SUB updateBoids
  FOR id = 0 TO NUMBOIDS - 1
    CALL updateBoid(boids(id))
  NEXT id
END SUB

[BasicCoder2]

Maybe someone could do something with it to make it better. The Screen 1 resolution is too small.

What you could do better is write one yourself after learning how it is done?

I don't waste time on modifying other people's programs unless they have explained in detail how it works rather then having to painfully extract the algorithms from the code itself. If you are smart enough to decipher other people's code you are smart enough to write your own version.

There are explanation of rules for controlling boid behaviors. You could start with a simple program like the one below and add those rules and the calculations required to get the measurements used by those rules.

Here is a basic start to which you might add rules. My coding tends to be less than professional as I have bad habits from teaching myself a long time ago but I think it is mostly readable.

Code: Select all

const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians

const SCRW = 600
const SCRH = 600
screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(120,120,255):cls  'blue paper, black ink

const TOTBRD = 22  'number of birds

type BIRD
    as single x          'x position of center of disc
    as single y          'y position of center of disc
    as single dx         'change in x position per cycle
    as single dy         'change in y position per cycle
    as single v          'speed
    as single rad        'radius of bird travel
    as single angle      'direction in degrees
    as ulong  c          'color of bird
end type


dim shared as BIRD birds(1 to TOTBRD)
'initialize birds() values
for i as integer = 1 to TOTBRD
    birds(i).x = int(rnd(1)*SCRW)
    birds(i).y = int(rnd(1)*SCRH)
    birds(i).v = int(rnd(1)*3)+8     ' random speed of bird
    birds(i).angle = int(rnd(1)*350) ' random direction of travel
    birds(i).rad = 3                 ' radius of bird circle
    birds(i).c = rgb(255,0,0)        ' color of bird red
next i

sub update()
    screenlock
    cls
    
    'draw birds
    for i as integer = 1 to TOTBRD
        'draw circle
        circle (birds(i).x,birds(i).y), (birds(i).rad) ,birds(i).c,,,,f
        'draw tail
        line (birds(i).x,birds(i).y)-(birds(i).x + cos((birds(i).angle+180) * DtoR)*20,birds(i).y + sin((birds(i).angle+180) * DtoR)*20),rgb(0,0,0)        
    next i    
    screenunlock
end sub


dim as single frameTimer
frameTimer = timer

do
    

    if timer > frameTimer + 0.005 then
        frameTimer = timer

        for i as integer = 1 to TOTBRD 
            
            'compute change in position
            birds(i).dx = cos(birds(i).angle * DtoR) * birds(i).v
            birds(i).dy = sin(birds(i).angle * DtoR) * birds(i).v

            'add change to move bird
            birds(i).x = birds(i).x + birds(i).dx
            birds(i).y = birds(i).y + birds(i).dy
            
            'wrap around
            if birds(i).x > SCRW then birds(i).x = 0
            if birds(i).x < 0 then birds(i).x = SCRW
            if birds(i).y > SCRH then birds(i).y = 0
            if birds(i).y < 0 then birds(i).y = SCRH
            
        next i

        update()
        
    end if

    sleep 2

loop until multikey(&H01)

[neil]

@BasicCoder2
It ran way too fast. I changed sleep 2 to sleep 30 and it ran nicely for about 5 seconds then it froze.
I'm not sure what the problem is.

[BasicCoder2]

Neil,
You must have a super fast computer compared with mine

You might try and change the 0.005 for the timer comparison to something bigger like 0.05 or some other larger value.

Code: Select all

if timer > frameTimer + 0.005 then

You might use dodicat's regulate routine. Or perhaps I should have used it as I think it keeps the frame rate consistent between computers.

Code: Select all

        Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            Var t=Timer
            frames+=1
            If (t-t3)>=1 Then t3=t:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=T
            Return sleeptime
        End Function

Call in your main loop.

Code: Select all

            Sleep regulate(40,fps),1

[neil]

@BasicCoder2

Do I need the timer part I commented out? It works nicely with out it.

Commenting out this seemed to fix the problem on my PC. It always works no more issues.
''if timer > frameTimer + 0.005 then
'' frameTimer = timer

your code ...

''End if

'' Sleep 2

I used dodicats regulator instead of Sleep 2
Sleep regulate(20,fps),1

[BasicCoder2]

The timer and sleep is in dodicat's regulator so yes you don't need the code you commented out.

[neil]

Here's BasicCoder2's boids version for learning. I finally got it running stable on my PC. Let me know how the speed regulator I added is working. On my PC 20 fps to 40 fps seems to be acceptable.

Code: Select all

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
  Static As Double timervalue,_lastsleeptime,t3,frames
  Var t=Timer
  frames+=1
  If (t-t3)>=1 Then t3=t:fps=frames:frames=0
  Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
  If sleeptime<1 Then sleeptime=1
  _lastsleeptime=sleeptime
  timervalue=T
  Return sleeptime
End Function

const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians
Dim as long fps

const SCRW = 600
const SCRH = 600
screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(120,120,255):cls  'blue paper, black ink

const TOTBRD = 22  'number of birds

type BIRD
    as single x          'x position of center of disc
    as single y          'y position of center of disc
    as single dx         'change in x position per cycle
    as single dy         'change in y position per cycle
    as single v          'speed
    as single rad        'radius of bird travel
    as single angle      'direction in degrees
    as ulong  c          'color of bird
end type

dim shared as BIRD birds(1 to TOTBRD)
'initialize birds() values
for i as integer = 1 to TOTBRD
    birds(i).x = int(rnd(1)*SCRW)
    birds(i).y = int(rnd(1)*SCRH)
    birds(i).v = int(rnd(1)*3)+8     ' random speed of bird
    birds(i).angle = int(rnd(1)*350) ' random direction of travel
    birds(i).rad = 3                 ' radius of bird circle
    birds(i).c = rgb(255,0,0)        ' color of bird red
next i

sub update()
    screenlock
    cls
    
    'draw birds
    for i as integer = 1 to TOTBRD
        'draw circle
        circle (birds(i).x,birds(i).y), (birds(i).rad) ,birds(i).c,,,,f
        'draw tail
        line (birds(i).x,birds(i).y)-(birds(i).x + cos((birds(i).angle+180) * DtoR)*20,birds(i).y + sin((birds(i).angle+180) * DtoR)*20),rgb(0,0,0)        
    next i    
    screenunlock
end sub

do
    
        for i as integer = 1 to TOTBRD 
            
            'compute change in position
            birds(i).dx = cos(birds(i).angle * DtoR) * birds(i).v
            birds(i).dy = sin(birds(i).angle * DtoR) * birds(i).v

            'add change to move bird
            birds(i).x = birds(i).x + birds(i).dx
            birds(i).y = birds(i).y + birds(i).dy
            
            'wrap around
            if birds(i).x > SCRW then birds(i).x = 0
            if birds(i).x < 0 then birds(i).x = SCRW
            if birds(i).y > SCRH then birds(i).y = 0
            if birds(i).y < 0 then birds(i).y = SCRH
            
        next i

        update()
      
      '' 20 fps to 40 fps works OK on my PC 
      Sleep regulate(30,fps),1

loop until multikey(&H01)

[BasicCoder2]

Neil,
You can delete,
dim as single frameTimer
frameTimer = timer
it is not being used.

The other factor in how fast the birds move is determined by their speed.
The larger the value the faster they will move.

birds(i).v = int(rnd(1)*3)+8 ' random speed of bird

So is the program easy to understand so far? I am not all that expert in math myself but is the math clear to you?

Our BIRD type has an x,y position, speed v and direction in degrees and we want to compute its next position.
Each cycle (or frame) is the time measurement.

So first I have calculated the change in the x position, dx and the change in the y position, dy. We can add the changes dx and dy to the current x,y position to determine the next x,y position.

[neil]

To understand what your talking about I would have to take a beginners trigonometry class. You make this type of math seem like its so easy but for some of us its not.

[BasicCoder2]

If you can't do something yourself you can't program a computer to do it. So if you are interested understanding boid simulations you need to understand the math being used.

[neil]

@BasicCoder2
Thanks for your help.
This explains Modeling flocking behaviors of animals with three simple rules. This is a good demo and explanation of it.
At least I learned something about simulating the behavior of animals and the 3 simple rules.
https://www.youtube.com/watch?v=QbUPfMXXQIY

[BasicCoder2]

@neil

Maybe someone could do something with it to make it better. The Screen 1 resolution is too small.

This explains Modeling flocking behaviors of animals with three simple rules.

Like I wrote earlier there are explanations of rules for implementing boid behaviors. They would be easy enough to implement in FreeBASIC if you had the time or interest. If anyone had the interest they would have done it. I am not sure what your interests are.

[neil]

Here's some FreeBasic code I found swarm.
It follows the mouse cursor.

Code: Select all

'' by notthecheatr Dec 09, 2008 
''
'' notthecheatr Flocking simulator
''
''

'A pretty simple but instructive flocking simulator.  I started out trying to
'simulate bird flocks;  by modifying various parameters it can look like a number
'of things, but the default settings look more like an insect swarm.

'Include the FreeBASIC graphics library
#Include Once "fbgfx.bi"

'A macro that returns the smaller of the two arguments passed to it
#Macro MIN (A, B)
  IIf(A > B, B, A)
#EndMacro

'Number of birds
Const numBirds = 300

'Screen width and height
Const SCRW = 800
Const SCRH = 600

'Control the color of the screen background and foreground
Const SCREEN_BG = 0
Const SCREEN_FG = &hffffffff


'Motion multiplier - used to modify the overall speed of the birds.  Do NOT make this negative!
'Other than that, this is safe to modify, but keep it within reasonable values.
Const MOVMULT = 10
'Maximum velocity - used to cap the velocity of the birds so they don't move too fast.
'Note that this is the maximum of the absolute value of the velocity;  that means that the
'actual velocity of each bird is always kept between -MAXVEL and MAXVEL.  Do NOT make this negative!
'Other than that, this is fairly safe to modify.  One interesting thing to do is make it much larger than
'usual (like multiply it by 10).  Then the swarm will kind of bounce back and forth like a pendulum
'because it keeps overshooting the mouse.
'The one thing this does NOT cap is random motion of the birds.  If random motion is enabled and MOVMULT
'is larger than MAXVEL, even if the velocity of the particles is capped the random motion won't be.  However,
'this is not very interesting because then the random motion tends to be more obvious than the flocking.
Const MAXVEL = 15

'Modifying these constants drastically messes the behavior up a lot.
'If you modify them, they should be left below 1, and CENTERMOV should always be greater than or equal to AVGVEL.
Const CENTERMOV = 0.5
Const AVGVEL = 0.5

'Controls how much the birds will move in order to escape from their nearest neighbor should they be
'within <NEARNESS_CAP> pixels of their nearest neighbor.  Probably the easiest way to control the spread
'of the flock;  larger values make the swarm spread apart further.  Larger values also make this have more effect
'on the swarm and thus decreases the relative effect of all the other factors.  For example, in this program, making
'this value larger will cause the swarm to move toward the mouse more slowly.  Making it smaller will make the swarm
'move toward the mouse more quickly.  
Const NEARMULT = 1

'This constant determines how fast the flock moves toward the mouse
Const MOUSEMOV = 5

'Nearness cap.  If a bird is further from its nearest neighbor than this, we don't bother to
'push it away from its nearest neighbor.  This is used to keep the flock close together.  Larger values
'let the flock pull apart further.  However, the effect is small if any unless MOVMULT and/or MAXVEL
'are also modified.  At the default settings, for example, the difference between 5 and 10 is not noticeable;
'the difference between 0.1 and 5 is slightly noticeable.
Const NEARNESS_CAP = 5

'Randomness multiplier.  If this is 0, the birds don't move randomly at all.  If it's non-zero, some random
'movement is incorporated into the motion of the particles, irrespective of the velocity of the particles.
'For a flock of birds, random movement should be 0.  For a swarm of insects, random movement can be non-zero.
Const RNDMULT = 0.1




'Simple 2d vector type
'I use this for practically everything that has a position, velocity, or acceleration
Type vector2d
  As Double x, y
End Type

'Because I wrote this program experimentally, I used arrays.
'Preferably each bird would be an object, and a parent "birdSystem" object would contain an array
'of bird objects.  I'm a bit lazy though, so I've left it like this.
Dim As vector2d birdspos (1 To numBirds)
Dim As vector2d birdsvel (1 To numBirds)

'Used so we can calculate the average center of the birds in the flock, and the average velocity
'of all the birds.  Both of these are used to calculate the new velocity of each bird every tick.
Dim As vector2d avgcenter, avgvelocity

'Motion of the group.  This is added to whatever the velocity is of each bird to calculate its new
'position at each tick.  The default settings don't use it, but it's there to show how easy it is to
'move the whole group and still have the interesting individual motion of "flocking patterns" that we
'have.
Dim As vector2d groupmotion

'These are the intermediate parts used in the calculation of the average position and velocity of the
'birds.  These are used to get the total sum;  then we divide by the number of birds and place the
'result in the avgcenter and avgvelocity vectors.
Dim As vector2d avgCalc
Dim As vector2d avgVelCalc

'Used to find which bird is closest to any other bird.  Every tick, we look at each bird and check it against
'all the other birds to figure out which other bird is closest to it.  Then we set its velocity moving the opposite
'direction of this "nearest neighbor" - though that's only part of the velocity component, of course.
Dim As Double closestdist
Dim As Integer closestBird

'Used to calculate the difference between x and y coordinates when finding the distance between any two birds.
Dim As Double xdiff, ydiff

'Camera X and Y.  By pressing the arrow keys the camera can be moved.  All this really does is modify the
'offset to which the flocks are drawn, and the value recognized as the mouse position.
Dim As Double camx, camy

'Mouse X and Y.  Used to find out where the mouse is on the screen.
Dim As Integer mx, my

'As noted earlier, group motion is not used.  It's a feature only present to show
'how easy it is to do.
groupmotion.x = 0
groupmotion.y = 0

'Set the random seed based on the timer.  Whenever we need random numbers, we'll have
'different ones each time we run the program thanks to this.
Randomize Timer

'Set the screen mode
ScreenRes SCRW, SCRH, 32


'If random motion is turned off, the birds must be initialized to random positions on the screen
'or they will all get stuck together at the same position.  Note that if RNDMULT <> 0 then
'this code is unneeded - but if RNDMULT = 0, this code is necessary or there will be no "flock".
'You can use it even if RNDMULT is 0 (just remove the If...End If lines) for an interesting effect,
'but it isn't necessary so isn't enabled by default unless RNDMULT = 0
If RNDMULT = 0 Then
  For i As Integer = 1 To numBirds
    birdspos(i).x = (SCRW/2) + (Rnd*numBirds)-(numBirds/2)
    birdspos(i).y = (SCRH/2) + (Rnd*numBirds)-(numBirds/2)
  Next i
End If


'Here is our main loop.  The interesting part of the program is all inside this loop.
Do
  'Each time we initialize our Position and Velocity sums to 0.
  avgCalc.x = 0
  avgCalc.y = 0
  avgVelCalc.x = 0
  avgVelCalc.y = 0
  
  'Then we add them all up in order to calculate the average position and velocity of the flock
  For i As Integer = 1 To numBirds
    avgCalc.x += birdspos(i).x
    avgCalc.y += birdspos(i).y
    
    avgVelCalc.x += birdsvel(i).x
    avgVelCalc.y += birdsvel(i).y
  Next i
  
  'Divide by the number of birds to get the averages
  avgcenter.x = avgCalc.x/numBirds
  avgcenter.y = avgCalc.y/numBirds
  avgvelocity.x = avgVelCalc.x/numBirds
  avgvelocity.y = avgVelCalc.y/numBirds
  
  
  'This is the clever bit of my program, the part I came up with on my own.
  'Well, maybe there are more clever ways to do this, but I thought it pretty
  'clever:
  
  'For each bird...
  For i As Integer = 1 To numBirds
    'We initialize our "closest neighbor" to either the first bird in the list or,
    'if this IS the first bird in the list, the second bird in the list.
    If i = 1 Then
      closestbird = 2
      
      'You should recognize this as a rather ugly form of the Pythagorean theorem.  To find the
      'distance between two points (x1, y1) and (x2, y2), we use the formula
      '    Sqr(((x2-x1)^2)+((y2-y1)^2))
      'That is, we take the differences of the x and y coordinates separately, square each difference
      '(that is, multiply it by itself), add the results together, and take the squareroot of that.
      xdiff = birdspos(1).x - birdspos(2).x
      ydiff = birdspos(1).y - birdspos(2).y
      closestdist = Sqr((xdiff*xdiff)+(ydiff*ydiff))
    Else
      closestbird = 2
      xdiff = birdspos(i).x - birdspos(1).x
      ydiff = birdspos(i).y - birdspos(1).y
      closestdist = Sqr((xdiff*xdiff)+(ydiff*ydiff))
    End If
    
    'Now for every bird
    For j As Integer = 1 To numBirds
      '(except for the one we're already doing)
      If j <> i Then
        'Get the difference between the X and Y coordinates of bird we're checking and the other bird
        xdiff = birdspos(i).x - birdspos(j).x
        ydiff = birdspos(i).y - birdspos(j).y
        
        'Now check if the distance between the two birds is lower than the last "closest" bird guess. 
        If closestdist > Sqr((xdiff*xdiff)+(ydiff*ydiff)) Then
          'If so, it becomes our new guess for the "closest neighbor"
          closestdist = Sqr((xdiff*xdiff)+(ydiff*ydiff))
          closestbird = j
        End If
      End If
    Next j
    
    'By this point, we've checked every bird so we know now which one must be the closest to the bird
    'we're currently looking at.
    
    'Here we force the bird to move towards the average position of the group, that is, the center of the group.
    'We use the constants CENTERMOV and MOVMULT (set earlier in the code) because these shouldn't be modified much.
    'If you do need to modify them, find where the constants are defined and read the comments to find out what is
    'safe to do and what is not safe to do.
    If birdspos(i).x > avgcenter.x Then birdsvel(i).x -= CENTERMOV*MOVMULT
    If birdspos(i).x < avgcenter.x Then birdsvel(i).x += CENTERMOV*MOVMULT
    If birdspos(i).y > avgcenter.y Then birdsvel(i).y -= CENTERMOV*MOVMULT
    If birdspos(i).y < avgcenter.y Then birdsvel(i).y += CENTERMOV*MOVMULT
    
    'NEARNESS_CAP is a constant defined earlier.  Its effect isn't huge, but it's important
    'nonetheless.
    If closestdist < NEARNESS_CAP Then
      'NEARMULT is a really interesting contant to modify.  It modifies how much the birds try
      'to avoid their nearest neighbor, or the strength of their aversion to their neighbors.
      If birdspos(i).x > birdspos(closestbird).x Then birdsvel(i).x += NEARMULT*MOVMULT
      If birdspos(i).x < birdspos(closestbird).x Then birdsvel(i).x -= NEARMULT*MOVMULT
      If birdspos(i).y > birdspos(closestbird).y Then birdsvel(i).y += NEARMULT*MOVMULT
      If birdspos(i).y < birdspos(closestbird).y Then birdsvel(i).y -= NEARMULT*MOVMULT
    End If
    
    'This tries to make the velocity of an individual bird closer to the average velocity of
    'the group.  The effect on the flocking behavior isn't huge, but it's certainly there.
    'The flocking behavior is still interesting without it, but I think it looks better with it.
    If birdsvel(i).x > avgvelocity.x Then birdsvel(i).x -= (AVGVEL*MOVMULT)
    If birdsvel(i).y > avgvelocity.y Then birdsvel(i).y -= (AVGVEL*MOVMULT)
    If birdsvel(i).x < avgvelocity.x Then birdsvel(i).x += (AVGVEL*MOVMULT)
    If birdsvel(i).y < avgvelocity.y Then birdsvel(i).y += (AVGVEL*MOVMULT)
    
    'This is the velocity cap.  We cap both the X and Y velocity between -MAXVEL and MAXVEL.
    'Not the most sophisticated system, but it works, and it's easier than capping the
    'entire velocity (which would require trig functions and might be slower).
    If birdsvel(i).x > MAXVEL Then birdsvel(i).x = MAXVEL
    If birdsvel(i).y > MAXVEL Then birdsvel(i).y = MAXVEL
    If birdsvel(i).x < -MAXVEL Then birdsvel(i).x = -MAXVEL
    If birdsvel(i).y < -MAXVEL Then birdsvel(i).y = -MAXVEL
    

    'And here we make the flock move toward the mouse
    GetMouse mx, my
    'Modify the actual mouse position by the camera position
    mx += camx
    my += camy
    
    'Set the velocity of the individual bird so it's moving toward the mouse position
    If birdspos(i).x > mx Then birdsvel(i).x -= MOUSEMOV
    If birdspos(i).y > my Then birdsvel(i).y -= MOUSEMOV
    If birdspos(i).x < mx Then birdsvel(i).x += MOUSEMOV
    If birdspos(i).y < my Then birdsvel(i).y += MOUSEMOV

    
    'Move the position of the bird by its velocity plus a random value in any direction.
    'Randomness can be turned off simply by setting RNDMULT to 0.  This makes the flock seem
    'more like a flock of birds;  with randomness on, it looks more like a swarm of insects.
    birdspos(i).x += birdsvel(i).x + ((Rnd*2*MOVMULT*RNDMULT)-(MOVMULT*RNDMULT))
    birdspos(i).y += birdsvel(i).y + ((Rnd*2*MOVMULT*RNDMULT)-(MOVMULT*RNDMULT))
    
    'As noted earlier, group motion is not used but implemented.  As you can see,
    'we simply add the group motion vector to the position of each bird - all this means
    'is that the group as a whole has a velocity in addition to the individual velocity of
    'each bird.  By modifying this in varying ways, you can achieve a number of interesting effects.
    birdspos(i).x += groupmotion.x
    birdspos(i).y += groupmotion.y
    
  'Finally!  We finish all the individual bird stuff.
  Next i
  
  'Arrow keys move the camera by 100 pixels in any direction
  If MultiKey(FB.SC_LEFT) Then camx -= 100
  If MultiKey(FB.SC_RIGHT) Then camx += 100
  If MultiKey(FB.SC_UP) Then camy -= 100
  If MultiKey(FB.SC_DOWN) Then camy += 100
  
  
  'The drawing portion of the code
  ScreenLock
  
  'Clear screen by drawing the background color over it in a filled box.
  'One interesting application for this is as a painting program, in which case you might comment this line out.
  'However, you'd probably be more likely to use more simple particle effects in such a program.
  Line (0, 0)-(SCRW, SCRH), SCREEN_BG, BF
  
  'Now draw each bird
  For i As Integer = 1 To numBirds
    'Default method is with circles;  pixels are too small to see, so the flocking behavior is
    'less apparent.
    Circle(birdspos(i).x-camx, birdspos(i).y-camy), 2, SCREEN_FG
    'PSet (birdspos(i).x-camx, birdspos(i).y-camy), SCREEN_FG
  Next i
  ScreenUnLock

  'Delay.  This can be modified to slow things down or speed them up, depending on
  'how fast your system is.
  Sleep 50, 1
  
'Continue the main loop until ESCAPE is pressed
Loop Until MultiKey(FB.SC_ESCAPE)

[neil]

@BasicCoder2
You are correct.
I am looking into taking an advanced math class. I need to learn more about physics.
Then I would have a better understanding of how it works using FreeBasic's math functions.