-- CO516 q7: Adam Sampson <ats1>          vim:et:ts=2:foldmethod=marker
-- Dining Frogger^WPhilosophers
-- This will be a lot more readable in a folding editor (I use VIM).

#USE "course"

--{{{ Constants

--{{{ Screen size
-- The size of the screen
VAL INT screen.width IS 80:
VAL INT screen.height IS 24:
--}}}

--{{{ Locations of sprites
VAL INT table.x IS 36:
VAL INT table.y IS 14:
VAL []INT forks.x IS [2, 3, 8, 9, 5]:
VAL []INT forks.y IS [3, 1, 1, 3, 4]:
VAL []INT phils.x IS [-2, -2, 4, 12, 9]:
VAL []INT phils.y IS [4, -1, -3, 1, 5]:
VAL INT security.x IS 60:
VAL INT security.y IS 19:
--}}}

--{{{ General tweaks
-- Set this to false to reduce the gore level a bit.
VAL BOOL adult.mode IS TRUE:
-- Set this to false to make the philosophers really, really stupid (as
-- opposed to merely very stupid).
VAL BOOL avoid.cars IS TRUE:
--}}}

--{{{ Philosopher timing controls
VAL INT think.time IS 5000000:
VAL INT eat.time IS 10000000:
VAL INT sleep.time IS 10000000:
VAL INT balloon.hide.time IS 1000000:
VAL INT dead.time IS 3000000:
--}}}

--{{{ RNG seed
-- My birthday, used as an offset to seed the RNG with.
VAL INT adams.birthday IS 250981:
--}}}

--{{{ Sprite numbers
-- The number of sprites
VAL INT num.targets IS 1:
VAL INT base.targets IS 0:
VAL INT num.philosophers IS 5:
VAL INT base.philosophers IS (base.targets + num.targets):
VAL INT num.cars IS 6:
VAL INT base.cars IS (base.philosophers + num.philosophers):
VAL INT num.forks IS num.philosophers:
VAL INT base.forks IS (base.cars + num.cars):
VAL INT num.security IS 1:
VAL INT base.security IS (base.forks + num.forks):
VAL INT num.statics IS 4 + num.philosophers:
VAL INT base.statics IS (base.security + num.security):
VAL INT num.handcuffs IS num.philosophers:
VAL INT base.handcuffs IS (base.statics + num.statics):
VAL INT num.scores IS num.philosophers:
VAL INT base.scores IS (base.handcuffs + num.handcuffs):
VAL INT num.balloons IS 1 + num.philosophers:
VAL INT base.balloons IS (base.scores + num.scores):
VAL INT num.texts IS 2:
VAL INT base.texts IS (base.balloons + num.balloons):
VAL INT num.sprites IS (base.texts + num.texts):
--}}}

--{{{ Numbers for the coords channels
VAL INT coords.base.forks IS 0:
VAL INT coords.base.balloons IS (coords.base.forks + num.forks):
VAL INT num.coords IS (coords.base.balloons + num.balloons):
--}}}

--{{{ The bottom-of-screen message
VAL []BYTE bottom.message IS "Adam Sampson <ats1>*'s Dining Philosophers model, with apologies to the designers of Frogger. -=- Keys: -=- [i] turn off invulnerability for the philosophers -=- Philosopher speed: [q] insane [w] normal [e] snail*'s pace -=- [1-5] tell the security guard to allow 1-5 philosophers in -=- Car speed: [r] 90mph [t] 60mpg [y] 30mph -=- [6-9] select philosopher to control, [hjkl] move selected philosopher, [SPACE] return philosopher to autopilot -=- The numbers by the philosophers show the number of lives left and the number of meals eaten -=- philosophy courtesy of Hobbes*' Leviathan -=- greetings to everyone on UKCIRC :)":
--}}}

--{{{ Autogenerated brain tables
-- This is generated by a seperate program from some input text.
-- I've included it inline to make it easier to submit this, but I don't
-- suggest trying to read it by hand.

VAL [20]BYTE brain.words IS "!begin!endJavasucks.":
VAL [3]INT brain.links IS [2,3,1]:
VAL [4]INT brain.wordpos IS [0,6,10,14]:
VAL [4]INT brain.wordlen IS [6,4,4,6]:
VAL [4]INT brain.linkpos IS [0,1,1,2]:
VAL [4]INT brain.linklen IS [1,0,1,1]:
--}}}

--}}}

