⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

Only uses about 2.5% cpu with 60 boids at 25 FPS. Split into two source files, for no particular reason. {{libheader|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
```