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

<lang Phix>-- -- 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, 
       radius_label, radius_txt, boids_label, boids_txt, shadow_check

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 draw_shadows = 1

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

   if draw_shadows then
       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[5]])
       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
       v1 = sq_add(pt,make_length(v, 20))

       -- make the base of the triangle
       sv = make_length(get_ortho(v), 4)
       v2 = sq_add(pt,sv)
       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
       if draw_shadows then
           for j=6 to 8 do
               pt = verts[i][j]
               pt[2] = 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

function add_boids(integer num) 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)
       case radius_txt: N_DIST = max(i,1)
       case boids_txt:  BOIDS  = add_boids(i)
   end switch
   return IUP_DEFAULT

end function

function shadow_cb(Ihandle /*ih*/, integer state)

   draw_shadows = state
   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_label = IupLabel("Max Speed","PADDING=0x4")
   speed_txt = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"), 
                       "SPIN=Yes, SPINMIN=1, RASTERSIZE=48x")
   IupSetInt(speed_txt,"VALUE",V_MAX)

   dist_label = IupLabel("Separation","PADDING=0x4")
   dist_txt = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"), 
                            "SPIN=Yes, SPINMIN=10, SPINMAX=600, RASTERSIZE=48x")
   IupSetInt(dist_txt,"VALUE",DIST)

   radius_label = IupLabel("Neighbor Radius","PADDING=0x4")
   radius_txt = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"), 
                        "SPIN=Yes, SPINMIN=1, SPINMAX=200, RASTERSIZE=48x")
   IupSetInt(radius_txt,"VALUE",N_DIST)

   boids_label = IupLabel("Boids","PADDING=0x4")
   boids_txt = IupText("VALUECHANGED_CB", Icallback("valuechanged_cb"), 
                       "SPIN=Yes, SPINMIN=1, SPINMAX=200, RASTERSIZE=48x")
   IupSetInt(boids_txt,"VALUE",BOIDS)

   shadow_check = IupToggle("Draw Shadows","ACTION",Icallback("shadow_cb"),"VALUE=ON")
   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({radius_label,radius_txt},"NORMALIZESIZE=HORIZONTAL"),
                   IupVbox({boids_label,boids_txt},"NORMALIZESIZE=HORIZONTAL"),
                   IupVbox({shadow_check,restart},"NORMALIZESIZE=HORIZONTAL")})
   IupDestroy(IupNormalizer({speed_label,shadow_check},"NORMALIZE=VERTICAL"))
   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()</lang>

<lang Phix>-- -- 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[1]*v[1]+v[2]*v[2]+v[3]*v[3])

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[1]*v[1]+u[2]*v[2]

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][2]<DIST then

           other = boidsn[n[i][1]]

           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][1]]

           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][1]]
           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)

   boidsnp1[bid][B_X..B_Z] = sq_add(boidsnp1[bid][B_X..B_Z],boidsnp1[bid][B_XV..B_ZV])

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</lang>