--{{{ Protocols

--{{{ Graphics

--{{{ PROTOCOL SPRITE
-- The maximum length of a sprite graphic.
VAL INT max.graphic IS 1024:

-- A sprite: graphic to draw (' ' is transparent, '*n' moves to a new line);
-- x; y; colour
PROTOCOL SPRITE IS INT::[]BYTE ; INT ; INT ; INT:
--}}}

--{{{ PROTOCOL GRAPHICS.COMMAND
-- A protocol for sending graphics fragments at the screen.buffer
PROTOCOL GRAPHICS.COMMAND
  CASE
    sprite; INT::[]BYTE ; INT ; INT ; INT
    flip
    quit
:
--}}}

--}}}

--{{{ Collision detection

--{{{ PROTOCOL COORDS
-- A protocol for reporting philosopher coordinates.
PROTOCOL COORDS IS INT ; INT:
--}}}

--{{{ PROTOCOL COLLISION.TEST
-- A protocol for specifying collision tests: x, y, radius.
PROTOCOL COLLISION.TEST IS INT ; INT ; INT:
--}}}

--}}}

--{{{ Object control and reporting

--{{{ PROTOCOL PHILOSOPHER.CONTROL
PROTOCOL PHILOSOPHER.CONTROL
  CASE
    set.lives ; INT
    set.delay ; INT
    enable.autopilot ; BOOL
    move ; INT ; INT
:
--}}}

--{{{ PROTOCOL PHILOSOPHER.STATUS
-- A protocol for reporting philosopher actions.
PROTOCOL PHILOSOPHER.STATUS
  CASE
    thinking
    queueing
    waiting
    eating
    sleeping
:
--}}}

--{{{ PROTOCOL FORK.STATUS
-- A protocol for reporting fork status.
PROTOCOL FORK.STATUS
  CASE
    picked.up.left
    picked.up.right
    put.down
:
--}}}

--{{{ PROTOCOL SECURITY.CONTROL
PROTOCOL SECURITY.CONTROL
  CASE
    set.max ; INT
:
--}}}

--{{{ PROTOCOL SECURITY.STATUS
-- A protocol for reporting security guard status.
PROTOCOL SECURITY.STATUS
  CASE
    queue.size; INT; INT
:
--}}}

--{{{ PROTOCOL DRIVER.CONTROL
PROTOCOL DRIVER.CONTROL
  CASE
    set.delay ; INT
:
--}}}

--{{{ PROTOCOL BALLOON.CONTROL
PROTOCOL BALLOON.CONTROL
  CASE
    string; [10]BYTE
    hide
:
--}}}

--{{{ PROTOCOL SCORES.REPORT
-- Number of lives; score.
PROTOCOL SCORES.REPORT IS INT ; INT:
--}}}

--{{{ PROTOCOL TARGET.CONTROL
PROTOCOL TARGET.CONTROL
  CASE
    position; INT; INT
    hide
:
--}}}

--}}}

--}}}

--{{{ ANSI terminal utilites

--{{{ ANSI colours
VAL INT col.red IS 31:
VAL INT col.green IS 32:
VAL INT col.yellow IS 33:
VAL INT col.blue IS 34:
VAL INT col.purple IS 35:
VAL INT col.cyan IS 36:
VAL INT col.white IS 37:
--}}}

--{{{ PROC set.colour
PROC set.colour (VAL INT colour, CHAN OF BYTE out)
  SEQ
    out ! ESCAPE
    out ! '['
    out.int (colour, 0, out)
    out ! 'm'
:
--}}}

--{{{ PROC hide.cursor
PROC hide.cursor (CHAN OF BYTE out)
  SEQ
    -- This is an xterm-specific escape sequence.
    -- It works in xterm and rxvt, but not in gnome-terminal or aterm,
    -- and then only when the window has focus -- but it does make it look
    -- much nicer.
    out ! ESCAPE
    out ! '['
    out ! '?'
    out ! '2'
    out ! '5'
    out ! 'l'
:
--}}}

--}}}

--{{{ General utilities

--{{{ PROC sleep
-- Sleep for a given period.
PROC sleep (VAL INT delay)
  TIMER tim:
  INT t:
  SEQ
    tim ? t
    tim ? AFTER t PLUS delay
:
--}}}

--}}}

--{{{ Text generation

--{{{ PROTOCOL LINE
VAL INT max.text IS 1024:
PROTOCOL LINE IS INT::[]BYTE:
--}}}

--{{{ PROC philosophy.generator
-- This is a Markov-chain text generator.
PROC philosophy.generator (CHAN OF LINE output)
  [max.text]BYTE buf:
  INT bufpos, seed:
  VAL INT num.words IS SIZE brain.wordpos:
  SEQ
    seed := adams.birthday
    WHILE TRUE
      INT word, next, len:
      SEQ
        bufpos := 0
        next, seed := random(brain.linklen[0], seed)
        word := brain.links[next]
        BOOL full:
        SEQ
          full := FALSE
          WHILE (NOT full) AND (word <> 1)
            SEQ
              len := brain.wordlen[word]
              full := ((bufpos + len) + 1) >= (SIZE buf)
              IF
                NOT full
                  SEQ
                    copy.string ([brain.words FROM brain.wordpos[word] FOR len], [buf FROM bufpos FOR len])
                    bufpos := bufpos + len
                    buf[bufpos] := ' '
                    bufpos := bufpos + 1
                    next, seed := random(brain.linklen[word], seed)
                    word := brain.links[brain.linkpos[word] + next]
                TRUE
                  SKIP
        make.string (buf, bufpos)
        output ! bufpos::buf
:
--}}}

--{{{ PROC scroll.text
-- Scroll text to the screen while it's supplied; pause while it isn't.
VAL INT scroll.buf.size IS 4 * max.text:
PROC scroll.text (VAL INT delay, VAL INT width, CHAN OF LINE in, CHAN OF LINE out)
  [scroll.buf.size]BYTE buf:
  INT used:
  [max.text]BYTE disp:
  [max.text]BYTE line:
  INT len:
  TIMER tim:
  INT t:
  SEQ
    len := -1
    SEQ i = 0 FOR width
      buf[i] := '*#00'
    make.string (buf, width)
    used := width
    make.string (disp, 0)
    tim ? t
    WHILE TRUE
      PRI ALT
        (len < 0) & in ? len::line
          SKIP
        tim ? AFTER t PLUS delay
          INT w:
          SEQ
            IF
              (len >= 0) AND (((SIZE buf) - used) >= len)
                SEQ
                  make.string (line, len)
                  copy.string ([line FROM 0 FOR len], [buf FROM used FOR len])
                  used := used + len
                  len := -1
              TRUE
                SKIP
            IF
              used <= 0
                SEQ
                  make.string (buf, width)
                  used := width
              TRUE
                SKIP
            IF
              used < width
                w := used
              TRUE
                w := width
            copy.string ([buf FROM 0 FOR w], [disp FROM 0 FOR w])
            make.string (disp, w)
            out ! width::disp
            SEQ i = 0 FOR used - 1
              buf[i] := buf[i + 1]
            used := used - 1
            tim ? t
:   
--}}}

--{{{ PROC repeat.text
-- Used to scroll the same message over and over again.
PROC repeat.text (VAL []BYTE text, CHAN OF LINE out)
  WHILE TRUE
    out ! (SIZE text)::text
:
--}}}

--}}}

