--** Boids implementation in occam-pi.

#INCLUDE "course.module"
#INCLUDE "miniraster.module"
#INCLUDE "maths.module"
#INCLUDE "rastergraphics.module"
#INCLUDE "rasterio.module"

--{{{  defines
-- If this is turned on, occoids will dump an image of each frame in
-- uncompressed PPM format into the "frames" directory (which you'll need to
-- make first); you can then use mencoder to turn these into a video.
--#DEFINE DUMP.VIDEO
--}}}

--{{{  constants
VAL INT DIRECTIONS IS 8:
VAL INT WIDTH.SPACES IS 5:
VAL INT HEIGHT.SPACES IS 5:
VAL INT NUM.SPACES IS WIDTH.SPACES * HEIGHT.SPACES:
VAL INT PIXEL.SCALE IS 600 / HEIGHT.SPACES:
VAL REAL32 MAX.INIT.VELOCITY IS 0.1:
VAL REAL32 MIN.CYLINDER.RADIUS IS 0.1:
VAL REAL32 MAX.CYLINDER.RADIUS IS 0.3:
VAL INT INITIAL.BOIDS IS 150:
VAL INT INITIAL.CYLINDERS IS NUM.SPACES:
VAL INT MAX.LOCAL.OBJECTS IS INITIAL.BOIDS + INITIAL.CYLINDERS:
VAL REAL32 MEAN.VELOCITY.FRACTION IS 8.0:
VAL REAL32 CENTRE.OF.MASS.FRACTION IS 30.0:
VAL REAL32 REPULSION.DISTANCE IS 0.05:
VAL REAL32 REPULSION.FRACTION IS 4.0:
VAL REAL32 SOFT.THRESHOLD IS 0.05:
VAL REAL32 OBSTACLE.FRACTION IS 8.0:
VAL REAL32 BIAS.SIZE IS 0.0001:
VAL REAL32 SPEED.LIMIT IS 0.03:
VAL INT BIAS.CHANGE.COUNT IS 500:
--* How far you can see -- this can't be greater than 1.0.
VAL REAL32 VISION.RADIUS IS 0.25:
VAL INT BOID.CYCLE.TIME IS 20000:
VAL INT SCREEN.UPDATE.TIME IS 1000000 / 20:
VAL REAL32 SMOOTH.ACCELERATION IS 5.0:

--{{{  priorities
VAL INT CAPSULE.PRI IS 5:
VAL INT VIEWER.PRI IS 10:
VAL INT NORMAL.PRI IS 20:
--}}}
--}}}

--{{{  data types and protocols
--{{{  vectors
DATA TYPE VECTOR
  RECORD
    REAL32 x, y:
:

VECTOR INLINE FUNCTION "+" (VAL VECTOR a, b) IS [a[x] + b[x], a[y] + b[y]]:
VECTOR INLINE FUNCTION "-" (VAL VECTOR a, b) IS [a[x] - b[x], a[y] - b[y]]:
VECTOR INLINE FUNCTION "**" (VAL VECTOR a, VAL REAL32 b) IS [a[x] * b, a[y] * b]:
VECTOR INLINE FUNCTION "/" (VAL VECTOR a, VAL REAL32 b) IS [a[x] / b, a[y] / b]:

--* Compute the square of the magnitude of the vector.
REAL32 INLINE FUNCTION magnitude2 (VAL VECTOR v) IS (v[x] * v[x]) + (v[y] * v[y]):

PROC out.vector (VAL VECTOR v, CHAN BYTE out!)
  SEQ
    out ! '('
    out.real32 (v[x], 0, 0, out!)
    out ! ','
    out.real32 (v[y], 0, 0, out!)
    out ! ')'
:
--}}}
--{{{  boid info
--*{{{ BT boid types
VAL INT BT.BOID IS 1:
VAL INT BT.CYLINDER IS 2:
--*}}}

DATA TYPE BOID.INFO
  RECORD
    INT type:
    VECTOR position, velocity:
    REAL32 radius:
    INT colour:
:
--}}}
--{{{  viewers
CHAN TYPE VIEWER.CT
  MOBILE RECORD
    CHAN MOBILE []BOID.INFO seen!:
:
--}}}
--{{{  boids
PROTOCOL BOID.REQ
  CASE
    view
    moved; VECTOR
:

PROTOCOL BOID.RESP
  CASE
    viewer; VIEWER.CT!
:

CHAN TYPE BOID.CT
  MOBILE RECORD
    CHAN BOID.REQ req?:
    CHAN BOID.RESP resp!:
:
--}}}
--{{{  space cells
PROTOCOL CELL.REQ
  CASE
    --* Boid moving to a new cell.
    -- @item boid The boid that's moving.
    -- @item info The boid's new information, with a position and velocity in
    --   the destination cell.
    boid.in; BOID.CT?; BOID.INFO
    look
:

PROTOCOL CELL.RESP
  CASE
    seen; MOBILE []BOID.INFO
:

CHAN TYPE CELL.CT
  MOBILE RECORD
    CHAN CELL.REQ req?:
    CHAN CELL.RESP resp!:
:
--}}}
--}}}

