Boid Watching
#1
EDIT: adding some more background 

At JB the subject of Boids came up but I couldn't get what bluatigro was talking about, then I found the youtube videos!
Boids is like birds flocking and breaking apart and regrouping...
Quote:Oh hey! I decided to look up boid, thinking bluatigro might be trying for bird, I ran into this almost immediately:
http://www.youtube.com/watch?v=GUkjC-69vaw

and the one right after too, (not any more)
http://www.youtube.com/watch?v=QbUPfMXXQIY

cool!

Boid Rules (these can be turned on or off, so you get all kinds of variations of "behavior"):
1. Avoid barriers / obstacles 
2. Head in same direction as your "radial" group
3. Head or Group towards "center of gravity" so to speak
4. Space out while grouping, don't get too close or overlap.

I was using mouse position as centering / obstacle toggle.

In video's I liked how they formed particular groups, not just one big one around mouse position.


Got it working pretty well, watch the critters flock and break apart:
Code:
_TITLE "Boid Watching   by bplus 2018-04-28"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'from
'Boid Watching.txt for JB 2.0 B+ 2018-04-28
'from
'networking.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-14
' combined with
'Mouse school critter attract or repell.txt for JB 2.0 B+ 2018-04-26
' plus what I picked up generally from the videos

CONST xmax = 1200
CONST ymax = 700
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 40
RANDOMIZE TIMER


'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
spacing = 15 'space amount approx

noise = 0 'general randomness added to movements individualism

Boids = 20

DIM SHARED x(Boids), y(Boids), a(Boids), r(Boids), c&(Boids), predator

FOR i = 1 TO Boids
   newCritter i
NEXT

WHILE 1
   CLS
   IF INKEY$ = "q" THEN END
   FOR i = 1 TO Boids
       m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY

       FOR j = i + 1 TO Boids

           IF distance(x(i), y(i), x(j), y(j)) < 100 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
                   ' The following is STATIC's adjustment of ball positions if overlapping
                   ' before calcultion 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 + 20 THEN
                       nx = nx / nm
                       ny = ny / nm
                       ' Regardless of momentum exchange, separate the balls along the lone connecting them.
                       WHILE nm < spacing + 30
                           x(j) = x(j) + .1 * spacing * nx
                           y(j) = y(j) + .1 * spacing * ny
                           x(i) = x(i) - .1 * spacing * nx
                           y(i) = y(i) - .1 * 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
       IF x(i) < 30 OR x(i) > xmax - 30 OR y(i) < 30 OR y(i) > ymax - 30 THEN a(i) = a(i) + sway
       'out of sight
       IF x(i) < -1 * r(i) OR x(i) > xmax + r(i) OR y(i) < -1 * r(i) OR y(i) > ymax + r(i) THEN 'start new
           newCritter i
       END IF
       IF distance(x(i), y(i), mx, my) < 75 THEN
           a(i) = _ATAN2(my - y(i), mx - x(i)) + _PI
           predatorMode = 1
       ELSE
           predatorMode = 0
       END IF

       'update points
       x(i) = x(i) + 10 * COS(a(i)) + RND * noise - .5 * noise
       y(i) = y(i) + 10 * SIN(a(i)) + RND * noise - .5 * noise

       critter i

   NEXT
   'mouse predator
   COLOR _RGB32(160, 0, 0)
   fcirc mx, my, 25

   _DISPLAY
   _LIMIT 20
WEND

SUB newCritter (index)
   x(index) = rand(0, xmax)
   y(index) = rand(0, ymax)
   a(index) = -2 * _PI * RND
   r(index) = rand(10, 15)
   c&(index) = _RGB32(rand(64, 155), rand(64, 155), rand(64, 155))
END SUB

SUB critter (i)
   COLOR c&(i)
   fcirc x(i), y(i), r(i)
   IF predator THEN
       x1 = x(i) + .75 * r(i) * COS(a(i) - _PI(1 / 9) + _PI)
       y1 = y(i) + .75 * r(i) * SIN(a(i) - _PI(1 / 9) + _PI)
       x2 = x(i) + .75 * r(i) * COS(a(i) + _PI(1 / 9) + _PI)
       y2 = y(i) + .75 * r(i) * SIN(a(i) + _PI(1 / 9) + _PI)
   ELSE
       x1 = x(i) + .75 * r(i) * COS(a(i) - _PI(1 / 9))
       y1 = y(i) + .75 * r(i) * SIN(a(i) - _PI(1 / 9))
       x2 = x(i) + .75 * r(i) * COS(a(i) + _PI(1 / 9))
       y2 = y(i) + .75 * r(i) * SIN(a(i) + _PI(1 / 9))
   END IF
   COLOR _RGB32(255, 255, 255)
   fcirc x1, y1, .25 * r(i)
   fcirc x2, y2, .25 * r(i)
   IF predator THEN
       x3 = x1 + .125 * r(i) * COS(a(i) + _PI)
       y3 = y1 + .125 * r(i) * SIN(a(i) + _PI)
       x4 = x2 + .125 * r(i) * COS(a(i) + _PI)
       y4 = y2 + .125 * r(i) * SIN(a(i) + _PI)
   ELSE
       x3 = x1 + .125 * r(i) * COS(a(i))
       y3 = y1 + .125 * r(i) * SIN(a(i))
       x4 = x2 + .125 * r(i) * COS(a(i))
       y4 = y2 + .125 * r(i) * SIN(a(i))
   END IF
   COLOR _RGB32(0, 0, 0)
   fcirc x3, y3, .125 * r(i)
   fcirc x4, y4, .125 * r(i)
END SUB

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
   DIM subRadius AS LONG, RadiusError AS LONG
   DIM X AS LONG, Y AS LONG

   subRadius = ABS(R)
   RadiusError = -subRadius
   X = subRadius
   Y = 0

   IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

   ' Draw the middle span here so we don't draw it twice in the main loop,
   ' which would be a problem with blending turned on.
   LINE (CX - X, CY)-(CX + X, CY), , BF

   WHILE X > Y
       RadiusError = RadiusError + Y * 2 + 1
       IF RadiusError >= 0 THEN
           IF X <> Y + 1 THEN
               LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
               LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
           END IF
           X = X - 1
           RadiusError = RadiusError - X * 2
       END IF
       Y = Y + 1
       LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
       LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
   WEND
END SUB

FUNCTION rand% (lo%, hi%)
   rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

FUNCTION distance (x1, y1, x2, y2)
   distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
END FUNCTION

FUNCTION rdir ()
   IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION
B += x
Reply
#2
Cute. In regards to 'Boids' and 'Critters' someone has a lot of time on their hands... lol  Nicely done. Wink
May your journey be free of incident.

Live long and prosper.
Reply
#3
Oh hey! I added some background info to the original post. 

If you don't know what Boids are check out the youtube links.


EDIT: Thanks Johnno!
B += x
Reply
#4
Hi Walter, 

I saw this and contacted you in PM here is snap of what I saw.


Attached Files Thumbnail(s)

B += x
Reply
#5
@Bplus,

What exactly were you doing when this error message appeared?

Are you able to recreate the error?

I checked the log files, both for this site and the one for the server, and I do not see any errors corresponding with your IP address. However, I do see a recent server error message that is a bit strange though, but I am not sure what caused it. From what I can determine so far, it appears there was an error trying to load a CSS file. It is possible the hard drive the server was attempting to pull the file from had some bad sectors on it, causing the error, but the server has redundant hard drives (RAID) to prevent this from becoming a major problem.

I personally have never seen this error message on this forum before, so this is a new one on me. Remember, I don't have access to the internal workings of the server, so I am limited on what I can do.
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#6
Boid watching? Wasn't that one of Curly Joe's, from the Three Stoogies, hobbies?

Suggestion: Maybe next time code it in America so the flocking boids won't fly apart.

Pete Big Grin
Reply
#7
Hi Walter, 

I think I had just EDITed the 1st post in this thread with the background material, then I went to post #3 to notify others (Johnno at least) of the new material added in first post.

It was just before or just after I posted #3 that I saw the message. I speculated it might have something to do with the links in the added material in the EDIT of post #1? post #3 was not the least bit complex.
B += x
Reply
#8
@Bplus,

Let me know if you can duplicate it. If so, it will give me a clue of where to look.

At this point, I am trying to find the fastest way to update this site without having it stay "closed" for a long period of time. Either way, I believe that once I update it, we should be having less trouble with the software.
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#9
Boids my ascii. They are just your balls with eyes. So I spent 5 minutes playing with your balls. Oh wait, this isn't going well. OK, fine they are boids. So I spent 5-minutes playing with your boids, nice effects! It's a far cry better than my very first program, which I wrote in 1981. It was a square, not a ball... Oh, but it was a flashing square... and as it flashed, it migrated from one end of the screen to the other! Yeah, my father-in-law, who was visiting us, wasn't too impressed either, but I was. Nine years later he was struggling with some POS office software, he's a chiropractor, too, and me, I had a smooth running office with my very own office software I programmed in the same BASIC language that made that flashing migrating square. Long story longer, I'm coming back nine years from now and I expect big things from you! If not, I spent 5-minutes playing with your ba...boids, for nothing!

