tock-mirror/testcases/ats1-q7.occ

1363 lines
42 KiB
Plaintext

-- 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)
:
--}}}