--{{{ The (instrumented) secure college

--{{{  PROC philosopher
PROC philosopher (CHAN OF BOOL left, right, down, up, CHAN OF PHILOSOPHER.STATUS philosophish, CHAN OF BOOL ack, VAL INT init.seed)
  INT seed, rand:
  BOOL b:
  SEQ
    seed := init.seed
    WHILE TRUE
      SEQ
        philosophish ! thinking
        ack ? b
        rand, seed := random(think.time, seed)
        sleep (rand)
        philosophish ! queueing
        ack ? b
        down ! TRUE
        philosophish ! waiting
        ack ? b
        PAR
          left ! TRUE
          right ! TRUE
        philosophish ! eating
        ack ? b
        rand, seed := random(eat.time, seed)
        sleep (rand)
        PAR
          left ! TRUE
          right ! TRUE
        up ! TRUE
        -- It's a hard life being a philosopher.
        philosophish ! sleeping
        ack ? b
        rand, seed := random(sleep.time, seed)
        sleep (rand)
:
--}}}

--{{{  PROC fork
PROC fork (CHAN OF BOOL left, right, CHAN OF FORK.STATUS forkish)
  WHILE TRUE
    ALT
      BOOL any:
      left ? any     -- philosopher left picks up fork
        SEQ
          forkish ! picked.up.left
          left ? any   -- philosopher left puts down fork
          forkish ! put.down
      BOOL any:
      right ? any    -- philosopher right picks up fork
        SEQ
          forkish ! picked.up.right
          right ? any  -- philosopher right puts down fork
          forkish ! put.down
:
--}}}

--{{{  PROC security
PROC security ([]CHAN OF BOOL down, up, CHAN OF SECURITY.CONTROL control, CHAN OF SECURITY.STATUS securitish)
  INT max:
  INT n.sat.down:
  SEQ
    max := 4
    n.sat.down := 0
    WHILE TRUE
      SEQ
        securitish ! queue.size ; n.sat.down ; max
        PRI ALT
          control ? CASE
            set.max ; max
              SKIP
          ALT i = 0 FOR 5
            ALT
              --{{{  philosopher wanting to sit down
              BOOL any:
              (n.sat.down < max) & down[i] ? any  -- don't allow max at a time
                n.sat.down := n.sat.down + 1
              --}}}
              --{{{  philosopher wanting to stand up
              BOOL any:
              up[i] ? any                         -- always allow this
                n.sat.down := n.sat.down - 1
              --}}}
:
--}}}

--{{{  PROC secure.college
PROC secure.college ([num.philosophers]CHAN OF PHILOSOPHER.STATUS philosophish, [num.philosophers]CHAN OF BOOL philosophish.ack, [num.forks]CHAN OF FORK.STATUS forkish, CHAN OF SECURITY.STATUS securitish, CHAN OF SECURITY.CONTROL security.control)
  [5]CHAN OF BOOL left, right, up, down:
  PAR
    security (down, up, security.control, securitish)
    PAR i = 0 FOR num.philosophers
      PAR
        philosopher (left[i], right[i], down[i], up[i], philosophish[i], philosophish.ack[i], i + adams.birthday)
        fork (left[i], right[(i+1)\5], forkish[i])
:
--}}}

--}}}

--{{{ Car control

--{{{ PROC mindless.driver
-- A driver that moves the car at a variable speed. A future enhancement would
-- be to make the driving protocol include the Y coordinate as well, so that we
-- could make cars swerve and overtake...
PROC mindless.driver (VAL INT initial.delay, VAL INT width, CHAN OF DRIVER.CONTROL control, CHAN OF INT out)
  TIMER tim:
  INT t, delay:
  SEQ
    delay := initial.delay
    WHILE TRUE
      SEQ i = 0 FOR width
        SEQ
          out ! i
          tim ? t
          PRI ALT
            control ? CASE
              set.delay ; delay
                SKIP
            tim ? AFTER t PLUS delay
              SKIP
:
--}}}

--}}}