Pete Big Grin
Reply
#10
Right too many balls, quit playing with them! I must pick it up from the folks I hang out with. Big Grin

Boids Watch 2, no balls:
Code:
_TITLE "Boid Watching 2  by bplus 2018-04-29"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'from Boid Watching.bas for QB64 version 2017 1106/82 B+ 2018-04-28
'from Boid Watching.txt for JB 2.0 B+ 2018-04-28
'from networking.bas  SmallBASIC 0.12.9 [B+=MGA] 2017-04-14
' combined with
'Mouse school critter attract or repell.txt for JB 2.0 B+ 2018-04-26
' plus what I picked up generally from the videos

CONST xmax = 1200
CONST ymax = 700
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 40
RANDOMIZE TIMER


'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
spacing = 15 'space amount approx

noise = 10 'general randomness added to movements individualism

Boids = 50

DIM SHARED x(Boids), y(Boids), z(Boids), a(Boids), r(Boids), c(Boids) AS _UNSIGNED LONG, predator

FOR i = 1 TO Boids
   newCritter i
NEXT

land& = _NEWIMAGE(xmax, ymax, 32)
_DEST land&
drawLandscape
_DEST 0

WHILE 1
   _PUTIMAGE , land&, 0
   IF INKEY$ = "q" THEN END
   FOR i = 1 TO Boids
       m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY

       FOR j = i + 1 TO Boids

           IF distance(x(i), y(i), x(j), y(j)) < 100 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
                   ' The following is STATIC's adjustment of ball positions if overlapping
                   ' before calcultion 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 + 20 THEN
                       nx = nx / nm
                       ny = ny / nm
                       ' Regardless of momentum exchange, separate the balls along the lone connecting them.
                       WHILE nm < spacing + 30
                           x(j) = x(j) + .1 * spacing * nx
                           y(j) = y(j) + .1 * spacing * ny
                           x(i) = x(i) - .1 * spacing * nx
                           y(i) = y(i) - .1 * 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
       IF y(i) < 30 OR y(i) > ymax - 30 THEN a(i) = a(i) + sway
       'out of sight
       IF x(i) < -1 * r(i) OR x(i) > xmax + r(i) OR y(i) < -1 * r(i) OR y(i) > ymax + r(i) THEN 'start new
           newCritter i
       END IF
       IF distance(x(i), y(i), mx, my) < 75 THEN
           a(i) = _ATAN2(my - y(i), mx - x(i)) + _PI
           predatorMode = 1
       ELSE
           predatorMode = 0
       END IF

       'update points
       x(i) = x(i) + 10 * COS(a(i)) + RND * noise - .5 * noise
       y(i) = y(i) + 10 * SIN(a(i)) + RND * noise - .5 * noise

       drawBoid i

   NEXT
   'mouse predator
   'COLOR _RGB32(160, 0, 0)
   'fcirc mx, my, 25

   _DISPLAY
   _LIMIT 20
WEND

SUB newCritter (index)
   x(index) = rand(xmax, xmax + 100)
   y(index) = rand(100, ymax - 50)
   z(index) = RND * .6 + .4
   a(index) = _PI * RND + _PI(.5)
   r(index) = rand(10, 12)
   r = rand(10 + INT(z(i) * 40), 40 + INT(z(i) * 40))
   c(index) = _RGB32(r, r, r)
END SUB

SUB critter (i)
   COLOR c&(i)
   fcirc x(i), y(i), r(i)
   IF predator THEN
       x1 = x(i) + .75 * r(i) * COS(a(i) - _PI(1 / 9) + _PI)
       y1 = y(i) + .75 * r(i) * SIN(a(i) - _PI(1 / 9) + _PI)
       x2 = x(i) + .75 * r(i) * COS(a(i) + _PI(1 / 9) + _PI)
       y2 = y(i) + .75 * r(i) * SIN(a(i) + _PI(1 / 9) + _PI)
   ELSE
       x1 = x(i) + .75 * r(i) * COS(a(i) - _PI(1 / 9))
       y1 = y(i) + .75 * r(i) * SIN(a(i) - _PI(1 / 9))
       x2 = x(i) + .75 * r(i) * COS(a(i) + _PI(1 / 9))
       y2 = y(i) + .75 * r(i) * SIN(a(i) + _PI(1 / 9))
   END IF
   COLOR _RGB32(255, 255, 255)
   fcirc x1, y1, .25 * r(i)
   fcirc x2, y2, .25 * r(i)
   IF predator THEN
       x3 = x1 + .125 * r(i) * COS(a(i) + _PI)
       y3 = y1 + .125 * r(i) * SIN(a(i) + _PI)
       x4 = x2 + .125 * r(i) * COS(a(i) + _PI)
       y4 = y2 + .125 * r(i) * SIN(a(i) + _PI)
   ELSE
       x3 = x1 + .125 * r(i) * COS(a(i))
       y3 = y1 + .125 * r(i) * SIN(a(i))
       x4 = x2 + .125 * r(i) * COS(a(i))
       y4 = y2 + .125 * r(i) * SIN(a(i))
   END IF
   COLOR _RGB32(0, 0, 0)
   fcirc x3, y3, .125 * r(i)
   fcirc x4, y4, .125 * r(i)