--{{{  colour utilities
--{{{  INT FUNCTION hsv.to.rgb
--* Convert HSV to RGB (all values as floats between 0 and 1).
-- Algorithm from http://www.cs.rit.edu/~ncs/color/t_convert.html
INT FUNCTION hsv.to.rgb (VAL REAL32 h, s, v)
  REAL32 r, g, b:
  VALOF
    IF
      s = 0.0
        r, g, b := v, v, v
      TRUE
        INT i:
        REAL32 hh, f, p, q, t:
        SEQ
          hh := h * 6.0
          i := INT TRUNC hh
          f := hh - (REAL32 ROUND i)
          p := v * (1.0 - s)
          q := v * (1.0 - (s * f))
          t := v * (1.0 - (s * (1.0 - f)))
          CASE i
            0
              r, g, b := v, t, p
            1
              r, g, b := q, v, p
            2
              r, g, b := p, v, t
            3
              r, g, b := p, q, v
            4
              r, g, b := t, p, v
            ELSE
              r, g, b := v, p, q
    RESULT (((INT ROUND (r * 255.0)) << 16) \/ ((INT ROUND (g * 255.0)) << 8)) \/ (INT ROUND (b * 255.0))
:
--}}}
--}}}

PROC occoids (SHARED CHAN BYTE err!)
  --{{{  stuff to do with directions on the grid
  --{{{  FUNCTION dir.value
  INT FUNCTION dir.value (VAL REAL32 r)
    INT d:
    VALOF
      IF
        r < 0.0
          d := -1
        r >= 1.0
          d := 1
        TRUE
          d := 0
      RESULT d
  :
  --}}}
  VAL [][2]INT directions IS [[-1, -1], [0, -1], [1, -1],
                              [-1, 0],           [1, 0],
                              [-1, 1],  [0, 1],  [1, 1]]:
  --}}}

  --{{{  FUNCTION random.real32
  REAL32, INT FUNCTION random.real32 (VAL REAL32 range, VAL INT seed)
    REAL32 result:
    INT value, newseed:
    VALOF
      SEQ
        value, newseed := random (MOSTPOS INT, seed)
        result := (range * (REAL32 ROUND value)) / (REAL32 ROUND (MOSTPOS INT))
      RESULT result, newseed
  :
  --}}}

  --{{{  PROC random.vector
  PROC random.vector (VAL REAL32 mag, INT seed, RESULT VECTOR vector)
    SEQ
      vector[x], seed := random.real32 (mag, seed)
      vector[y], seed := random.real32 (mag, seed)
  :
  --}}}

  --{{{  PROC capsule
  --* Forkable process that delivers a boid to a destination cell.
  PROC capsule (BOID.CT? boid, VAL BOID.INFO info, SHARED CELL.CT! dest)
    CLAIM dest!
      dest[req] ! boid.in; boid; info
  :
  --}}}

  --{{{  PROC viewer
  PROC viewer (VAL VECTOR position, MOBILE []BOID.INFO my.info, MOBILE []SHARED CELL.CT! cells, VIEWER.CT? svr)
    PROTOCOL REP IS MOBILE []BOID.INFO; INT:
    SHARED! CHAN REP c:
    PAR
      CLAIM c!
        c ! my.info; (-1)
      --{{{  ask neighbours for info
      PAR dir = 0 FOR SIZE cells
        MOBILE []BOID.INFO info:
        SEQ
          CLAIM cells[dir]
            SEQ
              cells[dir][req] ! look
              cells[dir][resp] ? CASE seen; info
          CLAIM c!
            c ! info; dir
      --}}}
      --{{{  collect responses into an array
      INITIAL MOBILE []BOID.INFO infos IS MOBILE [0]BOID.INFO:
      SEQ
        SEQ i = 0 FOR (SIZE cells) + 1
          MOBILE []BOID.INFO info, new.infos:
          INT dir:
          SEQ
            c ? info; dir
            IF
              dir >= 0
                --{{{  adjust the positions based on the relative position of the cell they came from
                SEQ i = 0 FOR SIZE info
                  -- FIXME argggghhh
                  VAL [][2]INT directions IS [[-1, -1], [0, -1], [1, -1],
                                              [-1, 0],           [1, 0],
                                              [-1, 1],  [0, 1],  [1, 1]]:
                  SEQ
                    -- FIXME use vectors here (and below)
                    info[i][position][x] := info[i][position][x] + (REAL32 ROUND directions[dir][0])
                    info[i][position][y] := info[i][position][y] + (REAL32 ROUND directions[dir][1])
                --}}}
              TRUE
                SKIP
            new.infos := MOBILE [(SIZE infos) + (SIZE info)]BOID.INFO
            [new.infos FOR (SIZE infos)] := [infos FOR (SIZE infos)]
            [new.infos FROM (SIZE infos)] := [info FOR (SIZE info)]
            infos := new.infos
        SEQ i = 0 FOR SIZE infos
          infos[i][position] := infos[i][position] - position
        svr[seen] ! infos
      --}}}
  :
  --}}}

  --{{{  PROC space
  PROC space (CELL.CT? svr, MOBILE []SHARED CELL.CT! clis,
              CHAN RASTER graphics.in?, graphics.out!, VAL INT pos.x, pos.y)
    INITIAL MOBILE []BOID.CT? boids IS MOBILE [MAX.LOCAL.OBJECTS]BOID.CT?:
    INITIAL MOBILE []BOID.INFO info IS MOBILE [MAX.LOCAL.OBJECTS]BOID.INFO:
    INITIAL INT num.boids IS 0:

    PROC report (CHAN BYTE out!)
      SEQ
        out.string ("Cell(", 0, out!)
        out.int (pos.x, 0, out!)
        out ! ','
        out.int (pos.y, 0, out!)
        out.string ("): ", 0, out!)
    :

    --{{{  PROC handle.boid.movement
    PROC handle.boid.movement (VAL INT i)
      INITIAL BOID.INFO this.info IS info[i]:
      INT dx, dy:
      SEQ
        dx := dir.value (this.info[position][x])
        dy := dir.value (this.info[position][y])
        IF
          (dx <> 0) OR (dy <> 0)
            --{{{  boid moves to a new cell
            IF dir = 0 FOR DIRECTIONS
              (directions[dir][0] = dx) AND (directions[dir][1] = dy)
                SEQ
                  --{{{  message
                  #IF FALSE
                  CLAIM err!
                    SEQ
                      report (err!)
                      out.string ("boid ", 0, err!)
                      out.int (i, 0, err!)
                      out.string (" moving to new cell*n", 0, err!)
                  #ENDIF
                  --}}}
                  --{{{  compute position in destination cell
                  this.info[position][x] := this.info[position][x] - (REAL32 ROUND directions[dir][0])
                  this.info[position][y] := this.info[position][y] - (REAL32 ROUND directions[dir][1])
                  --}}}
                  SETPRI (CAPSULE.PRI)
                  FORK capsule (boids[i], this.info, clis[dir])
                  SETPRI (NORMAL.PRI)
                  --{{{  remove the boid from the array
                  IF
                    i = (num.boids - 1)
                      SKIP
                    TRUE
                      --{{{  move the last boid down to this position
                      SEQ
                        boids[i] := boids[num.boids - 1]
                        info[i] := info[num.boids - 1]
                      --}}}
                  num.boids := num.boids - 1
                  --}}}
            --}}}
          TRUE
            SKIP
    :
    --}}}

    WHILE TRUE
      ALT
        svr[req] ? CASE
          --{{{  new incoming boid
          boid.in; boids[num.boids]; info[num.boids]
            INITIAL INT n IS num.boids:
            SEQ
              #IF FALSE
              CLAIM err!
                SEQ
                  report (err!)
                  out.string ("new boid ", 0, err!)
                  out.int (n, 0, err!)
                  out.string (" received*n", 0, err!)
              #ENDIF
              num.boids := num.boids + 1
              handle.boid.movement (n)
          --}}}
          --{{{  who's there?
          look
            INITIAL MOBILE []BOID.INFO my.info IS MOBILE [num.boids]BOID.INFO:
            SEQ
              [my.info FOR num.boids] := [info FOR num.boids]
              svr[resp] ! seen; my.info
          --}}}

        ALT i = 0 FOR num.boids
          boids[i][req] ? CASE
            --{{{  who's there?
            view
              VIEWER.CT! cli:
              VIEWER.CT? svr:
              INITIAL MOBILE []BOID.INFO my.info IS MOBILE [num.boids - 1]BOID.INFO:
              INITIAL MOBILE []SHARED CELL.CT! my.links IS MOBILE [DIRECTIONS]SHARED CELL.CT!:
              SEQ
                cli, svr := MOBILE VIEWER.CT
                [my.info FOR i] := [info FOR i]
                -- FIXME: something odd about these slices:
                [my.info FROM i FOR ((num.boids - i) - 1)] := [info FROM i + 1 FOR ((num.boids - i) - 1)]
                -- FIXME: using a CLONE here doesn't work?
                SEQ i = 0 FOR DIRECTIONS
                  my.links[i] := clis[i]
                SETPRI (VIEWER.PRI)
                FORK viewer (info[i][position], my.info, my.links, svr)
                SETPRI (NORMAL.PRI)
                boids[i][resp] ! viewer; cli
            --}}}
            --{{{  boid reporting movement
            moved; info[i][velocity]
              SEQ
                info[i][position] := info[i][position] + info[i][velocity]
                handle.boid.movement (i)
            --}}}

        --{{{  graphics update
        RASTER r:
        graphics.in ? r
          VAL INT by IS pos.y * PIXEL.SCALE:
          VAL INT bx IS pos.x * PIXEL.SCALE:
          SEQ
            SEQ i = 0 FOR num.boids
              VAL REAL32 PSR IS REAL32 ROUND PIXEL.SCALE:
              VAL INT y IS by + (INT TRUNC (PSR * info[i][position][y])):
              VAL INT x IS bx + (INT TRUNC (PSR * info[i][position][x])):
              VAL INT dy IS INT TRUNC (PSR * info[i][velocity][y]):
              VAL INT dx IS INT TRUNC (PSR * info[i][velocity][x]):
              CASE info[i][type]
                BT.BOID
                  SEQ
                    fill.circle (x, y, 2, info[i][colour], r)
                    INITIAL INT xx IS x:
                    INITIAL INT yy IS y:
                    draw.line (xx, yy, (-4) * dx, (-4) * dy, #123456, #808080, r)
                BT.CYLINDER
                  draw.circle (x, y, INT TRUNC (PSR * info[i][radius]), info[i][colour], r)
            graphics.out ! r
        --}}}
  :
  --}}}

  --{{{  FUNCTION wrap
  INT FUNCTION wrap (VAL INT i, max)
    INT n:
    VALOF
      SEQ
        n := i
        WHILE n < 0
          n := n + max
      RESULT n \ max
  :
  --}}}

  --{{{  PROC boid 
  PROC boid (VAL INT id, BOID.CT! cli, VAL VECTOR init.velocity, MOBILE BARRIER bar, SHARED CHAN BYTE err!)
    PROC report (CHAN BYTE out!)
      SEQ
        out.string ("Boid(", 0, out!)
        out.int (id, 0, out!)
        out.string ("): ", 0, out!)
    :

    --{{{  PROC brain
    PROC brain (CHAN MOBILE []BOID.INFO out!, CHAN VECTOR in?)
      WHILE TRUE
        VIEWER.CT! viewer:
        MOBILE []BOID.INFO infos:
        VECTOR velocity:
        SEQ
          cli[req] ! view
          cli[resp] ? CASE viewer; viewer
          viewer[seen] ? infos
          out ! infos

          in ? velocity
          cli[req] ! moved; velocity

          SYNC bar
    :
    --}}}
    --{{{  PROC filter.local
    PROC filter.local (CHAN MOBILE []BOID.INFO in?, out!)
      MOBILE []BOID.INFO info.in, info.out:
      WHILE TRUE
        --{{{  FUNCTION can.see
        BOOL FUNCTION can.see (VAL BOID.INFO info)
          BOOL b:
          VALOF
            VAL VECTOR pos IS info[position]:
            IF
              magnitude2 (pos) < (VISION.RADIUS * VISION.RADIUS)
                b := TRUE
              TRUE
                b := FALSE
            RESULT b
        :
        --}}}

        INITIAL INT n IS 0:
        SEQ
          in ? info.in

          SEQ i = 0 FOR SIZE info.in
            IF
              can.see (info.in[i])
                n := n + 1
              TRUE
                SKIP
          #IF FALSE
          CLAIM err!
            SEQ
              report (err!)
              out.string ("filtered ", 0, err!)
              out.int (SIZE info.in, 0, err!)
              out.string (" down to ", 0, err!)
              out.int (n, 0, err!)
              out.string ("*n", 0, err!)
          #ENDIF
          info.out := MOBILE [n]BOID.INFO
          n := 0
          SEQ i = 0 FOR SIZE info.in
            IF
              can.see (info.in[i])
                SEQ
                  info.out[n] := info.in[i]
                  n := n + 1
              TRUE
                SKIP

          out ! info.out
    :
    --}}}
    --{{{  PROC filter.type
    PROC filter.type (VAL INT type, CHAN MOBILE []BOID.INFO in?, out!)
      MOBILE []BOID.INFO info.in, info.out:
      WHILE TRUE
        INITIAL INT n IS 0:
        SEQ
          in ? info.in

          SEQ i = 0 FOR SIZE info.in
            IF
              info.in[i][type] = type
                n := n + 1
              TRUE
                SKIP
          info.out := MOBILE [n]BOID.INFO
          n := 0
          SEQ i = 0 FOR SIZE info.in
            IF
              info.in[i][type] = type
                SEQ
                  info.out[n] := info.in[i]
                  n := n + 1
              TRUE
                SKIP

          out ! info.out
    :
    --}}}
    --{{{  PROC delta
    PROC delta (CHAN MOBILE []BOID.INFO in?, []CHAN MOBILE []BOID.INFO outs!)
      MOBILE []BOID.INFO infos:
      WHILE TRUE
        SEQ
          in ? infos
          PAR i = 0 FOR SIZE outs
            outs[i] ! CLONE infos
    :
    --}}}
    --{{{  PROC centre.of.mass.rule
    PROC centre.of.mass.rule (CHAN MOBILE []BOID.INFO in?, CHAN VECTOR out!)
      MOBILE []BOID.INFO infos:
      WHILE TRUE
        INITIAL VECTOR com IS [0.0, 0.0]:
        SEQ
          in ? infos

          --{{{  find centre of mass of boids we can see
          IF
            (SIZE infos) > 0
              SEQ
                SEQ i = 0 FOR SIZE infos 
                  com := com + infos[i][position]
                com := com / (REAL32 ROUND (SIZE infos))
            TRUE
              SKIP
          --}}}

          out ! com / CENTRE.OF.MASS.FRACTION
    :
    --}}}
    --{{{  PROC repulsion.rule
    PROC repulsion.rule (CHAN MOBILE []BOID.INFO in?, CHAN VECTOR out!)
      MOBILE []BOID.INFO infos:
      WHILE TRUE
        INITIAL VECTOR push IS [0.0, 0.0]:
        SEQ
          in ? infos

          SEQ i = 0 FOR SIZE infos
            VAL VECTOR pos IS infos[i][position]:
            IF
              magnitude2 (pos) < (REPULSION.DISTANCE * REPULSION.DISTANCE)
                --{{{  this one's close; move away from it
                push := push - pos
                --}}}
              TRUE
                SKIP

          out ! push / REPULSION.FRACTION
    :
    --}}}
    --{{{  PROC mean.velocity.rule
    PROC mean.velocity.rule (CHAN MOBILE []BOID.INFO in?, CHAN VECTOR my.vel.in?, CHAN VECTOR out!)
      MOBILE []BOID.INFO infos:
      INITIAL VECTOR my.velocity IS init.velocity:
      WHILE TRUE
        INITIAL VECTOR perceived.velocity IS [0.0, 0.0]:
        SEQ
          in ? infos
          #IF FALSE
          CLAIM err!
            SEQ
              report (err!)
              out.string ("I can see: ", 0, err!)
              SEQ i = 0 FOR SIZE infos
                SEQ
                  out.string ("v:", 0, err!)
                  out.vector (infos[i][velocity], err!)
                  out.string (",p:", 0, err!)
                  out.vector (infos[i][position], err!)
                  err ! ' '
              out.string ("*n", 0, err!)
          #ENDIF

          IF
            (SIZE infos) > 0
              SEQ
                SEQ i = 0 FOR SIZE infos
                  perceived.velocity := perceived.velocity + infos[i][velocity]
                perceived.velocity := perceived.velocity / (REAL32 ROUND (SIZE infos))
            TRUE
              SKIP
          perceived.velocity := perceived.velocity - my.velocity
          #IF FALSE
          CLAIM err!
            SEQ
              report (err!)
              out.string ("perceived velocity is ", 0, err!)
              out.vector (perceived.velocity, err!)
              out.string ("*n", 0, err!)
          #ENDIF
          out ! perceived.velocity / MEAN.VELOCITY.FRACTION

          -- This rule's special because it needs to know our velocity --
          -- which'll get reported once the entire network has gone through one
          -- cycle.
          my.vel.in ? my.velocity
    :
    --}}}
    --{{{  PROC migration.rule
    PROC migration.rule (CHAN MOBILE []BOID.INFO in?, CHAN VECTOR out!)
      INITIAL INT cycle IS 0:
      INT seed:
      INITIAL REAL32 bias.angle IS 0.0:
      MOBILE []BOID.INFO infos:
      SEQ
        TIMER tim:
        tim ? seed
        seed := (seed >> 2) + 1

        WHILE TRUE
          SEQ
            in ? infos
            -- and ignore it

            --{{{  change bias angle periodically
            IF
              cycle = BIAS.CHANGE.COUNT
                SEQ
                  bias.angle := bias.angle + 0.5
                  cycle := 0
              TRUE
                cycle := cycle + 1
            --}}}

            out ! [BIAS.SIZE * SIN (bias.angle), BIAS.SIZE * COS (bias.angle)]
    :
    --}}}
    --{{{  PROC obstacle.rule
    PROC obstacle.rule (CHAN MOBILE []BOID.INFO in?, CHAN VECTOR out!)
      MOBILE []BOID.INFO infos:
      WHILE TRUE
        INITIAL VECTOR push IS [0.0, 0.0]:
        SEQ
          in ? infos

          SEQ i = 0 FOR SIZE infos
            --{{{  compute how hard to push away from this object
            VAL VECTOR pos IS infos[i][position]:
            VAL REAL32 dist IS SQRT (magnitude2 (pos)) - infos[i][radius]:
            IF
              dist < 0.0
                --{{{  past the soft threshold; push back hard
                push := push - pos
                --}}}
              dist < SOFT.THRESHOLD
                --{{{  inside the soft threshold; push back a variable amount
                push := push - (pos * (1.0 (REAL32) - (dist / SOFT.THRESHOLD)))
                --}}}
              TRUE
                --{{{  nowhere near
                SKIP
                --}}}
            --}}}

          out ! push / OBSTACLE.FRACTION
    :
    --}}}
    --{{{  PROC sum
    PROC sum ([]CHAN VECTOR ins?, CHAN VECTOR out!)
      WHILE TRUE
        INITIAL MOBILE []VECTOR vs IS MOBILE [SIZE ins]VECTOR:
        INITIAL VECTOR sum IS [0.0, 0.0]:
        SEQ
          PAR i = 0 FOR SIZE ins
            ins[i] ? vs[i]
          SEQ i = 0 FOR SIZE ins
            sum := sum + vs[i]
          out ! sum
    :
    --}}}
    --{{{  PROC wings
    PROC wings (CHAN VECTOR in?, []CHAN VECTOR outs!)
      INITIAL VECTOR velocity IS init.velocity:
      VAL REAL32 SPEED.LIMIT2 IS SPEED.LIMIT * SPEED.LIMIT:
      WHILE TRUE
        VECTOR acceleration:
        REAL32 mag:
        SEQ
          in ? acceleration

          velocity := velocity + (acceleration / SMOOTH.ACCELERATION)
          #IF FALSE
          CLAIM err!
            SEQ
              report (err!)
              out.string ("my velocity is ", 0, err!)
              out.vector (velocity, err!)
              out.string ("*n", 0, err!)
          #ENDIF

          --{{{  apply speed limit
          mag := magnitude2 (velocity)
          IF
            mag > SPEED.LIMIT2
              velocity := velocity / (mag / SPEED.LIMIT2)
            TRUE
              SKIP
          --}}}

          PAR i = 0 FOR SIZE outs
            outs[i] ! velocity
    :
    --}}}

    CHAN MOBILE []BOID.INFO eo, fi, obi, ooi, obo, ooo, mvi, ri, cmi, mi:
    CHAN VECTOR ei, vfb, mvo, ro, cmo, mo, oro, acc:
    PAR
      brain (eo!, ei?)
      delta (eo?, [fi!, ooi!])

      filter.local (fi?, obi!)
      filter.type (BT.BOID, obi?, obo!)
      delta (obo?, [cmi!, ri!, mvi!, mi!])
      centre.of.mass.rule (cmi?, cmo!)
      repulsion.rule (ri?, ro!)
      mean.velocity.rule (mvi?, vfb?, mvo!)
      migration.rule (mi?, mo!)

      filter.type (BT.CYLINDER, ooi?, ooo!)
      obstacle.rule (ooo?, oro!)

      sum ([cmo?, ro?, mvo?, mo?, oro?], acc!)
      wings (acc?, [ei!, vfb!])
  :
  --}}}

  --{{{  PROC spawn.object
  PROC spawn.object (VAL INT id, type, INT seed, SHARED CELL.CT! dest, MOBILE BARRIER bar)
    BOID.CT? svr:
    BOID.CT! cli:
    BOID.INFO info:
    SEQ
      cli, svr := MOBILE BOID.CT
      info[type] := type
      CASE type
        BT.BOID
          --{{{  spawn a boid
          SEQ
            random.vector (1.0, seed, info[position])
            random.vector (MAX.INIT.VELOCITY * 2.0, seed, info[velocity])
            info[velocity] := info[velocity] - [MAX.INIT.VELOCITY, MAX.INIT.VELOCITY] (VECTOR)
            info[radius] := 0.0
            info[colour] := hsv.to.rgb ((REAL32 ROUND id) / (REAL32 ROUND INITIAL.BOIDS), 0.6, 1.0)
            FORK boid (id, cli, info[velocity], bar, err!)
          --}}}
        BT.CYLINDER
          --{{{  spawn an obstacle
          SEQ
            random.vector (1.0, seed, info[position])
            info[velocity] := [0.0, 0.0]
            info[radius], seed := random.real32 (MAX.CYLINDER.RADIUS - MIN.CYLINDER.RADIUS, seed)
            info[radius] := info[radius] + MIN.CYLINDER.RADIUS
            info[colour] := #FFFFFF
          --}}}
      CLAIM dest
        dest[req] ! boid.in; svr; info
  :
  --}}}

  --{{{  PROC display
  PROC display (CHAN RASTER in?, out!)
    --{{{  PROC clear
    PROC clear (CHAN RASTER in?, out!)
      WHILE TRUE
        RASTER r:
        SEQ
          in ? r
          clear.raster (r, #002000)
          SEQ x = 1 FOR WIDTH.SPACES - 1
            draw.vertical.line (x * PIXEL.SCALE, 0, SIZE r, #447744, r)
          SEQ y = 1 FOR HEIGHT.SPACES - 1
            draw.horizontal.line (0, y * PIXEL.SCALE, SIZE r[0], #447744, r)
          out ! r
    :
    --}}}
    --{{{  PROC speed.limit
    PROC speed.limit (CHAN RASTER in?, out!)
      TIMER tim:
      INT t:
      SEQ
        tim ? t
        WHILE TRUE
          RASTER r:
          SEQ
            tim ? AFTER t
            t := t PLUS SCREEN.UPDATE.TIME
            in ? r
            out ! r
    :
    --}}}
    
    CHAN RASTER thru, cleared:
    PAR
      miniraster.simple ("Occoids",
                         (WIDTH.SPACES * PIXEL.SCALE),
                         (HEIGHT.SPACES * PIXEL.SCALE),
                         4, in?, thru!)
      clear (thru?, cleared!)
      speed.limit (cleared?, out!)
  :
  --}}}

  --{{{  PROC cycle.limiter
  --* Limit the maximum speed of the simulation.
  -- This makes sure that the barrier cycles no more often than [@ref
  -- BOID.CYCLE.TIME].
  PROC cycle.limiter (MOBILE BARRIER bar)
    WHILE TRUE
      TIMER tim:
      INT t:
      SEQ
        tim ? t
        tim ? AFTER t PLUS BOID.CYCLE.TIME

        SYNC bar
  :
  --}}}

  --{{{  main program
  [NUM.SPACES + 1]CHAN RASTER gs:
  CHAN RASTER disp.in, disp.out:

  INITIAL MOBILE []SHARED CELL.CT! clis IS MOBILE [NUM.SPACES]SHARED CELL.CT!:
  INITIAL MOBILE []CELL.CT? svrs IS MOBILE [NUM.SPACES]CELL.CT?:

  SEQ
    SETPRI (NORMAL.PRI)

    --{{{  allocate all the channel bundles
    SEQ i = 0 FOR NUM.SPACES
      clis[i], svrs[i] := MOBILE CELL.CT
    --}}}

    CLAIM err!
      out.string ("occoids starting*n", 0, err!)

    PAR
      --{{{  the grid of space cells
      PAR x = 0 FOR WIDTH.SPACES
        PAR y = 0 FOR HEIGHT.SPACES
          VAL INT cell.num IS x + (y * WIDTH.SPACES):

          CHAN RASTER gin? IS gs[cell.num]:
          CHAN RASTER gout! IS gs[cell.num + 1]:

          INITIAL MOBILE []SHARED CELL.CT! these.clis IS MOBILE [DIRECTIONS]SHARED CELL.CT!:
          SEQ
            SEQ i = 0 FOR DIRECTIONS
              VAL INT that.x IS wrap (x + directions[i][0], WIDTH.SPACES):
              VAL INT that.y IS wrap (y + directions[i][1], HEIGHT.SPACES):
              VAL INT that.num IS that.x + (that.y * WIDTH.SPACES):
              these.clis[i] := clis[that.num]
            space (svrs[cell.num], these.clis, gin?, gout!, x, y)
      --}}}

      display (disp.in?, disp.out!)

      FORKING
        TIMER tim:
        INT seed:
        INITIAL MOBILE BARRIER bar IS MOBILE BARRIER:
        SEQ
          tim ? seed
          seed := (seed >> 2) + 1

          FORK cycle.limiter (bar)

          --{{{  spawn cylinders
          SEQ i = 0 FOR INITIAL.CYLINDERS
            INT cell:
            SEQ
              cell, seed := random (NUM.SPACES, seed)
              spawn.object ((-1) - i, BT.CYLINDER, seed, clis[cell], bar)
          --}}}
          --{{{  spawn boids
          INITIAL INT id IS 0:
          SEQ i = 0 FOR INITIAL.BOIDS
            INT cell:
            SEQ
              cell, seed := random (NUM.SPACES, seed)
              spawn.object (id, BT.BOID, seed, clis[cell], bar)
              id := id + 1
          --}}}

          #IF DEFINED (DUMP.VIDEO)
          --{{{  dump video
          -- The wiring here is a bit tricky. We have to intercept frames
          -- before they go to the display in order to write them to disk, but
          -- we can't rate-limit them at that point because that would block
          -- the space processes.
          --
          -- Instead, we do rate-limiting before the frames are fed to the
          -- space processes, and capture the frames separately afterwards.
          PAR
            --{{{  lock display speed to boid update rate
            WHILE TRUE
              RASTER r:
              SEQ
                disp.out ? r
                gs[0] ! r
                SYNC bar
            --}}}
            write.rasters ("frames/frame", ".ppm", gs[NUM.SPACES]?, disp.in!)
          --}}}
          #ELSE
          --{{{  just copy frames through
          RESIGN bar
            PAR
              WHILE TRUE
                RASTER r:
                SEQ
                  disp.out ? r
                  gs[0] ! r
              WHILE TRUE
                RASTER r:
                SEQ
                  gs[NUM.SPACES] ? r
                  disp.in ! r
          --}}}
          #ENDIF
  --}}}
: