# Boids/Phix

Only uses about 2.5% cpu with 60 boids at 25 FPS. Split into two source files, for no particular reason.

Library: Phix/pGUI
```--
-- demo\pGUI\boids3d.exw
--
-- Originally by by Matt Lewis
-- Ported from arwen to pGUI, Pete Lomax June 2017
--
include pGUI.e
include boids3d.e

constant TITLE = "Boids 3D on pGUI"

Ihandle canvas, dialog,
restart, speed_label, speed_txt, dist_label, dist_txt,
cdCanvas cddbuffer, cdcanvas

integer ox,oy,oz
procedure set_observer()
{ox,oy,oz} = {floor(X_MAX/2),floor(Y_MAX/2),Z_MAX*2}
end procedure

sequence colors = {}

sequence verts = {}

integer dx = 0, dy = 0, dw = 0, dh = 0

function project_point(sequence pt)
atom d
atom px,py,pz

{px,py,pz} = pt
if pz=oz then
d = 0.0001
else
d =  1-pz/(pz-oz)
end if

px = floor(ox+(ox-px)/d)
py = dh - floor(oy+(oy-py)/d)

return {px,py}
end function

procedure draw_lines(sequence coords)
--
-- Draw zero or more lines.
--  The lines are drawn between the sets of coordinates in coords.
--  This sequence can contain Colors, Lines, or Points:
--      A Color is a single atom that is a 24-bit color value. Subsequent lines use this color.
--      A Line is a 4-element sequence {X1,Y1,X2,Y2} that specifies the X,Y position of a lines
--          starting point and the X,Y position of its end point. The line is drawn from X1,Y1
--          to X2,Y2.
--      A Point is a 2-element sequence {X,Y} that gives the X,Y position of the end-point
--          of a line. The line is drawn to this position from the last end-point supplied.
--          There must have been a preceding Line (or Point), else x1 unassigned error.
--
-- If no color parameters are supplied, the current pen color for the control is used.
--
-- Example:
--
--      -- draw a shape in TheWindow
--      draw_lines({White,{40,0,0,80},{80,80},{40,0},
--                  Blue,{40,5,0,85},{80,85},{40,5}})
--
--  draws white lines {40,0}..{0,80}, {0,80}..{80,80}, {80,80}..{40,0}
--    and blue lines {40,5}..{0,85}, {0,85}..{80,85}, {80,85}..{40,5}.
--
atom x1, y1, x2, y2
object ci

for i = 1 to length(coords) do
ci = coords[i]
if atom(ci) then
cdCanvasSetForeground(cddbuffer, ci)
elsif length(ci) = 4 then
{x1,y1,x2,y2} = ci
cdCanvasLine(cddbuffer,x1,y1,x2,y2)
{x1,y1} = {x2,y2}
elsif length(ci) = 2 then
{x2,y2} = ci
cdCanvasLine(cddbuffer,x1,y1,x2,y2)
{x1,y1} = {x2,y2}
else
?9/0
end if
end for
end procedure

procedure draw_polygon(sequence points)
integer {{x1,y1},{x2,y2},{x3,y3}} = points
cdCanvasBegin(cddbuffer,CD_FILL)
cdCanvasVertex(cddbuffer,x1,y1)
cdCanvasVertex(cddbuffer,x2,y2)
cdCanvasVertex(cddbuffer,x3,y3)
cdCanvasEnd(cddbuffer)
end procedure

function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
integer N, x, y, z
atom x1, y1, z1,
x2, y2, z2
{dw,dh} = IupGetIntInt(canvas, "DRAWSIZE")
{dx,dy} = {floor(dw/4)+1,floor(dh/4)+1}
{X_MAX,Y_MAX,Z_MAX} = {dw,dh,floor((dw+dh)/2)}
set_observer()
cdCanvasActivate(cddbuffer)
cdCanvasClear(cddbuffer)
cdCanvasSetForeground(cddbuffer, #909090)

{x1,y1,z1} = {X_MIN,  0.0,Z_MIN}
{x2,y2,z2} = {X_MAX,Y_MAX,Z_MAX}

-- draw the verticals on the sides and horizontals on the floor and ceiling
N = floor((z2-z1)/100)
if N<3 then N = 3 end if
for i=1 to N-1 do
z = z1+floor((i/N)*(z2-z1))
draw_lines({#808080,
project_point({x2, y2, z}) & project_point({x2, y1, z}),
project_point({x1, y1, z}),
project_point({x1, y2, z}),
#FFFFFF,
project_point({x2, y2, z})})
end for

-- draw the horizontals on the back and the not-quite horizontals on the sides
N = floor((y2-y1)/100)
if N<3 then N = 3 end if
for i=1 to N-1 do
y = y1+floor((i/N)*(y2-y1))
draw_lines({#808080,
project_point({x1,y,z1}) & project_point({x1,y,z2}),
project_point({x2,y,z2}),
project_point({x2,y,z1})})
end for

-- draw the verticals on the back and the not-quite-verticals on floor/ceiling
N = floor((x2-x1)/100)
if N<3 then N = 3 end if
for i=1 to N-1 do
x = x1+floor((i/N)*(x2-x1))
draw_lines({#808080,
project_point({x,y2,z2}) & project_point({x,y1,z2}),
project_point({x,y1,z1}),
#FFFFFF,
project_point({x,y2,z1}) & project_point({x,y2,z2})})
end for

-- draw the minimal room outline
draw_lines({CD_BLACK,
project_point({x1, y1, z2}) & project_point({x2, y1, z2}),
project_point({x2, y2, z2}),
project_point({x1, y2, z2}),
project_point({x1, y1, z2}),
project_point({x1, y1, z1}) & project_point({x1, y1, z2}),
project_point({x2, y1, z1}) & project_point({x2, y1, z2}),
project_point({x2, y2, z1}) & project_point({x2, y2, z2}),
project_point({x1, y2, z1}) & project_point({x1, y2, z2})})

cdCanvasSetForeground(cddbuffer, #A0A0A0)
for i=1 to BOIDS do
draw_polygon(verts[i][6..8])
end for
end if

-- draw boids as polygons, starting with farthest from the POV
for i=BOIDS to 1 by -1 do
sequence v = verts[i]
cdCanvasSetForeground(cddbuffer, colors[v])
draw_polygon(v[2..4])
end for

cdCanvasFlush(cddbuffer)
return IUP_DEFAULT
end function

constant null_u = {0,0}
function get_ortho(sequence v)
sequence y, yhat, z, u

u = v[1..2]
if equal(u, null_u) then
return {1,1,0}
end if
y = {1,1}
yhat = sq_mul(sq_div(dot(u,y),dot(u,u)),u)
z = sq_sub(y,yhat)
if equal(z, null_u) then
return {1,1,0}
end if
return z & 0
end function

function timer_cb(Ihandle /*ih*/)
sequence in,boid, pt, v, v1, v2, v3, sv

move_boids()

in = boidsnp1

if length(colors)=0 then
colors = repeat(0, BOIDS)
for i=1 to BOIDS do
colors[i] = rand(#FFFFFF)
end for
end if

-- convert boid location and velocities into triangles in 3D
-- and project them onto the screen
verts = repeat("", BOIDS)
for i=1 to BOIDS do

boid = in[i]

pt = boid[B_X..B_Z]
v = boid[B_XV..B_ZV]

if equal(v,{0,0,0}) then
v = {1,0,1}
end if

-- the 'nose' of the boid

-- make the base of the triangle
sv = make_length(get_ortho(v), 4)
v3 = sq_sub(pt,sv)

verts[i] = {distance3(pt, {ox,oy,oz}), v1, v2, v3, i, v1, v2, v3}

-- project the 3D points onto a 2D viewing surface
for j=2 to 4 do
verts[i][j] = project_point(verts[i][j])
end for
for j=6 to 8 do
pt = verts[i][j]
pt = 0.0
verts[i][j] = project_point(pt)
end for
end if

end for

-- sort by distance, so nearer boids clip those that are more distant
verts = sort(verts)

IupUpdate(canvas)
return IUP_IGNORE
end function

sequence boid = repeat(0, B_ELEMENTS)
if num>BOIDS then
for i=BOIDS+1 to num do
boid[B_X] = rand(X_MAX)
boid[B_Y] = rand(Y_MAX)
boid[B_Z] = rand(Z_MAX)

boid[B_XV] = floor(V_MAX/2)-rand(V_MAX)
boid[B_YV] = floor(V_MAX/2)-rand(V_MAX)
boid[B_ZV] = floor(V_MAX/2)-rand(V_MAX)
boidsnp1 = append(boidsnp1, boid)
colors &= rand(#FFFFFF)
end for
boidsn = boidsnp1
end if
--  BOIDS = num
return num
end function

function valuechanged_cb(Ihandle ih)
integer i = IupGetInt(ih, "VALUE")
switch ih do
case speed_txt:  V_MAX  = max(i,1)
case dist_txt:   DIST   = max(i,10)
end switch
return IUP_DEFAULT
end function

return IUP_DEFAULT
end function

function restart_cb(Ihandle /*ih*/)
setup()
return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
cdcanvas = cdCreateCanvas(CD_IUP, ih)
cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
cdCanvasSetBackground(cddbuffer, CD_GREY)
return IUP_DEFAULT
end function

function esc_close(Ihandle /*ih*/, atom c)
if c=K_ESC then return IUP_CLOSE end if
return IUP_CONTINUE
end function

procedure main()
Ihandle hbox

IupOpen()

canvas = IupCanvas("RASTERSIZE=625x690")
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))

speed_txt = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"),
"SPIN=Yes, SPINMIN=1, RASTERSIZE=48x")
IupSetInt(speed_txt,"VALUE",V_MAX)

dist_txt = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"),
"SPIN=Yes, SPINMIN=10, SPINMAX=600, RASTERSIZE=48x")
IupSetInt(dist_txt,"VALUE",DIST)

"SPIN=Yes, SPINMIN=1, SPINMAX=200, RASTERSIZE=48x")

boids_txt = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"),
"SPIN=Yes, SPINMIN=1, SPINMAX=200, RASTERSIZE=48x")
IupSetInt(boids_txt,"VALUE",BOIDS)

restart = IupButton("Restart","ACTION",Icallback("restart_cb"),"GAP=0x14")

hbox = IupHbox({IupVbox({speed_label,speed_txt},"NORMALIZESIZE=HORIZONTAL"),
IupVbox({dist_label,dist_txt},"NORMALIZESIZE=HORIZONTAL"),
IupVbox({boids_label,boids_txt},"NORMALIZESIZE=HORIZONTAL"),
dialog = IupDialog(IupVbox({canvas,hbox}, "MARGIN=5x5, GAP=5"),"MINSIZE=455x170")
IupSetAttribute(dialog,"TITLE",TITLE);
IupSetCallback(dialog, "K_ANY", Icallback("esc_close"));

Ihandle hTimer = IupTimer(Icallback("timer_cb"), 40)
setup()
set_observer()
{} = timer_cb(hTimer)
IupShow(dialog)
IupSetAttribute(canvas, "RASTERSIZE", NULL)

IupMainLoop()
IupClose()
end procedure
main()
```
```--
-- demo\pGUI\boids3d.e
-- ===================
--
global integer BOIDS = 60
--             OBSTACLES = 3
global atom N_DIST = 75.0,
DIST = 30.0,
V_MIN = 4.0,
V_MAX = 10.0,
X_MIN = 0.0,
Y_MIN = 0.0,
Z_MIN = 0.0,
X_MAX = 600.0,
Y_MAX = 600.0,
Z_MAX = 600.0

constant DIST_FACTOR = 1.0/100.0

global enum B_X, B_Y, B_Z, B_XV, B_YV, B_ZV, B_ELEMENTS = B_ZV

global sequence boidsn, boidsnp1
--, obstacles

function magnitude3(sequence v)
-- return the scalar magnitude of a 3D vector
return sqrt(v*v+v*v+v*v)
end function

global function make_length(sequence v, atom l)
-- change the scalar magnitude of a 3D vector
return sq_mul(v,l/magnitude3(v))
end function

global function dot(sequence u, sequence v)
-- return the dot product of 2 2D vectors
return u*v+u*v
end function

global function distance3(sequence v1, sequence v2)
-- return the distance between two 3D vectors
return magnitude3(sq_sub(v1[1..3],v2[1..3]))
end function

function boids_dist(integer b1, integer b2)
-- return the distance between two boids, identified by their position in the boidsn sequence
return distance3(boidsn[b1], boidsn[b2])
end function

sequence n_id, n_dist

function neighbors(integer bid, atom distance)
-- return a list of boids within the N_DIST radius of a specified boid
atom dist
integer ix
sequence n, nid, ndist

if bid=1 then
n_id = repeat("", BOIDS)
n_dist = n_id
end if

nid = n_id[bid]
ndist = n_dist[bid]
n = repeat({}, BOIDS)
ix = 0
for i=1 to length(n_id[bid]) do
ix += 1
n[ix] =  {nid[i], ndist[i]}
end for

for i=bid+1 to BOIDS do
dist = boids_dist(bid, i)
if dist<=distance then
ix += 1
n[ix] = {i,dist}
n_id[i] &= bid
n_dist[i] &= dist
end if
end for

return n[1..ix]
end function

procedure maintain_distance(integer bid, sequence n)
-- alter a boids velocity to try to stay at least DIST away from other boids
atom dx, dy, dz
sequence this, other

dx = 0.0
dy = 0.0
dz = 0.0

this = boidsn[bid]

for i=1 to length(n) do
if n[i]<DIST then

other = boidsn[n[i]]

dx -= (other[B_X]-this[B_X])*2
dy -= (other[B_Y]-this[B_Y])*2
dz -= (other[B_Z]-this[B_Z])*2

end if

end for

dx *= DIST_FACTOR
dy *= DIST_FACTOR
dz *= DIST_FACTOR

boidsnp1[bid][B_XV] += dx
boidsnp1[bid][B_YV] += dy
boidsnp1[bid][B_ZV] += dz
end procedure

procedure avoid_walls(integer bid)
-- avoid the boundaries of MAX and MIN for each dimension (X, Y, Z)
sequence this
atom dx, dy, dz, t
dx = 0.0
dy = 0.0
dz = 0.0
this = boidsn[bid]
t = this[B_X]
if t<DIST+X_MIN then
dx += 1
elsif t>X_MAX-DIST then
dx -= 1
end if

t = this[B_Y]
if t<DIST+Y_MIN then
dy += 1
elsif t>Y_MAX-DIST then
dy -= 1
end if

t = this[B_Z]
if t<DIST+Z_MIN then
dz += 1
elsif t>Z_MAX-DIST then
dz -= 1
end if

boidsnp1[bid][B_XV] += dx
boidsnp1[bid][B_YV] += dy
boidsnp1[bid][B_ZV] += dz
end procedure

procedure match_velocity(integer bid, sequence n)
-- try to match the velocity of a boid to its neighbors
atom dx, dy, dz
sequence this, other

if length(n) then
dx = 0.0
dy = 0.0
dz = 0.0
this = boidsn[bid]

for i=1 to length(n) do
other = boidsn[n[i]]

dx += other[B_XV]
dy += other[B_YV]
dz += other[B_ZV]
end for

dx /= length(n)
dy /= length(n)
dz /= length(n)

dx -= this[B_XV]
dy -= this[B_YV]
dz -= this[B_ZV]

dx *= DIST_FACTOR
dy *= DIST_FACTOR
dz *= DIST_FACTOR

boidsnp1[bid][B_XV] += dx
boidsnp1[bid][B_YV] += dy
boidsnp1[bid][B_ZV] += dz
end if
end procedure

procedure move_to_center(integer bid, sequence n)
-- try to move a boid toward the center of its neighbors
atom x, y, z
sequence other
if length(n) then
x = 0.0
y = 0.0
z = 0.0
for i=1 to length(n) do
other = boidsn[n[i]]
x += other[B_X]
y += other[B_Y]
z += other[B_Z]
end for

-- compute the center
x /= length(n)
y /= length(n)
z /= length(n)

-- figure out the direction...
other = boidsn[bid]
x -= other[B_X]
y -= other[B_Y]
z -= other[B_Z]

x *= DIST_FACTOR
y *= DIST_FACTOR
z *= DIST_FACTOR

boidsnp1[bid][B_XV] += x
boidsnp1[bid][B_YV] += y
boidsnp1[bid][B_ZV] += z
end if
end procedure

procedure constrain(integer bid)
-- don't let them go too fast or too slow
atom mag = magnitude3(boidsnp1[bid][B_XV..B_ZV])
if mag>V_MAX then
boidsnp1[bid][B_XV..B_ZV] = sq_div(boidsnp1[bid][B_XV..B_ZV],mag/V_MAX)
elsif mag<V_MIN then
if mag then
boidsnp1[bid][B_XV..B_ZV] = sq_mul(boidsnp1[bid][B_XV..B_ZV],V_MIN/mag)
else
boidsnp1[bid][B_XV] = V_MIN*rand(100)/100
boidsnp1[bid][B_YV] = V_MIN*rand(100)/100
boidsnp1[bid][B_ZV] = V_MIN*rand(100)/100
end if
end if
end procedure

procedure move(integer bid)
end procedure

global procedure setup()
atom mag
boidsn = repeat(repeat(0.0, B_ELEMENTS), BOIDS)
boidsnp1 = boidsn

-- place them randomly
for boid=1 to BOIDS do
boidsnp1[boid][B_X] = rand(X_MAX)
boidsnp1[boid][B_Y] = rand(Y_MAX)
boidsnp1[boid][B_Z] = rand(Z_MAX)

boidsnp1[boid][B_XV] = V_MAX-rand(2*V_MAX)
boidsnp1[boid][B_YV] = V_MAX-rand(2*V_MAX)
boidsnp1[boid][B_ZV] = V_MAX-rand(2*V_MAX)

mag = magnitude3(boidsnp1[boid])/V_MAX

if mag>1.0 then
boidsnp1[boid][B_XV..B_ZV] = sq_div(boidsnp1[boid][B_XV..B_ZV],mag)
end if
end for

--  obstacles = repeat({},OBSTACLES)
--  for o=1 to OBSTACLES do
--      obstacles[o] = {rand(X_MAX), rand(Y_MAX), rand(Z_MAX), 30}
--  end for

boidsn = boidsnp1

end procedure

global procedure move_boids()
sequence n
for boid=1 to BOIDS do
n = neighbors(boid, N_DIST)
maintain_distance(boid, n)
match_velocity(boid, n)
move_to_center(boid, n)
avoid_walls(boid)
constrain(boid)
move(boid)
end for
boidsn = boidsnp1
end procedure
```