END SUB

SUB drawBoid (i)
   r = RND * _PI(1 / 4) 'flapping
   w = _PI(7 / 12)
   IF predator THEN
       x1 = x(i) + z(i) * r(i) * COS(a(i) + _PI)
       y1 = y(i) + z(i) * r(i) * SIN(a(i) + _PI)
       x2 = x(i) + z(i) * r(i) * COS(a(i) + _PI + w + r)
       y2 = y(i) + z(i) * r(i) * SIN(a(i) + _PI + w + r)
       x3 = x(i) + z(i) * r(i) * COS(a(i) + _PI - w - r)
       y3 = y(i) + z(i) * r(i) * SIN(a(i) + _PI - w - r)

   ELSE
       x1 = x(i) + z(i) * r(i) * COS(a(i))
       y1 = y(i) + z(i) * r(i) * SIN(a(i))
       x2 = x(i) + z(i) * r(i) * COS(a(i) + w + r)
       y2 = y(i) + z(i) * r(i) * SIN(a(i) + w + r)
       x3 = x(i) + z(i) * r(i) * COS(a(i) - w - r)
       y3 = y(i) + z(i) * r(i) * SIN(a(i) - w - r)
   END IF
   filltri x(i), y(i), x1, y1, x2, y2, c(i)
   filltri x(i), y(i), x1, y1, x3, y3, c(i)
END SUB

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
   a& = _NEWIMAGE(1, 1, 32)
   _DEST a&
   PSET (0, 0), K
   _DEST 0
   _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
   _FREEIMAGE a& '<<< this is important!
END SUB

'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
   DIM subRadius AS LONG, RadiusError AS LONG
   DIM X AS LONG, Y AS LONG

   subRadius = ABS(R)
   RadiusError = -subRadius
   X = subRadius
   Y = 0

   IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB

   ' Draw the middle span here so we don't draw it twice in the main loop,
   ' which would be a problem with blending turned on.
   LINE (CX - X, CY)-(CX + X, CY), , BF

   WHILE X > Y
       RadiusError = RadiusError + Y * 2 + 1
       IF RadiusError >= 0 THEN
           IF X <> Y + 1 THEN
               LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
               LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
           END IF
           X = X - 1
           RadiusError = RadiusError - X * 2
       END IF
       Y = Y + 1
       LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
       LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
   WEND
END SUB

FUNCTION rand% (lo%, hi%)
   rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

FUNCTION distance (x1, y1, x2, y2)
   distance = ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) ^ .5
END FUNCTION

FUNCTION rdir ()
   IF RND < .5 THEN rdir = -1 ELSE rdir = 1
END FUNCTION

SUB drawLandscape
   'the sky
   FOR i = 0 TO ymax
       midInk 0, 0, 128, 128, 128, 255, i / ymax
       LINE (0, i)-(xmax, i)
   NEXT
   'the land
   startH = ymax - 200
   rr = 70: gg = 70: bb = 90
   FOR mountain = 1 TO 6
       Xright = 0
       y = startH
       WHILE Xright < xmax
           ' upDown = local up / down over range, change along Y
           ' range = how far up / down, along X
           upDown = (RND * .8 - .35) * (mountain * .5)
           range = Xright + rand(15, 25) * 2.5 / mountain
           lastx = Xright - 1
           FOR X = Xright TO range
               y = y + upDown
               COLOR _RGB(rr, gg, bb)
               LINE (lastx, y)-(X, ymax), , BF 'just lines weren't filling right
               lastx = X
           NEXT
           Xright = range
       WEND
       rr = rand(rr - 15, rr): gg = rand(gg - 15, gg): bb = rand(bb - 25, bb)
       IF rr < 0 THEN rr = 0
       IF gg < 0 THEN gg = 0
       IF bb < 0 THEN bb = 0
       startH = startH + rand(5, 20)
   NEXT
END SUB

SUB midInk (r1, g1, b1, r2, g2, b2, fr)
   COLOR _RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
END SUB

B += x
Reply
#11
Flocking brilliant!

Pete Big Grin
Reply