--{{{ Animation

--{{{ PROC three.digits
-- Format a three-digit number into a buffer.
PROC three.digits (VAL INT n, [3]BYTE buf)
  IF
    n < 0
      [buf FOR 3] := "   "
    TRUE
      SEQ
        buf[0] := '0' + (BYTE ((n / 100) \ 10))
        buf[1] := '0' + (BYTE ((n / 10) \ 10))
        buf[2] := '0' + (BYTE (n \ 10))
:
--}}}

--{{{ PROC animate.scores
PROC animate.scores (VAL INT x, y, CHAN OF SCORES.REPORT in, CHAN OF SPRITE out)
  [7]BYTE msg:
  INT lives, score:
  SEQ
    copy.string ("   *n   ", msg)
    WHILE TRUE
      SEQ
        out ! (SIZE msg)::msg ; x ; y ; col.white
        in ? lives ; score
        three.digits (lives, [msg FROM 0 FOR 3])
        three.digits (score, [msg FROM 4 FOR 3])
:
--}}}

--{{{ PROC animate.static
PROC animate.static (VAL INT x, y, col, VAL []BYTE item, CHAN OF SPRITE out)
  out ! (SIZE item)::item ; x ; y ; col
:
--}}}

--{{{ PROC animate.car 
PROC animate.car (VAL INT x, y, CHAN OF INT in, CHAN OF COORDS coords, CHAN OF SPRITE out)
  INT pos:
  SEQ
    pos := 0
    WHILE TRUE
      SEQ
        coords ! x + pos ; y
        out ! 14::"/###\_*n`O--O-*'" ; x + pos ; y ; col.white
        in ? pos
:
--}}}

--{{{ PROC animate.security
PROC animate.security (VAL INT x, y, CHAN OF SECURITY.STATUS in, CHAN OF BALLOON.CONTROL balloon, CHAN OF SPRITE out)
  [11]BYTE sid:
  [10]BYTE msg:
  SEQ
    copy.string (" Q *n-U-*n/ \", sid)
    copy.string ("n/n diners", msg)
    WHILE TRUE
      SEQ
        out ! (SIZE sid)::sid ; x ; y ; col.green
        in ? CASE
          INT queue, max:
          queue.size ; queue ; max
            SEQ
              msg[0] := '0' + (BYTE queue)
              msg[2] := '0' + (BYTE max)
              balloon ! string ; msg
:
--}}}

--{{{ PROC animate.philosopher
PROC animate.philosopher (VAL INT num, home.x, home.y, table.x, table.y, CHAN OF PHILOSOPHER.STATUS in, CHAN OF BOOL ack, CHAN OF COORDS coords.report, CHAN OF COLLISION.TEST collision.request, CHAN OF BOOL collision.reply, CHAN OF BALLOON.CONTROL balloon, CHAN OF SCORES.REPORT scores, CHAN OF PHILOSOPHER.CONTROL control, CHAN OF TARGET.CONTROL targeting, CHAN OF BOOL cuffs, CHAN OF SPRITE out)
  INT x, y, dest.x, dest.y, lives, score, move.delay:
  [11]BYTE phil:
  [10]BYTE msg:
  BOOL moving, legs, alive, autopilot:
  SEQ
    move.delay := 100000
    alive := TRUE
    -- Philosophers are invunerable to start with.
    lives := -1
    score := 0
    moving := FALSE
    legs := FALSE
    autopilot := TRUE
    copy.string (" o *n-#-*n/ \", phil)
    -- Slightly tricky, since it needs to match the keys used to select
    -- the philosophers.
    IF
      num < 4
        phil[5] := '6' + (BYTE num)
      TRUE
        phil[5] := '0'
    x, y := home.x, home.y
    dest.x, dest.y := x, y
    WHILE alive
      BOOL collide:
      SEQ
        coords.report ! x ; y
        collision.request ! x ; y ; 0
        collision.reply ? collide
        IF
          collide
            -- Run over the philosopher.
            VAL []BYTE splat IS "-=#%%#.*n==%#%#%*n-=#%##*'":
            SEQ
              copy.string ("Ouch!", msg)
              balloon ! string ; msg
              IF
                adult.mode
                  SEQ
                    out ! (SIZE splat)::splat ; x ; y ; col.red
                    sleep (dead.time)
                TRUE
                  SKIP
              IF
                lives = 1
                  SEQ
                    -- Out of lives -- game over, dude, game over...
                    lives := 0
                    alive := FALSE
                lives > 0
                  lives := lives - 1
                TRUE
                  -- Lives count is negative, so infinite lives mode.
                  SKIP
          TRUE
            SKIP
        scores ! lives ; score
        IF
          alive
            INT col:
            SEQ
              IF
                autopilot
                  col := col.red
                TRUE
                  col := col.white
              out ! (SIZE phil)::phil ; x ; y ; col
              IF
                (((dest.x = x) AND (dest.y = y)) AND moving)
                  SEQ
                    ack ! TRUE
                    moving := FALSE
                    [phil FROM 8 FOR 3] := "/ \"
                TRUE
                  TIMER tim:
                  INT t:
                  SEQ
                    tim ? t
                    PRI ALT
                      -- Get control signals.
                      control ? CASE
                        set.lives ; lives
                          SKIP
                        set.delay ; move.delay
                          SKIP
                        enable.autopilot ; autopilot
                          IF
                            autopilot
                              targeting ! hide
                            TRUE
                              SKIP
                        INT dx, dy:
                        move ; dx ; dy
                          SEQ
                            x, y := x + dx, y + dy
                            IF
                              x < 0
                                x := 0
                              x >= (screen.width - 3)
                                x := (screen.width - 3)
                              y < 0
                                y := 0
                              y >= (screen.height - 3)
                                y := (screen.height - 3)
                              TRUE
                                SKIP
                      -- Get a status update from the model.
                      in ? CASE
                        thinking
                          SEQ
                            copy.string ("Hmmm...", msg)
                            balloon ! string ; msg
                            phil[1] := '/'
                            ack ! TRUE
                        queueing
                          SEQ
                            copy.string ("I*'m hungry", msg)
                            balloon ! string ; msg
                            phil[1] := '!'
                            cuffs ! TRUE
                            ack ! TRUE
                        waiting
                          SEQ
                            copy.string ("Need forks", msg)
                            balloon ! string ; msg
                            phil[1] := '**'
                            dest.x, dest.y := table.x, table.y
                            cuffs ! FALSE
                            moving := TRUE
                        eating
                          SEQ
                            copy.string ("Delicious!", msg)
                            balloon ! string ; msg
                            phil[1] := 'O'
                            score := score + 1
                            ack ! TRUE
                        sleeping
                          SEQ
                            copy.string ("I*'m tired.", msg)
                            balloon ! string ; msg
                            phil[1] := 'z'
                            dest.x, dest.y := home.x, home.y
                            moving := TRUE
                      -- Get a timeout.
                      tim ? AFTER t PLUS move.delay
                        IF
                          moving
                            -- Work out which way to move and do it.
                            INT dx, dy:
                            SEQ
                              IF
                                dest.x > x
                                  dx := 1
                                dest.x < x
                                  dx := -1
                                TRUE
                                  dx := 0
                              IF
                                dest.y > y
                                  dy := 1
                                dest.y < y
                                  dy := -1
                                TRUE
                                  dy := 0
                              -- This is a hack to make the philosophers head home in
                              -- a more sensibly froggy way.
                              IF  
                                (dy < 0) AND (NOT (dx = 0))
                                  dy := 0
                                TRUE
                                  SKIP
                              -- Attempt to avoid collisions. Not that this works
                              -- very well, since the tactic is essentially to
                              -- stand still if you're about to be hit by a car.
                              collision.request ! x + dx ; y + dy ; 3
                              collision.reply ? collide
                              IF
                                (avoid.cars AND collide)
                                  SEQ
                                    copy.string ("Mind out..", msg)
                                    balloon ! string ; msg
                                autopilot
                                  x, y := x + dx, y + dy
                                TRUE
                                  -- Not on autopilot, so don't move.
                                  SKIP
                              -- Animate the philosopher's legs.
                              IF
                                legs
                                  [phil FROM 8 FOR 3] := " |\"
                                TRUE
                                  [phil FROM 8 FOR 3] := "/| "
                              legs := NOT legs
                          TRUE
                            -- Not moving -- animate the philosopher's head.
                            IF
                              -- Sleeping.
                              phil[1] = 'z'
                                phil[1] := 'Z'
                              phil[1] = 'Z' 
                                phil[1] := 'z'
                              -- Thinking (head spinning)
                              phil[1] = '/'
                                phil[1] := '-'
                              phil[1] = '-'
                                phil[1] := '\'
                              phil[1] = '\'
                                phil[1] := '|'
                              phil[1] = '|'
                                phil[1] := '/'
                              -- Eating (head throbbing)
                              phil[1] = '.'
                                phil[1] := 'o'
                              phil[1] = 'o'
                                phil[1] := 'O'
                              phil[1] = 'O'
                                phil[1] := '0'
                              phil[1] = '0'
                                phil[1] := '.'
                              -- Waiting (head "shaking")
                              phil[1] = '<'
                                phil[1] := '!'
                              phil[1] = '!'
                                phil[1] := '>'
                              phil[1] = '>'
                                phil[1] := 'i'
                              phil[1] = 'i'
                                phil[1] := '<'
                              TRUE
                                SKIP
                    IF
                      autopilot
                        SKIP
                      TRUE
                        targeting ! position ; dest.x ; dest.y
          TRUE
            SKIP
:
--}}}

--{{{ PROC animate.fork
PROC animate.fork (VAL INT num, table.x, table.y, CHAN OF FORK.STATUS in, CHAN OF INT coords.request, CHAN OF COORDS coords.reply, CHAN OF SPRITE out)
  INT x, y:
  SEQ
    x, y := table.x, table.y
    WHILE TRUE
      SEQ
        out ! 1::"Y" ; x ; y ; col.yellow
        in ? CASE
          picked.up.left
            SEQ
              coords.request ! num
              coords.reply ? x ; y
              y := y + 1
          picked.up.right
            SEQ
              coords.request ! ((num + 1) \ num.philosophers)
              coords.reply ? x ; y
              x := x + 2
              y := y + 1
          put.down
            x, y := table.x, table.y
:
--}}}

--{{{ PROC animate.text
PROC animate.text (VAL INT x, y, col, CHAN OF LINE in, CHAN OF SPRITE out)
  [max.text]BYTE buf:
  INT len:
  SEQ
    len := 0
    make.string (buf, 0)
    WHILE TRUE
      SEQ
        out ! len::buf ; x ; y ; col
        in ? len::buf
:
--}}}

--{{{ PROC animate.balloon
PROC animate.balloon (VAL INT person, CHAN OF BALLOON.CONTROL in, CHAN OF INT coords.request, CHAN OF COORDS coords.reply, CHAN OF SPRITE out)
  INT x, y:
  BOOL shown:
  [38]BYTE loon:
  TIMER tim:
  INT t:
  SEQ
    shown := FALSE
    copy.string (",----------.*n|          |*n/----------*'", loon)
    WHILE TRUE
      SEQ
        coords.request ! person
        coords.reply ? x ; y
        x := x + 2
        y := y - 3
        -- This is necessary so that we can still see the "thinking" balloon.
        IF
          y < 0
            y := 0
          TRUE
            SKIP
        IF
          shown
            out ! (SIZE loon)::loon ; x ; y ; col.cyan
          TRUE
            out ! 0::"" ; x ; y ; col.cyan
        tim ? t
        PRI ALT
          in ? CASE
            string ; [loon FROM 14 FOR 10]
              SEQ
                shown := TRUE
                -- Replace any spaces with nulls, so the sign isn't transparent
                SEQ i = 14 FOR 10
                  IF
                    loon[i] = ' '
                      loon[i] := '*#00'
                    TRUE
                      SKIP
            hide
              shown := FALSE
          tim ? AFTER t PLUS balloon.hide.time
            -- Pop down the balloon after a while.
            shown := FALSE
:
--}}}

--{{{ PROC animate.target
PROC animate.target (CHAN OF TARGET.CONTROL in, CHAN OF SPRITE out)
  INT x, y:
  VAL []BYTE target IS ",-.*n| |*n`-*'":
  SEQ
    x, y := -10, -10
    WHILE TRUE
      SEQ
        out ! (SIZE target)::target ; x ; y ; col.blue
        in ? CASE
          position ; x ; y
            SKIP
          hide
            x, y := -10, -10
:
--}}}

--{{{ PROC animate.handcuffs
PROC animate.handcuffs (VAL INT x, y, CHAN OF BOOL in, CHAN OF SPRITE out)
  BOOL shown:
  VAL []BYTE cuffs IS "-o o-":
  SEQ
    shown := FALSE
    WHILE TRUE
      SEQ
        IF
          shown
            out ! (SIZE cuffs)::cuffs ; x ; y ; col.green
          TRUE
            out ! 0::"" ; x ; y ; col.green
        in ? shown
:
--}}}

--}}}

--{{{ Target control multiplexer

--{{{ PROC target.plex
-- All of the philosophers generate targeting information; this combines them
-- into one.
PROC target.plex ([num.philosophers]CHAN OF TARGET.CONTROL in, CHAN OF TARGET.CONTROL out)
  WHILE TRUE
    ALT i = 0 FOR num.philosophers
      in[i] ? CASE
        INT x, y:
        position ; x ; y
          out ! position ; x ; y
        hide
          out ! hide
:
--}}}

--}}}

--{{{ Collision detection

--{{{ PROC position.tracker
-- This process keeps track of the positions of all the philosophers (and the
-- security guard), so that other sprites can find out where they need to draw
-- themselves.
PROC position.tracker ([num.philosophers]CHAN OF COORDS incoming.reports, [num.coords]CHAN OF INT coords.requests, [num.coords]CHAN OF COORDS coords.replies)
  [num.philosophers + 1]INT xs, ys:
  SEQ
    xs[num.philosophers], ys[num.philosophers] := security.x, security.y
    SEQ i = 0 FOR num.philosophers
      xs[i], ys[i] := 0, 0
    WHILE TRUE
      PRI ALT
        ALT i = 0 FOR num.coords
          INT phil:
          coords.requests[i] ? phil
            coords.replies[i] ! xs[phil] ; ys[phil]
        ALT i = 0 FOR num.philosophers
          incoming.reports[i] ? xs[i] ; ys[i]
            SKIP
:
--}}}

--{{{ PROC collision.detector
-- Process to detect when philosophers get run over by cars.
PROC collision.detector ([num.cars]CHAN OF COORDS in, [num.philosophers]CHAN OF COLLISION.TEST requests, [num.philosophers]CHAN OF BOOL replies)
  [num.cars]INT x, y:
  SEQ
    SEQ i = 0 FOR num.cars
      x[i], y[i] := 0, 0
    WHILE TRUE
      PRI ALT
        ALT i = 0 FOR num.philosophers
          INT px, py, r:
          requests[i] ? px ; py ; r
            BOOL rep:
            SEQ
              rep := FALSE
              SEQ j = 0 FOR num.cars
                VAL INT cx IS x[j] + 6:
                VAL INT cy IS y[j] + 1:
                IF
                  (((cx + r) >= px) AND ((cx - r) <= (px + 2))) AND (((cy + r) >= py) AND ((cy - r) <= (py + 3)))
                    rep := TRUE
                  TRUE
                    SKIP
              replies[i] ! rep
        ALT i = 0 FOR num.cars
          in[i] ? x[i] ; y[i]
            SKIP
:
--}}}

--}}}

--{{{ Double-buffered screen output code

--{{{ PROC sprite.mem.cell
-- This holds the information for a particular sprite -- the animator writes
-- into it, and the screen stuff reads from it.
PROC sprite.mem.cell (CHAN OF SPRITE in, CHAN OF SPRITE out, CHAN OF BOOL req)
  [max.graphic]BYTE lump:
  INT lump.len, x, y, col:
  SEQ
    lump.len := 0
    make.string (lump, 0)
    x, y := 0, 0
    col := 0
    WHILE TRUE
      PRI ALT
        BOOL b:
        req ? b
          out ! lump.len::lump ; x ; y ; col
        in ? lump.len::lump ; x ; y ; col
          SKIP
:
--}}}

--{{{ PROC graphics.plex
-- This is slightly misnamed, since it's not a conventional occamy multiplexer;
-- it makes requests to each of the mem cells in turn.
PROC graphics.plex ([num.sprites]CHAN OF SPRITE in, [num.sprites]CHAN OF BOOL in.req, CHAN OF GRAPHICS.COMMAND out, CHAN OF BOOL req)
  [num.sprites][max.graphic]BYTE lump:
  [num.sprites]INT lump.len, x, y, col:
  WHILE TRUE
    SEQ
      BOOL b:
      req ? b
      PAR i = 0 FOR num.sprites
        SEQ
          in.req[i] ! TRUE
          in[i] ? lump.len[i]::lump[i] ; x[i] ; y[i] ; col[i]
      SEQ i = 0 FOR num.sprites
        out ! sprite ; lump.len[i]::lump[i] ; x[i] ; y[i] ; col[i]
      out ! flip
:
--}}}

--{{{ PROC update.requester
-- Send periodic update requests to the plexer.
PROC update.requester (VAL INT delay, CHAN OF BOOL out)
  WHILE TRUE
    SEQ
      out ! TRUE
      sleep (delay)
:
--}}}

--{{{ PROC clear.buffer
PROC clear.buffer ([screen.height][screen.width]BYTE screen, [screen.height][screen.width]INT colour)
  SEQ y = 0 FOR screen.height
    SEQ x = 0 FOR screen.width
      SEQ
        screen[y][x] := ' '
        colour[y][x] := 0
:
--}}}

--{{{ PROC screen.buffer
-- Optimised double-buffered screen renderer. This is the only bit of code that
-- knows how to talk to the terminal.
PROC screen.buffer (CHAN OF GRAPHICS.COMMAND in, CHAN OF BYTE out)
  [2][screen.height][screen.width]BYTE screen:
  [2][screen.height][screen.width]INT colour:
  INT current, prev.x, prev.y, prev.col:
  SEQ
    hide.cursor (out)
    erase.screen (out)
    current := 0
    prev.x, prev.y := -1, -1
    prev.col := -1
    clear.buffer (screen[0], colour[0])
    clear.buffer (screen[1], colour[1])
    WHILE TRUE
      in ? CASE
        [max.graphic]BYTE lump:
        INT lumpsize, x, y, col, origx:
        sprite ; lumpsize::lump ; x ; y ; col
          SEQ
            origx := x
            SEQ i = 0 FOR lumpsize
              IF 
                lump[i] = '*n'
                  SEQ
                    x := origx
                    y := y + 1
                lump[i] = ' '
                  -- Spaces are "transparent"
                  x := x + 1
                TRUE
                  SEQ
                    -- Nulls are non-transparent spaces.
                    IF
                      lump[i] = '*#00'
                        lump[i] := ' '
                      TRUE
                        SKIP
                    IF
                      (((x >= 0) AND (x < screen.width)) AND ((y >= 0) AND (y < screen.height)))
                        SEQ
                          screen[current][y][x] := lump[i]
                          colour[current][y][x] := col
                      TRUE
                        SKIP
                    x := x + 1
        flip
          SEQ
            SEQ y = 0 FOR screen.height
              SEQ x = 0 FOR screen.width
                IF
                  NOT ((screen[current][y][x] = screen[1 - current][y][x]) AND (colour[current][y][x] = colour[1 - current][y][x]))
                    INT col IS colour[current][y][x]:
                    SEQ
                      -- Only bother with colour changes and cursor moves
                      -- if they're really necessary. (Minimises the number
                      -- of control sequences sent -- since I tested this over
                      -- a laggy ssh connection, this is well worth the effort.)
                      IF
                        col = prev.col
                          SKIP
                        TRUE
                          set.colour (col, out)
                      IF
                        (x = (prev.x + 1)) AND (y = prev.y)
                          SKIP
                        TRUE
                          cursor.x.y (BYTE (x + 1), BYTE (y + 1), out)
                      out ! screen[current][y][x]
                      prev.x, prev.y, prev.col := x, y, col
                  TRUE
                    SKIP
            current := 1 - current
            clear.buffer (screen[current], colour[current])
            out ! FLUSH
:
--}}}

--{{{ PROC sprite.renderer
-- Wrapper process around all the above.
PROC sprite.renderer (VAL INT delay, [num.sprites]CHAN OF SPRITE sprites, CHAN OF BYTE out)
  [num.sprites]CHAN OF SPRITE memory.sprites:
  [num.sprites]CHAN OF BOOL sprite.reqs:
  CHAN OF BOOL graphics.tick:
  CHAN OF GRAPHICS.COMMAND graphics.feed:
  PAR
    PAR i = 0 FOR num.sprites
      sprite.mem.cell (sprites[i], memory.sprites[i], sprite.reqs[i])
    update.requester (delay, graphics.tick)
    graphics.plex (memory.sprites, sprite.reqs, graphics.feed, graphics.tick)
    screen.buffer (graphics.feed, out)
:
--}}}

--}}}

--{{{ Keyboard control

--{{{ PROC keyboard.controller
PROC keyboard.controller (CHAN OF BYTE in, [num.philosophers]CHAN OF PHILOSOPHER.CONTROL philosopher.controls, [num.cars]CHAN OF DRIVER.CONTROL driver.controls, CHAN OF SECURITY.CONTROL security.control)
  BYTE b:
  INT under.control:
  SEQ
    under.control := -1
    WHILE TRUE
      SEQ
        in ? b
        IF
          -- i: give all the philosophers 5 lives.
          b = 'i'
            SEQ i = 0 FOR num.philosophers
              philosopher.controls[i] ! set.lives ; 5
          -- s: speed up all the philosophers a lot.
          b = 'q'
            SEQ i = 0 FOR num.philosophers
              philosopher.controls[i] ! set.delay ; 10000
          -- m: set normal speed for the philosophers.
          b = 'w'
            SEQ i = 0 FOR num.philosophers
              philosopher.controls[i] ! set.delay ; 100000
          -- w: slow down the philosophers a lot.
          b = 'e'
            SEQ i = 0 FOR num.philosophers
              philosopher.controls[i] ! set.delay ; 500000
          -- 0-5: set security max
          (b >= '1') AND (b <= '5')
            security.control ! set.max ; (INT (b - '0'))
          -- f: fast cars
          b = 'r'
            SEQ i = 0 FOR num.cars
              driver.controls[i] ! set.delay ; 10000
          -- g: medium cars
          b = 't'
            SEQ i = 0 FOR num.cars
              driver.controls[i] ! set.delay ; 100000
          -- h: slow cars
          b = 'y'
            SEQ i = 0 FOR num.cars
              driver.controls[i] ! set.delay ; 1000000
          -- abcde: set philosopher to control
          ((b >= '6') AND (b <= '9')) OR (b = '0')
            SEQ
              IF
                under.control >= 0
                  philosopher.controls[under.control] ! enable.autopilot ; TRUE
                TRUE
                  SKIP
              IF
                b = '0'
                  under.control := 4
                TRUE
                  under.control := (INT (b - '6'))
              philosopher.controls[under.control] ! enable.autopilot ; FALSE
          -- space: stop controlling philosopher
          b = ' '
            IF
              under.control >= 0
                SEQ
                  philosopher.controls[under.control] ! enable.autopilot ; TRUE
                  under.control := -1
              TRUE
                SKIP
          -- hjkl: move philosophers
          under.control >= 0
            INT dx, dy:
            SEQ
              IF
                b = 'h'
                  dx, dy := -1, 0
                b = 'j'
                  dx, dy := 0, 1
                b = 'k'
                  dx, dy := 0, -1
                b = 'l'
                  dx, dy := 1, 0
                TRUE
                  SKIP
              philosopher.controls[under.control] ! move ; dx ; dy
          TRUE
            SKIP
:
--}}}

--}}}

--{{{  PROC q7
PROC q7 (CHAN OF BYTE keyboard, screen, error)
  [num.cars]CHAN OF INT drivings:
  [num.cars]CHAN OF COORDS car.coords:
  [num.philosophers]CHAN OF COLLISION.TEST car.requests:
  [num.philosophers]CHAN OF BOOL car.replies:
  [num.sprites]CHAN OF SPRITE sprites:
  [num.philosophers]CHAN OF COORDS position.reports:
  [num.coords]CHAN OF INT position.requests:
  [num.coords]CHAN OF COORDS position.replies:
  [num.philosophers]CHAN OF PHILOSOPHER.STATUS philosophish:
  [num.philosophers]CHAN OF PHILOSOPHER.CONTROL philosopher.controls:
  [num.cars]CHAN OF DRIVER.CONTROL driver.controls:
  CHAN OF SECURITY.CONTROL security.control:
  [num.philosophers]CHAN OF BOOL philosophish.ack:
  [num.forks]CHAN OF FORK.STATUS forkish:
  [num.philosophers]CHAN OF SCORES.REPORT scores:
  CHAN OF SECURITY.STATUS securitish:
  CHAN OF BALLOON.CONTROL security.balloon:
  CHAN OF LINE bottom.scrolled, bottom.text, random.philosophy, scrolled.philosophy:
  [num.philosophers]CHAN OF BALLOON.CONTROL philosopher.balloons:
  [num.philosophers]CHAN OF TARGET.CONTROL targeting:
  [num.philosophers]CHAN OF BOOL cuffage:
  CHAN OF TARGET.CONTROL all.targeting:
  PAR
    -- I don't use error, but this stops KRoC warning me about it.
    error ! FLUSH

    -- The original college itself.
    secure.college (philosophish, philosophish.ack, forkish, securitish, security.control)

    -- Process collecting input from the keyboard.
    keyboard.controller (keyboard, philosopher.controls, driver.controls, security.control)

    -- The collision detection system.
    position.tracker (position.reports, position.requests, position.replies)
    collision.detector (car.coords, car.requests, car.replies)

    -- The cars.
    PAR i = 0 FOR num.cars
      PAR
        mindless.driver (10000 * (i + 2), 90, driver.controls[i], drivings[i])
        animate.car (-5, 4 + (2 * (i \ 3)), drivings[i], car.coords[i], sprites[base.cars + i])

    -- The philosophers.
    PAR i = 0 FOR num.philosophers
      PAR
        animate.philosopher (i, 6 + (16 * i), 1, table.x + phils.x[i], table.y + phils.y[i], philosophish[i], philosophish.ack[i], position.reports[i], car.requests[i], car.replies[i], philosopher.balloons[i], scores[i], philosopher.controls[i], targeting[i], cuffage[i], sprites[base.philosophers + i])
        animate.handcuffs (5 + (16 * i), 2, cuffage[i], sprites[base.handcuffs + i])

    -- The forks.
    PAR i = 0 FOR num.forks
      animate.fork (i, table.x + forks.x[i], table.y + forks.y[i], forkish[i], position.requests[coords.base.forks + i], position.replies[coords.base.forks + i], sprites[base.forks + i])

    -- The security guard.
    animate.security (security.x, security.y, securitish, security.balloon, sprites[base.security])

    -- The furniture.
    animate.static (table.x, table.y, col.blue, "  /~~~~~~\*n /        \*n/          \*n\          /*n \        /*n  \______/", sprites[base.statics])
    animate.static (0, 0, col.green, "    ,-----.         ,-----.         ,-----.         ,-----.         ,-----.*n    |     |         |     |         |     |         |     |         |     |*n    |     |         |     |         |     |         |     |         |     |*n----*'     `---------*'     `---------*'     `---------*'     `---------*'     `----", sprites[base.statics + 1])

    -- The thought balloons.
    animate.balloon (num.philosophers, security.balloon, position.requests[coords.base.balloons + num.philosophers], position.replies[coords.base.balloons + num.philosophers], sprites[base.balloons + num.philosophers])
    PAR i = 0 FOR num.philosophers
      animate.balloon (i, philosopher.balloons[i], position.requests[coords.base.balloons + i], position.replies[coords.base.balloons + i], sprites[base.balloons + i])

    -- The philosophers' scores.
    PAR i = 0 FOR num.scores
      PAR
        animate.scores (12 + (16 * i), 1, scores[i], sprites[base.scores + i])
        animate.static (11 + (16 * i), 1, col.green, "L*nS", sprites[base.statics + (4 + i)])

    -- The credits/instructions text.
    repeat.text (bottom.message, bottom.text)
    scroll.text (100000, 80, bottom.text, bottom.scrolled)
    animate.text (0, 23, col.white, bottom.scrolled, sprites[base.texts])

    -- The random philosophy text.
    animate.static (0, 22, col.yellow, "{", sprites[base.statics + 2])
    animate.static (79, 22, col.yellow, "}", sprites[base.statics + 3])
    philosophy.generator (random.philosophy)
    scroll.text (50000, 78, random.philosophy, scrolled.philosophy)
    animate.text (1, 22, col.yellow, scrolled.philosophy, sprites[base.texts + 1])

    -- The navigation target (the blue thing that appears when you're
    -- controlling a philosopher).
    target.plex (targeting, all.targeting)
    animate.target (all.targeting, sprites[base.targets])

    -- The process that renders all the sprites.
    sprite.renderer (90000, sprites, screen)
:
--}}}