Boids/Phix: Difference between revisions
mNo edit summary |
m (Phix/pGUI) |
||
Line 1:
Only uses about 2.5% cpu with 60 boids at 25 FPS. Split into two source files, for no particular reason.
{{libheader|Phix/pGUI}}
<lang Phix>--
-- demo\pGUI\boids3d.exw
|
Revision as of 15:54, 25 May 2020
Only uses about 2.5% cpu with 60 boids at 25 FPS. Split into two source files, for no particular reason.
<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>