⚠️ 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, 
        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
        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
            {x1,y1} = {x2,y2}
        elsif length(ci) = 2 then
            {x2,y2} = ci
            {x1,y1} = {x2,y2}
        end if
    end for
end procedure

procedure draw_polygon(sequence points)
    integer {{x1,y1},{x2,y2},{x3,y3}} = points
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)}
    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))
                    project_point({x2, y2, z}) & project_point({x2, y1, z}),
                    project_point({x1, y1, z}),
                    project_point({x1, y2, z}),
                    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))
                    project_point({x1,y,z1}) & project_point({x1,y,z2}),
    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))
                    project_point({x,y2,z2}) & project_point({x,y1,z2}),
                    project_point({x,y2,z1}) & project_point({x,y2,z2})})
    end for

    -- draw the minimal room outline
                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
        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]])
    end for

    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


    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)

    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*/)
    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


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

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

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

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

    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"),
    dialog = IupDialog(IupVbox({canvas,hbox}, "MARGIN=5x5, GAP=5"),"MINSIZE=455x170")
    IupSetCallback(dialog, "K_ANY", Icallback("esc_close"));

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

end procedure
-- 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)
            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)
    end for
    boidsn = boidsnp1
end procedure