-- -- bb.occ -- a better bar -- Copyright (C) 2002 Fred Barnes -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -- #INCLUDE "consts.inc" #INCLUDE "semaphore.inc" --{{{ top-level PROC bb (CHAN BYTE kyb?, scr!, err!) --{{{ stuff from course library -- Copyright (C) David Morse, Peter Welch and David Wood INT, INT FUNCTION random (VAL INT upto, seed) --{{{ miscellaneous constants VAL INT magic IS 16807: VAL INT period IS 2147483647: VAL INT quotient IS period / magic: VAL INT remainder IS period \ magic: --}}} INT int.result, new.seed: VALOF --{{{ INT lo, hi, test: SEQ hi := seed / quotient lo := seed \ quotient test := (magic TIMES lo) MINUS (remainder TIMES hi) IF test > 0 new.seed := test TRUE new.seed := test PLUS period int.result := new.seed \ upto --}}} RESULT int.result, new.seed : PROC out.repeat (VAL BYTE ch, VAL INT n, CHAN OF BYTE out) --{{{ COMMENT documentation --This outputs `ch' down the channel `out' `n' times. --If `n' is negative, nothing happens. --}}} --{{{ IF n > 0 SEQ i = 0 FOR n out ! ch TRUE SKIP --}}} : PROC out.byte (VAL BYTE b, VAL INT field, CHAN OF BYTE out) --{{{ COMMENT documentation --This outputs `b' in a fieldwidth `field' down `out'. If the --fieldwidth is too wide for `b', it right-justifies `b' with --spaces on the left. If the field is not wide enough, it prints --the `b' anyway. These rules for fieldwidth are the same as --those used by the Pascal `write' procedure. --}}} --{{{ VAL BYTE hundreds IS b/100: VAL BYTE rest IS b\100: VAL BYTE tens IS rest/10: VAL BYTE ones IS rest\10: IF hundreds > 0 SEQ out.repeat (' ', field - 3, out) out ! hundreds + '0' out ! tens + '0' out ! ones + '0' tens > 0 SEQ out.repeat (' ', field - 2, out) out ! tens + '0' out ! ones + '0' TRUE SEQ out.repeat (' ', field - 1, out) out ! ones + '0' --}}} : PROC out.string (VAL []BYTE str, VAL INT align, CHAN BYTE out!) SEQ i = 0 FOR SIZE str out ! str[i] : PROC out.int (VAL INT n, VAL INT field, CHAN OF BYTE out) --{{{ COMMENT documentation --This outputs `n' in a fieldwidth `field' down `out'. The rules --for fieldwidth are as above. --}}} --{{{ IF n = (MOSTNEG INT) --{{{ minint out.string ("-2147483648", field, out) --}}} n = 0 --{{{ zero SEQ IF 1 < field out.repeat (' ', field - 1, out) TRUE SKIP out ! '0' --}}} TRUE --{{{ anything else VAL INT max.digits IS 20: [max.digits]INT D: INT x, i: SEQ --{{{ check negative IF n < 0 x := -n TRUE -- (n > 0) x := n --}}} --{{{ decompose SEQ i := 0 WHILE x > 0 SEQ D[i] := x\10 x := x/10 i := i + 1 --}}} --{{{ pad IF n > 0 out.repeat (' ', field - i, out) TRUE SEQ out.repeat (' ', (field - 1) - i, out) out ! '-' --}}} --{{{ output #PRAGMA DEFINED D WHILE i > 0 SEQ i := i - 1 out ! BYTE (D[i] + (INT '0')) --}}} --}}} --}}} : PROC cursor.x.y (VAL BYTE x, y, CHAN OF BYTE out) --{{{ COMMENT documentation --This outputs a VT220 control sequence down channel `out' to place --the cursor at screen coordinates (x, y). --}}} --{{{ SEQ out ! ESCAPE out ! '[' out.byte (y, 0, out) out ! ';' out.byte (x, 0, out) out ! 'H' --}}} : PROC cursor.invisible (CHAN OF BYTE out) --{{{ COMMENT documentation --This outputs a VT220 control sequence to make the cursor invisible. --}}} --{{{ SEQ out ! ESCAPE out ! '[' out ! '?' out ! '2' out ! '5' out ! 'l' --}}} : PROC cursor.visible (CHAN OF BYTE out) --{{{ COMMENT documentation --This outputs a VT220 control sequence to make the cursor visible. --}}} --{{{ SEQ out ! ESCAPE out ! '[' out ! '?' out ! '2' out ! '5' out ! 'h' --}}} : --}}} --{{{ constant tables VAL [][]BYTE screen IS --"0 1 2 3 4 5 6 7 ", --"123456789012345678901234567890123456789012345678901234567890123456789012345678" [" [BARSTAT] || |ooo| | | |ooo| | ", -- 01 " ---- || ---- M---<##>---M :( @@ ", -- 2 " || :( ,----. | ", -- 3 " ==== @@ ==== | | @@ ", -- 4 " @@ :( :(| |:( | ",-- 5 "cc || ,----. | | | de-tox", -- 6 "cc || | | `----*' | ", -- 7 "cc || :(| |:( :( @@ ", -- 8 "cc || | | | ", -- 9 "cc :( || `----*' @@ ",-- 10 "cc || :( | ", -- 1 "cc || `-------", -- 2 "cc || :( ", -- 3 "cc || ,----. o--------o--------o ", -- 4 "cc :( || | | | o | ", -- 5 "cc || :(| |:( :(| c o o | ", -- 6 "cc || | | | o | ", -- 7 "cc || `----*' o--------o--------o ", -- 8 "cc || :( ", -- 9 " @@ ", -- 20 "-@----@-+----@@-[INFORMATION LINE INFORMATION LINE INF]-[1P START]-[2P START]-", -- 1 " |()()|| ", -- 2 " cellar |()()|| ", -- 3 " |()()|| "]:-- 4 --"123456789012345678901234567890123456789012345678901234567890123456789012345678" VAL []BYTE screen.points IS [1,1,78,24]: VAL [][4]BYTE bad.regions IS [[14,1,15,24],[28,1,39,2],[22,1,45,1],[57,3,62,7],[41,6,46,10], [50,14,68,18],[30,14,35,18],[1,21,9,24],[3,1,11,1], [10,21,13,24],[16,21,78,24],[1,6,2,20],[72,1,78,12],[71,1,71,2], [71,4,71,8],[71,10,71,12],[4,2,7,2],[4,4,7,4], [16,2,21,2],[18,4,21,4]]: VAL [][2]BYTE sprites IS [":)",":|",":(",":}","8)","8]",":D",":O","|)","8D"," "]: VAL [][2]BYTE phil.origin IS [[59,2],[63,5],[55,5],[59,8],[43,5],[47,8],[43,11],[39,8], [32,13],[32,19],[36,16],[28,16],[33,3],[48,16]]: VAL [][4]BYTE table.points IS [[30,14,35,18],[41,6,46,10],[57,3,62,7]]: VAL [2][]BYTE game.if.points IS [[57,21,66,21], [68,21,77,21]]: VAL [2][]BYTE game.entry.points IS [[41,2,45,3], [22,2,26,3]]: VAL [2][]BYTE teleport.points IS [[4,2,7,4],[18,2,21,4]]: VAL INT jukebox.phil IS 12: VAL INT pool.phil IS 13: VAL []BYTE infoline.points IS [16,21,78,21]: VAL []BYTE infotext.points IS [18,21,54,21]: VAL [][2]BYTE att.origin IS [[5,10],[5,15]]: VAL []BYTE jukebox.points IS [28,1,39,2]: VAL []BYTE jukebox.credit.points IS [33,2]: VAL [][2]BYTE jukebox.speaker.points IS [[23,1],[42,1]]: VAL []BYTE pool.points IS [50,14,68,18]: VAL []BYTE bar.points IS [14,1,15,24]: VAL []BYTE bar.supports.y IS [4,5,20,21]: VAL []BYTE barstat.points IS [4,1,10,1]: VAL []BYTE cellar.points IS [1,21,9,24]: VAL []BYTE cellar.door.points IS [3,21]: VAL []BYTE depot.points IS [10,21,13,24]: VAL []BYTE beer.truck.points IS [16,22,78,24]: VAL []BYTE detox.points IS [71,1,78,12]: VAL []BYTE detox.in.door IS [70,3]: VAL []BYTE detox.out.door IS [70,9]: VAL BYTE phil.queue.y IS 6: -- where the philosophers start to queue VAL INT pints.per.barrel IS 20: --}}} --{{{ constants VAL INT MAX.SPRITES IS 16: VAL INT NUM.PHILS IS 14: VAL INT NUM.ATTENDANTS IS 2: VAL INT NUM.TAB.PHILS IS 12: VAL INT NUM.TABLES IS 3: VAL INT MAX.BULLETS IS 30: VAL [NUM.PHILS]INT TABLE.MAP IS [9,10,8,11,5,6,7,4,1,3,2,0,-1,-1]: -- phil<->table connection VAL INT SPR.HAPPY IS 0: VAL INT SPR.BORED IS 1: VAL INT SPR.SAD IS 2: VAL INT SPR.ILL IS 3: VAL INT SPR.DRUNK.HAPPY IS 4: VAL INT SPR.DRUNK.ILL IS 5: VAL INT SPR.TALK IS 6: VAL INT SPR.SHOCKED IS 7: VAL INT SPR.SLEEPY IS 8: VAL INT SPR.DRUNK.TALK IS 9: VAL INT SPR.CLEAR IS 10: VAL BYTE ANSI.NORMAL IS 0: VAL BYTE ANSI.BOLD IS 1: VAL BYTE ANSI.FG.BLACK IS 30: VAL BYTE ANSI.FG.RED IS 31: VAL BYTE ANSI.FG.GREEN IS 32: VAL BYTE ANSI.FG.YELLOW IS 33: VAL BYTE ANSI.FG.BLUE IS 34: VAL BYTE ANSI.FG.MAGENTA IS 35: VAL BYTE ANSI.FG.CYAN IS 36: VAL BYTE ANSI.FG.WHITE IS 37: --}}} --{{{ protocols PROTOCOL SPROTO CASE clear.screen string.x.y; BYTE; BYTE; BYTE::[]BYTE int.x.y; BYTE; BYTE; INT char.x.y; BYTE; BYTE; BYTE sprite.x.y; BYTE; BYTE; INT colour; BYTE : PROTOCOL COLL.REQ CASE init.sprite; BYTE; BYTE; BYTE -- "i am here"/init: x; y; id clear.sprite; BYTE; BYTE; BYTE -- "i am not here": x; y; id reserve.x.y; BYTE; BYTE; BYTE -- where can i go from here ?: x; y; id move.x.y; BYTE; BYTE; BYTE -- move: x; y; id region.reserve; BYTE; BYTE; BYTE; BYTE -- reserve this region ? region.set; BYTE; BYTE; BYTE; BYTE -- invalidate this region region.clear; BYTE; BYTE; BYTE; BYTE -- clear this region query.x.y; BYTE; BYTE -- what's at: x; y : PROTOCOL COLL.REP CASE reserved; [4]BYTE -- these are the directions you can go region.reply; BOOL -- yes/no to reserve query.reply; BYTE -- BYTE value at square : PROTOCOL CIF.PROTO CASE set.x.y; BYTE; BYTE -- x; y move.x.y; BYTE; BYTE; BYTE; BYTE -- cur-x; cur-y; new-x; new-y set.sprite; BYTE; BYTE; INT -- x; y; spr set.attr; BYTE; BYTE; BYTE -- x; y; attr draw.at; BYTE; BYTE; BYTE; BYTE -- cur-x; cur-y; new-x; new-y hide; BYTE; BYTE -- x; y show; BYTE; BYTE -- x; y offboard; BYTE; BYTE; BOOL -- x; y; off/on n.random; INT -- randomness hiding.sprite; INT -- spr hiding.attr; BYTE -- attr : PROTOCOL SCR.CTRL CASE set.attr; BYTE set.text; BYTE::[]BYTE set.speed; INT reset wait : PROTOCOL JUKEBOX.CTRL CASE coin -- 1 credit song; BYTE; BYTE -- disc; track : PROTOCOL PHIL.TAB CASE sit.down; INT -- philosopher sitting down; pint state (0-3) stand.up -- philosopher standing up glass.down -- philosopher puts glass down how.many -- how many here ? pint.update; INT -- pint state update (1-3) : PROTOCOL TAB.PHIL CASE n.here; INT -- number of others here : PROTOCOL TELE.REQ CASE activate; BYTE; BYTE; BYTE; BYTE; INT -- start teleport at: x; y; id; attr; sprite : PROTOCOL TELE.REP CASE done; BYTE; BYTE -- teleported to position: x; y : PROTOCOL BULLET.OUT IS BYTE; BYTE; BYTE; BYTE: -- x; y; direction; attribute PROTOCOL BULLET.IN IS INT: -- hit indicator --}}} --{{{ INT FUNCTION gen.seed.from.time (...) INT FUNCTION gen.seed.from.time (VAL INT t) IS ((t /\ #7FFFFFFF) >> 1) + 1: --}}} --{{{ PROC rand.delay (...) PROC rand.delay (VAL INT min, max, INT seed) #PRAGMA DEFINED seed TIMER tim: INT t: INT d: SEQ tim ? t d, seed := random ((max - min) + 1, seed) tim ? AFTER (t PLUS (min + d)) : --}}} --{{{ INT FUNCTION IABS (...) INT FUNCTION IABS (VAL INT n) INT r: VALOF IF n < 0 r := -n TRUE r := n RESULT r : --}}} --{{{ PROC init.screen (...) PROC init.screen (CHAN SPROTO out!, SEMAPHORE out.sem) SEQ claim.semaphore (out.sem) out ! clear.screen SEQ y = 0 FOR SIZE screen out ! string.x.y; 1; ((BYTE y) + 1); BYTE (SIZE screen[y])::screen[y] release.semaphore (out.sem) : --}}} --{{{ PROC text.scrolly (...) PROC text.scrolly (VAL BYTE x, y, width, CHAN SPROTO out!, SEMAPHORE out.sem, CHAN SCR.CTRL ctrl.in?) [255]BYTE text: BYTE text.len: BYTE attr: INT delay, t: TIMER tim: SEQ --{{{ get some initial values SEQ ctrl.in ? CASE set.attr; attr ctrl.in ? CASE set.text; text.len::text ctrl.in ? CASE set.speed; delay --}}} --{{{ main loop SEQ tim ? t t := t PLUS delay VAL []BYTE spaces IS " ": INITIAL INT idx IS (INT text.len): INITIAL BOOL suspend.input IS FALSE: WHILE TRUE SEQ --{{{ draw text SEQ claim.semaphore (out.sem) out ! colour; attr IF idx = (INT text.len) idx := -(INT width) TRUE SKIP IF idx < 0 VAL BYTE n.spaces IS BYTE (-idx): SEQ out ! string.x.y; x; y; n.spaces::spaces out ! string.x.y; x + n.spaces; y; (width - n.spaces)::text (idx + (INT width)) > (INT text.len) BYTE n.chars: SEQ n.chars := width - (((BYTE idx) + width) - text.len) out ! string.x.y; x; y; n.chars::[text FROM idx] out ! string.x.y; x + n.chars; y; (width - n.chars)::spaces TRUE out ! string.x.y; x; y; width::[text FROM idx] release.semaphore (out.sem) --}}} --{{{ alt for control or timeout PRI ALT (NOT suspend.input) & ctrl.in ? CASE set.attr; attr SKIP set.speed; delay SKIP set.text; text.len::text IF idx > (INT text.len) idx := -(INT width) TRUE SKIP reset idx := -(INT width) wait suspend.input := TRUE tim ? AFTER t SEQ idx := idx + 1 IF (idx = ((INT text.len) - 1)) AND suspend.input suspend.input := FALSE TRUE SKIP tim ? t t := t PLUS delay --}}} --}}} : --}}} --{{{ PROC detox (...) PROC detox (CHAN SPROTO out!, SEMAPHORE out.sem, CHAN INT drunk?, sober!) --{{{ note -- clients hold a semaphore when using the machine, so communication on drunk/sober -- can be fairly arbitary. --}}} --{{{ constant data, etc. VAL [][]BYTE detox.station IS ["| ", "@@ ", " | ", "@@ ", "| ", "| de-tox", "| ", "@@ ", " | ", "@@ ", "| ", "`-------"]: VAL BYTE detox.text.x IS detox.points[0] + 2: VAL BYTE detox.text.y IS detox.points[1] + 5: --}}} INT seed: SEQ --{{{ init SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.MAGENTA SEQ y = 0 FOR INT ((detox.points[3] - detox.points[1]) + 1) VAL BYTE sy IS (BYTE y) + detox.points[1]: out ! string.x.y; detox.points[0]; sy; BYTE (SIZE detox.station[y])::detox.station[y] out ! colour; ANSI.FG.CYAN out ! string.x.y; detox.text.x; detox.text.y; 6::"de-tox" release.semaphore (out.sem) TIMER tim: tim ? seed seed := gen.seed.from.time (seed) --}}} --{{{ main loop WHILE TRUE INT c: SEQ --{{{ wait for client SEQ drunk ? c --}}} --{{{ process SEQ SEQ i = 0 FOR 5 VAL BYTE y1 IS detox.points[1] + (BYTE i): VAL BYTE y2 IS detox.points[3] - ((BYTE i) + 1): SEQ claim.semaphore (out.sem) IF i < 2 out ! colour; ANSI.FG.RED i < 4 out ! colour; ANSI.FG.YELLOW TRUE out ! colour; ANSI.FG.GREEN out ! string.x.y; detox.points[0] + 3; y1; 4::"====" out ! string.x.y; detox.points[0] + 3; y2; 4::"====" release.semaphore (out.sem) rand.delay (400000, 600000, seed) claim.semaphore (out.sem) out ! string.x.y; detox.points[0] + 3; y1; 4::" " out ! string.x.y; detox.points[0] + 3; y2; 4::" " release.semaphore (out.sem) --}}} --{{{ let out SEQ sober ! c --}}} --}}} : --}}} --{{{ PROC cellar (...) PROC cellar (CHAN SPROTO out!, SEMAPHORE out.sem, CHAN INT door?, use.barrel?, beer.out!, CHAN INT beer.order!, barrel.in?, VAL INT init.barrels) #PRAGMA SHARED out, out.sem --{{{ private procs, etc. VAL [2]INT door.anim.delay IS [30000,40000]: PROC cellar.door (CHAN SPROTO out!, SEMAPHORE out.sem, CHAN INT door?, door.done!) INT seed: VAL [][4]BYTE door.bits IS ["----","--- ","-- ","- "," "]: SEQ --{{{ init TIMER tim: tim ? seed seed := gen.seed.from.time (seed) --}}} --{{{ draw door in pretty colours claim.semaphore (out.sem) out ! colour; ANSI.FG.RED out ! string.x.y; cellar.door.points[0]; cellar.door.points[1]; 4::door.bits[0] release.semaphore (out.sem) --}}} --{{{ main loop INITIAL BOOL open IS FALSE: WHILE TRUE INT start, step: INT v: SEQ door ? v IF NOT open start, step := 0, 1 TRUE start, step := (SIZE door.bits) - 1, -1 SEQ i = start FOR SIZE door.bits STEP step SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.RED out ! string.x.y; cellar.door.points[0]; cellar.door.points[1]; 4::door.bits[i] release.semaphore (out.sem) rand.delay (door.anim.delay[0], door.anim.delay[1], seed) open := NOT open door.done ! v --}}} : PROC barrel.display (CHAN SPROTO out!, SEMAPHORE out.sem, CHAN INT n.in?, VAL INT i.n) INT n: SEQ --{{{ initialise claim.semaphore (out.sem) out ! colour; ANSI.FG.MAGENTA out ! string.x.y; depot.points[0]; depot.points[1]; 4::"----" release.semaphore (out.sem) --}}} n := i.n VAL [][4]BYTE lines IS [" "," ()","()()"]: VAL [][3]INT itab IS [[0,0,0],[0,0,1],[0,0,2],[0,1,2],[0,2,2],[1,2,2],[2,2,2]]: WHILE TRUE SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.WHITE SEQ y = 0 FOR 3 out ! string.x.y; depot.points[0]; (depot.points[1] + 1) + (BYTE y); 4::lines[itab[n][y]] release.semaphore (out.sem) n.in ? n : --}}} --{{{ main cellar code SEQ --{{{ draw in pretty colours SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.MAGENTA out ! string.x.y; cellar.points[0]; cellar.points[1]; 9::"-@----@-+" SEQ iy = (INT cellar.points[1]) + 1 FOR (INT cellar.points[3]) - (INT cellar.points[1]) out ! char.x.y; cellar.points[2]; BYTE iy; '|' out ! colour; ANSI.FG.CYAN out ! string.x.y; cellar.points[0] + 1; cellar.points[1] + 2; 6::"cellar" release.semaphore (out.sem) --}}} --{{{ network CHAN INT local.door, local.door.done, bd.update: PAR cellar.door (out!, out.sem, local.door?, local.door.done!) barrel.display (out!, out.sem, bd.update?, init.barrels) INITIAL INT n.barrels IS init.barrels: WHILE TRUE SEQ --{{{ wait for dude at door INT v: door ?? v --{{{ extended process, open door SEQ local.door ! 0 INT any: local.door.done ? any --}}} --}}} --{{{ out of booze ? IF n.barrels = 0 SEQ beer.order ! 0 INITIAL BOOL done IS FALSE: WHILE NOT done INT n: SEQ barrel.in ? n IF n = 0 done := TRUE TRUE SEQ n.barrels := n.barrels + n bd.update ! n.barrels TRUE SKIP --}}} --{{{ wait for barrel change INT any: use.barrel ?? any SEQ --{{{ consume barrel and report more beer available n.barrels := n.barrels - 1 beer.out ! pints.per.barrel bd.update ! n.barrels --}}} --}}} --{{{ wait for close door SEQ INT v: door ? v local.door ! 0 INT any: local.door.done ? any --}}} --}}} --}}} : --}}} --{{{ PROC jukebox (...) PROC jukebox (CHAN JUKEBOX.CTRL in?, CHAN SPROTO out!, SEMAPHORE out.sem) #PRAGMA SHARED out, out.sem --{{{ local procs, etc. PROC credits.song.display (CHAN INT credit?, song?, CHAN SPROTO out!, SEMAPHORE out.sem) TIMER tim: INT t: INITIAL [2]BYTE dpy IS "##": INITIAL BYTE attr IS ANSI.FG.RED: INITIAL INT credit.flash IS 0: INITIAL INT current.song IS -1: WHILE TRUE SEQ claim.semaphore (out.sem) IF (credit.flash > 0) AND ((credit.flash /\ 1) = 1) out ! string.x.y; jukebox.credit.points[0]; jukebox.credit.points[1]; 2::" " TRUE SEQ out ! colour; attr out ! string.x.y; jukebox.credit.points[0]; jukebox.credit.points[1]; 2::dpy release.semaphore (out.sem) PRI ALT --{{{ incomming credit INT c: credit ? c SEQ dpy[0] := '0' + (BYTE ((c / 10) \ 10)) dpy[1] := '0' + (BYTE (c \ 10)) attr := ANSI.FG.GREEN credit.flash := 6 tim ? t t := (t PLUS 600000) --}}} --{{{ incomming song song ? current.song IF (credit.flash = 0) AND (current.song = (-1)) SEQ attr := ANSI.FG.RED dpy := "##" credit.flash = 0 SEQ attr := ANSI.FG.RED dpy[0] := '0' + (BYTE ((current.song / 10) \ 10)) dpy[1] := '0' + (BYTE (current.song \ 10)) TRUE SKIP --}}} --{{{ timeout #PRAGMA DEFINED t (credit.flash > 0) & tim ? AFTER t SEQ t := (t PLUS 600000) credit.flash := credit.flash - 1 IF --{{{ put song back (credit.flash = 0) AND (current.song = (-1)) SEQ attr := ANSI.FG.RED dpy := "##" credit.flash = 0 SEQ attr := ANSI.FG.RED dpy[0] := '0' + (BYTE ((current.song / 10) \ 10)) dpy[1] := '0' + (BYTE (current.song \ 10)) --}}} TRUE SKIP --}}} : PROC speaker (VAL BYTE x, y, CHAN SPROTO out!, SEMAPHORE out.sem, CHAN BOOL ctrl?) INT seed: VAL [][3]BYTE states IS ["---","ooo","000","OOO"]: SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.RED out ! string.x.y; x - 1; y; 5::"|---|" release.semaphore (out.sem) TIMER tim: tim ? seed seed := gen.seed.from.time (seed) TIMER tim: INT t: INITIAL BOOL running IS FALSE: INITIAL INT state IS 0: WHILE TRUE PRI ALT ctrl ? running IF running = TRUE INT v: SEQ tim ? t v, seed := random (400000, seed) t := t PLUS (200000 + v) TRUE SEQ state := 0 claim.semaphore (out.sem) out ! colour; ANSI.FG.RED out ! string.x.y; x; y; 3::states[state] release.semaphore (out.sem) #PRAGMA DEFINED t running & tim ? AFTER t INT v: SEQ state := (state + 1) \ (SIZE states) claim.semaphore (out.sem) out ! colour; ANSI.FG.RED out ! string.x.y; x; y; 3::states[state] release.semaphore (out.sem) tim ? t v, seed := random (300000, seed) t := t PLUS (150000 + v) : --}}} SEQ --{{{ draw jukebox in technicolour claim.semaphore (out.sem) out ! colour; ANSI.FG.RED out ! string.x.y; jukebox.points[0]; jukebox.points[1]; 12::"| |" out ! string.x.y; jukebox.points[0] + 1; jukebox.points[3]; 10::"---<##>---" out ! colour; ANSI.FG.BLUE out ! char.x.y; jukebox.points[0]; jukebox.points[3]; 'M' out ! char.x.y; jukebox.points[2]; jukebox.points[3]; 'M' release.semaphore (out.sem) CHAN SCR.CTRL scr.ctrl: CHAN INT upd.cred, upd.song: [2]CHAN BOOL to.speakers: PAR credits.song.display (upd.cred?, upd.song?, out!, out.sem) text.scrolly (jukebox.points[0] + 1, jukebox.points[1], (jukebox.points[2] - jukebox.points[0]) - 1, out!, out.sem, scr.ctrl?) speaker (jukebox.speaker.points[0][0], jukebox.speaker.points[0][1], out!, out.sem, to.speakers[0]?) speaker (jukebox.speaker.points[1][0], jukebox.speaker.points[1][1], out!, out.sem, to.speakers[1]?) --{{{ main process [255]BYTE dpy.text: BYTE dpy.text.len: PROC default.text () VAL []BYTE text IS "welcome to the jukebox, please insert coin to play": SEQ dpy.text.len := BYTE (SIZE text) [dpy.text FOR SIZE text] := text : PROC credit.text (VAL INT c) VAL []BYTE text IS "00 credits, please select song": SEQ dpy.text.len := BYTE (SIZE text) [dpy.text FOR SIZE text] := text dpy.text[0] := '0' + (BYTE ((c / 10) \ 10)) dpy.text[1] := '0' + (BYTE (c \ 10)) : PROC song.text (VAL BYTE disc, track, INT time) VAL []BYTE leading IS "now playing *"": VAL []BYTE trailing IS "*"": VAL [][][]BYTE song.names IS [["python -- the philosopher*'s song ", "python -- always look on the bright side of life", "python -- camalot sing-song ", "python -- eric the half-a-bee "]]: VAL [][]INT song.name.lengths IS [[32,48, 27, 29]]: VAL [][]INT song.times IS [[8500000,8000000,7000000, 9000000]]: VAL []BYTE invalid.song IS "synthesizer -- white noise": VAL INT invalid.song.time IS 10000000: VAL []BYTE n.tracks IS [BYTE (SIZE song.names[0]), 0, 0, 0, 0]: INITIAL INT i IS SIZE leading: SEQ [dpy.text FOR SIZE leading] := leading IF disc <> 0 SEQ [dpy.text FROM i FOR SIZE invalid.song] := invalid.song time := invalid.song.time i := i + (SIZE invalid.song) track > n.tracks[INT disc] SEQ [dpy.text FROM i FOR SIZE invalid.song] := invalid.song time := invalid.song.time i := i + (SIZE invalid.song) TRUE SEQ [dpy.text FROM i FOR song.name.lengths[INT disc][INT track]] := [song.names[INT disc][INT track] FOR song.name.lengths[INT disc][INT track]] time := song.times[INT disc][INT track] i := i + (song.name.lengths[INT disc][INT track]) [dpy.text FROM i FOR SIZE trailing] := trailing i := i + (SIZE trailing) dpy.text.len := BYTE i : PROC maxcredit.text () VAL []BYTE text IS "maxed at 99 credits! eating your money :)": SEQ dpy.text.len := BYTE (SIZE text) [dpy.text FOR SIZE text] := text : INT t: TIMER tim: SEQ default.text () scr.ctrl ! set.attr; ANSI.FG.CYAN scr.ctrl ! set.text; dpy.text.len::dpy.text scr.ctrl ! set.speed; 100000 INITIAL INT credits IS 0: INITIAL BOOL playing IS FALSE: WHILE TRUE PRI ALT in ? CASE --{{{ coin coin IF credits = 20 IF NOT playing SEQ maxcredit.text () scr.ctrl ! set.text; dpy.text.len::dpy.text scr.ctrl ! reset TRUE SKIP TRUE SEQ credits := credits + 1 upd.cred ! credits IF NOT playing SEQ credit.text (credits) scr.ctrl ! set.text; dpy.text.len::dpy.text scr.ctrl ! reset TRUE SKIP --}}} --{{{ song BYTE disc, track: song; disc; track IF playing SKIP credits = 0 SEQ default.text () scr.ctrl ! set.text; dpy.text.len::dpy.text scr.ctrl ! reset TRUE INT time: SEQ credits := credits - 1 song.text (disc, track, time) upd.song ! (INT track) tim ? t t := t PLUS time playing := TRUE scr.ctrl ! set.text; dpy.text.len::dpy.text scr.ctrl ! reset PAR i = 0 FOR 2 to.speakers[i] ! TRUE --}}} #PRAGMA DEFINED t playing & tim ? AFTER t --{{{ timeout for playing song SEQ playing := FALSE upd.song ! (-1) upd.cred ! credits IF credits = 0 default.text () TRUE credit.text (credits) scr.ctrl ! set.text; dpy.text.len::dpy.text scr.ctrl ! reset PAR i = 0 FOR 2 to.speakers[i] ! FALSE --}}} --}}} --}}} : --}}} --{{{ PROC pool.table (...) PROC pool.table (CHAN SPROTO out!, SEMAPHORE out.sem) #PRAGMA SHARED out, out.sem --{{{ sub-procs --{{{ constants VAL [2]BYTE cue.ball.origin IS [pool.points[0] + 4, pool.points[1] + 2]: VAL [][2]BYTE ry.ball.origin IS [[pool.points[2] - 4, pool.points[1] + 2], [pool.points[2] - 2, pool.points[1] + 2], [pool.points[2] - 3, pool.points[1] + 1], [pool.points[2] - 3, pool.points[1] + 3]]: --}}} --{{{ PROC cue.ball (...) PROC cue.ball (CHAN SPROTO out!, SEMAPHORE out.sem) SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.WHITE out ! char.x.y; cue.ball.origin[0]; cue.ball.origin[1]; 'c' release.semaphore (out.sem) : --}}} --{{{ PROC ry.ball (...) PROC ry.ball (VAL INT id, CHAN SPROTO out!, SEMAPHORE out.sem) SEQ claim.semaphore (out.sem) IF (id /\ 1) = 0 out ! colour; ANSI.FG.RED TRUE out ! colour; ANSI.FG.YELLOW out ! char.x.y; ry.ball.origin[id][0]; ry.ball.origin[id][1]; 'o' release.semaphore (out.sem) : --}}} --}}} SEQ --{{{ draw table in colour claim.semaphore (out.sem) out ! colour; ANSI.FG.GREEN out ! string.x.y; pool.points[0]; pool.points[1]; 19::"o--------o--------o" out ! string.x.y; pool.points[0]; pool.points[3]; 19::"o--------o--------o" SEQ y = (INT pool.points[1]) + 1 FOR INT ((pool.points[3] - pool.points[1]) - 1) out ! string.x.y; pool.points[0]; BYTE y; 19::"| |" release.semaphore (out.sem) --}}} --{{{ run processes PAR cue.ball (out!, out.sem) PAR i = 0 FOR SIZE ry.ball.origin ry.ball (i, out!, out.sem) --}}} : --}}} --{{{ PROC common.ifcode (...) PROC common.ifcode (VAL BYTE id, CHAN CIF.PROTO in?, CHAN SPROTO disp.out!, SEMAPHORE disp.sem, CHAN COLL.REQ c.req!, CHAN COLL.REP c.rep?, SEMAPHORE c.sem, VAL BYTE init.attr, VAL INT init.sprite, VAL [2]INT anim.delay, CHAN BYTE ch.attr.in?) BYTE x, y: INT seed: in ?? CASE set.x.y; x; y SEQ TIMER tim: tim ? seed seed := gen.seed.from.time (seed TIMES ((INT id) + 1)) claim.semaphore (c.sem) c.req ! init.sprite; x; y; id release.semaphore (c.sem) claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; init.sprite release.semaphore (disp.sem) SEQ --{{{ INLINE PROC swab (BYTE b1, BYTE b2) INITIAL BYTE t IS b1: SEQ b1 := b2 b2 := t : --}}} VAL BYTE starting.attr IS init.attr: INITIAL BYTE init.attr IS init.attr: INITIAL INT init.sprite IS init.sprite: INITIAL INT n.random IS 8: INITIAL BOOL hiding IS FALSE: INITIAL BYTE last.known.x IS x: INITIAL BYTE last.known.y IS y: INITIAL BOOL timed.attr IS FALSE: INT timed.attr.at: TIMER tim: WHILE TRUE PRI ALT ch.attr.in ? init.attr --{{{ update colour SEQ IF NOT hiding SEQ claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; last.known.x; last.known.y; SPR.SHOCKED release.semaphore (disp.sem) TRUE SKIP timed.attr := TRUE tim ? timed.attr.at timed.attr.at := timed.attr.at PLUS 10000000 -- 10 seconds --}}} #PRAGMA DEFINED timed.attr.at timed.attr & tim ? AFTER timed.attr.at --{{{ update colour SEQ init.attr := starting.attr IF NOT hiding SEQ claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; last.known.x; last.known.y; SPR.SHOCKED release.semaphore (disp.sem) TRUE SKIP timed.attr := FALSE --}}} in ?? CASE --{{{ move to position BYTE tx, ty: BYTE x, y: move.x.y; x; y; tx; ty INITIAL INT lockedin IS 0: WHILE NOT ((x = tx) AND (y = ty)) INT x.diff, y.diff: BYTE nx, ny: [4]BYTE prefdir: -- 0 = left, 1 = up, 2 = right, 3 = down SEQ claim.semaphore (c.sem) --{{{ where can we go ? (reserves all available targets) c.req ! reserve.x.y; x; y; id c.rep ? CASE reserved; prefdir --}}} --{{{ uh, more complicated than expected.. INITIAL INT i IS -1: BYTE ideal: SEQ x.diff := (INT tx) - (INT x) y.diff := (INT ty) - (INT y) --{{{ work out ideal direction IF (x.diff <= 0) AND (y.diff <= 0) IF IABS (x.diff) > IABS (y.diff) ideal := 0 TRUE ideal := 1 (x.diff <= 0) AND (y.diff > 0) IF IABS (x.diff) > IABS (y.diff) ideal := 0 TRUE ideal := 3 (x.diff > 0) AND (y.diff <= 0) IF IABS (x.diff) > IABS (y.diff) ideal := 2 TRUE ideal := 1 TRUE IF IABS (x.diff) > IABS (y.diff) ideal := 2 TRUE ideal := 3 --}}} --{{{ find direction to go in IF IF k = 0 FOR SIZE prefdir (lockedin <> 1) AND (prefdir[k] = ideal) SEQ i := k lockedin := 0 TRUE --{{{ can't go in the "ideal" way, try and go round BYTE alternative: SEQ CASE ideal 0 alternative := 3 1 alternative := 0 2 alternative := 1 3 alternative := 2 IF IF k = 0 FOR SIZE prefdir ((lockedin = 0) OR (lockedin = 1)) AND (prefdir[k] = alternative) i, lockedin := k, 1 TRUE --{{{ can't go that way either, try the other way round BYTE alt2: SEQ CASE ideal 0 alt2 := 1 1 alt2 := 2 2 alt2 := 3 3 alt2 := 0 IF IF k = 0 FOR SIZE prefdir prefdir[k] = alt2 i, lockedin := k, 2 TRUE SKIP --}}} --}}} --}}} IF i > 0 swab (prefdir[i], prefdir[0]) TRUE SKIP --}}} -- oki, should have a good selection of things in "prefdir" IF prefdir[0] = #FF --{{{ nowhere to go at the moment SEQ claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; SPR.SAD release.semaphore (disp.sem) -- tell collision that we're not moving.. c.req ! move.x.y; x; y; id release.semaphore (c.sem) -- delay before trying again rand.delay (500000, 1500000, seed) --}}} TRUE --{{{ move in prefdir[0] direction SEQ --{{{ -- maybe swap first and second directions, randomness ;) INT v: SEQ v, seed := random (n.random, seed) IF (v = 0) AND ((prefdir[0] < #04) AND (prefdir[1] < #04)) swab (prefdir[0], prefdir[1]) TRUE SKIP --}}} CASE prefdir[0] 0 nx, ny := x - 1, y 1 nx, ny := x, y - 1 2 nx, ny := x + 1, y 3 nx, ny := x, y + 1 --{{{ update display claim.semaphore (disp.sem) PRI ALT ch.attr.in ? init.attr SEQ disp.out ! colour; init.attr disp.out ! sprite.x.y; nx; ny; SPR.SHOCKED timed.attr := TRUE tim ? timed.attr.at timed.attr.at := timed.attr.at PLUS 10000000 -- 10 seconds #PRAGMA DEFINED timed.attr.at timed.attr & tim ? AFTER timed.attr.at SEQ timed.attr := FALSE init.attr := starting.attr disp.out ! colour; init.attr disp.out ! sprite.x.y; nx; ny; init.sprite TRUE & SKIP SEQ disp.out ! colour; init.attr disp.out ! sprite.x.y; nx; ny; init.sprite CASE prefdir[0] 0 disp.out ! char.x.y; (x+1); y; ' ' 1, 3 disp.out ! sprite.x.y; x; y; SPR.CLEAR 2 disp.out ! char.x.y; x; y; ' ' x, y := nx, ny release.semaphore (disp.sem) --}}} --{{{ tell collision we've moved SEQ c.req ! move.x.y; x; y; id c.req ! init.sprite; x; y; id release.semaphore (c.sem) --}}} rand.delay (anim.delay[0], anim.delay[1], seed) last.known.x := x last.known.y := y --}}} --}}} --{{{ n.random n.random; n.random SKIP --}}} --{{{ hiding.sprite hiding.sprite; init.sprite SKIP --}}} --{{{ hiding.attr hiding.attr; init.attr SKIP --}}} --{{{ offboard BYTE x, y: BOOL off: offboard; x; y; off IF off SEQ hiding := TRUE claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; SPR.CLEAR release.semaphore (disp.sem) claim.semaphore (c.sem) c.req ! clear.sprite; x; y; id release.semaphore (c.sem) TRUE SEQ hiding := FALSE claim.semaphore (c.sem) c.req ! init.sprite; x; y; id release.semaphore (c.sem) claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; init.sprite release.semaphore (disp.sem) --}}} --{{{ set.sprite BYTE x, y: set.sprite; x; y; init.sprite SEQ claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; init.sprite release.semaphore (disp.sem) last.known.x := x last.known.y := y --}}} --{{{ set.attr BYTE x, y: set.attr; x; y; init.attr SEQ claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; init.sprite release.semaphore (disp.sem) last.known.x := x last.known.y := y --}}} --{{{ v.move BYTE x, y, c.x, c.y: draw.at; c.x; c.y; x; y SEQ claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; init.sprite disp.out ! sprite.x.y; c.x; c.y; SPR.CLEAR release.semaphore (disp.sem) last.known.x := x last.known.y := y --}}} --{{{ hide BYTE x, y: hide; x; y SEQ hiding := TRUE claim.semaphore (disp.sem) disp.out ! sprite.x.y; x; y; SPR.CLEAR release.semaphore (disp.sem) last.known.x := x last.known.y := y --}}} --{{{ show BYTE x, y: show; x; y SEQ hiding := FALSE claim.semaphore (disp.sem) disp.out ! colour; init.attr disp.out ! sprite.x.y; x; y; init.sprite release.semaphore (disp.sem) last.known.x := x last.known.y := y --}}} : --}}} --{{{ PROC philosopher (...) PROC philosopher (VAL INT id, CHAN SPROTO out!, SEMAPHORE out.sem, CHAN COLL.REQ c.req!, CHAN COLL.REP c.rep?, SEMAPHORE c.sem, CHAN INT beer.req!, beer.rep?, CHAN JUKEBOX.CTRL juke.out!, CHAN INT to.detox!, from.detox?, SEMAPHORE detox.sem, CHAN BYTE ch.attr.in?, CHAN PHIL.TAB to.table!, CHAN TAB.PHIL from.table?) #PRAGMA SHARED out, out.sem --{{{ protocols/consts VAL [2]INT phil.anim.delay IS [50000,80000]: --}}} --{{{ PROC phil.maincode (...) PROC phil.maincode (VAL INT id, CHAN CIF.PROTO out!, CHAN JUKEBOX.CTRL juke.out!, CHAN SPROTO dpy.out!, SEMAPHORE dpy.sem, CHAN INT to.detox!, from.detox?, SEMAPHORE detox.sem, CHAN PHIL.TAB to.table!, CHAN TAB.PHIL from.table?) INITIAL BYTE x IS phil.origin[id][0]: INITIAL BYTE y IS phil.origin[id][1]: INT seed: INITIAL INT n.beers IS 0: [2]BYTE n.btext: PROC set.n.btext () IF n.beers > 9 SEQ n.btext[0] := '0' + (BYTE ((n.beers / 10) \ 10)) n.btext[1] := '0' + (BYTE (n.beers \ 10)) TRUE SEQ n.btext[0] := '0' + (BYTE (n.beers \ 10)) n.btext[1] := ' ' : SEQ TIMER tim: tim ? seed seed := gen.seed.from.time (seed TIMES (id + 1)) out ! set.x.y; x; y set.n.btext () claim.semaphore (dpy.sem) dpy.out ! colour; ANSI.FG.GREEN dpy.out ! string.x.y; 1; phil.queue.y + (BYTE id); 2::n.btext release.semaphore (dpy.sem) BYTE t.x, t.y: INITIAL INT def.sprite IS SPR.HAPPY: INITIAL INT current.sprite IS SPR.HAPPY: INITIAL INT pint.state IS 0: -- no pint VAL BOOL table.phil IS (id <> jukebox.phil) AND (id <> pool.phil): INITIAL BOOL had.pint IS FALSE: WHILE TRUE SEQ --{{{ sit down at table SEQ IF table.phil SEQ to.table ! sit.down; pint.state IF pint.state > 0 had.pint := TRUE TRUE had.pint := FALSE TRUE SKIP --}}} --{{{ think/talk SEQ IF table.phil BOOL talking: TIMER tim: INT long.timeout, v, rel.timeout: SEQ v, seed := random (2000000, seed) tim ? long.timeout long.timeout := long.timeout PLUS (2000000 + v) rel.timeout := 2000000 + v talking := TRUE VAL INT high.third IS (rel.timeout * 2) / 3: VAL INT low.third IS rel.timeout / 3: WHILE talking INT n.here: SEQ --{{{ ask table how many to.table ! how.many from.table ? CASE n.here; n.here --}}} --{{{ maybe update pint status (time related) INT left: SEQ tim ? left left := long.timeout MINUS left IF left > high.third SKIP left > low.third IF pint.state > 0 SEQ pint.state := 2 to.table ! pint.update; pint.state TRUE SKIP pint.state > 1 SEQ pint.state := 1 to.table ! pint.update; pint.state TRUE SKIP --}}} PRI ALT tim ? AFTER long.timeout talking := FALSE (n.here > 1) & SKIP INT t.sprite: SEQ IF (current.sprite = SPR.HAPPY) OR (current.sprite = SPR.ILL) t.sprite := SPR.TALK TRUE t.sprite := SPR.DRUNK.TALK rand.delay (50000, 100000, seed) out ! set.sprite; x; y; t.sprite rand.delay (50000, 100000, seed) out ! set.sprite; x; y; current.sprite rand.delay (100000, 300000, seed) TRUE & SKIP SEQ rand.delay (50000, 100000, seed) out ! set.sprite; x; y; SPR.BORED rand.delay (150000, 300000, seed) out ! set.sprite; x; y; current.sprite TRUE SEQ rand.delay (2000000, 4000000, seed) pint.state := 0 --}}} --{{{ get thirsty and stand up SEQ SKIP IF table.phil SEQ IF had.pint to.table ! glass.down TRUE SKIP to.table ! stand.up TRUE SKIP --}}} --{{{ pool philosopher wants to put music on :) IF id = pool.phil --{{{ move to jukebox and select song SEQ t.x := phil.origin[jukebox.phil][0] t.y := phil.origin[jukebox.phil][1] rand.delay (1000000, 2000000, seed) out ! move.x.y; x; y; t.x; t.y x, y := t.x, t.y juke.out ! song; 0; 0 --}}} TRUE SKIP --}}} --{{{ move to bar SEQ t.x := 16 t.y := phil.queue.y + (BYTE id) out ! move.x.y; x; y; t.x; t.y x, y := t.x, t.y --}}} --{{{ get beer SEQ current.sprite := SPR.SAD out ! set.sprite; x; y; current.sprite beer.req ! INT y current.sprite := SPR.BORED out ! set.sprite; x; y; current.sprite INT any: beer.rep ? any n.beers := n.beers + 1 set.n.btext () claim.semaphore (dpy.sem) IF n.beers < 5 dpy.out ! colour; ANSI.FG.GREEN n.beers < 10 dpy.out ! colour; ANSI.FG.YELLOW TRUE dpy.out ! colour; ANSI.FG.RED dpy.out ! string.x.y; 1; phil.queue.y + (BYTE id); 2::n.btext release.semaphore (dpy.sem) IF n.beers < 3 SEQ out ! n.random; 8 def.sprite := SPR.HAPPY n.beers < 6 SEQ out ! n.random; 6 def.sprite := SPR.DRUNK.HAPPY n.beers < 9 SEQ out ! n.random; 5 def.sprite := SPR.ILL TRUE SEQ out ! n.random; 4 def.sprite := SPR.DRUNK.ILL IF current.sprite <> def.sprite SEQ current.sprite := def.sprite out ! set.sprite; x; y; current.sprite TRUE SKIP pint.state := 3 --}}} --{{{ philosophers 6, 8 and 10 want to play a song IF ((id = 6) OR (id = 10)) OR (id = 8) SEQ t.x := phil.origin[jukebox.phil][0] t.y := phil.origin[jukebox.phil][1] rand.delay (1000000, 2000000, seed) out ! move.x.y; x; y; t.x; t.y x, y := t.x, t.y IF id = 6 juke.out ! song; 0; 1 id = 8 juke.out ! song; 0; 2 TRUE juke.out ! song; 0; 3 rand.delay (1000000, 2000000, seed) TRUE SKIP --}}} t.x, t.y := phil.origin[id][0], phil.origin[id][1] out ! move.x.y; x; y; t.x; t.y x, y := t.x, t.y --{{{ anything special ? IF id = jukebox.phil juke.out ! coin TRUE SKIP --}}} --{{{ if too much beer, go and de-toxify IF n.beers >= 11 SEQ --{{{ walk to detox SEQ t.x, t.y := detox.in.door[0], detox.in.door[1] out ! move.x.y; x; y; t.x; t.y x, y := t.x, t.y --}}} --{{{ do detox SEQ claim.semaphore (detox.sem) to.detox ! (INT id) out ! offboard; x; y; TRUE -- remove from arena INT any: from.detox ? any x, y := detox.out.door[0], detox.out.door[1] out ! hiding.sprite; SPR.HAPPY out ! offboard; x; y; FALSE -- put back on board rand.delay (500000, 600000, seed) t.x, t.y := x - 2, y out ! move.x.y; x; y; t.x; t.y release.semaphore (detox.sem) x, y := t.x, t.y --}}} --{{{ update beer count SEQ n.beers := 0 set.n.btext () claim.semaphore (dpy.sem) dpy.out ! colour; ANSI.FG.GREEN dpy.out ! string.x.y; 1; phil.queue.y + (BYTE id); 2::n.btext release.semaphore (dpy.sem) --{{{ walk back to table SEQ t.x, t.y := phil.origin[id][0], phil.origin[id][1] out ! move.x.y; x; y; t.x; t.y x, y := t.x, t.y --}}} pint.state := 0 TRUE SKIP --}}} : --}}} --}}} --{{{ philosopher network CHAN CIF.PROTO local: PAR phil.maincode (id, local!, juke.out!, out!, out.sem, to.detox!, from.detox?, detox.sem, to.table!, from.table?) common.ifcode (BYTE id, local?, out!, out.sem, c.req!, c.rep?, c.sem, ANSI.FG.YELLOW, SPR.HAPPY, [50000,80000], ch.attr.in?) --}}} : --}}} --{{{ PROC infoline (...) PROC infoline (CHAN SPROTO out!, SEMAPHORE out.sem) SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.MAGENTA out ! string.x.y; infoline.points[0]; infoline.points[1]; 1::"-" out ! string.x.y; infoline.points[2] - 22; infoline.points[1]; 23::"------------------------" out ! char.x.y; infoline.points[0] + 1; infoline.points[1]; '[' out ! char.x.y; infoline.points[2] - 23; infoline.points[1]; ']' release.semaphore (out.sem) CHAN SCR.CTRL to.scrolly: PAR text.scrolly (infotext.points[0], infotext.points[1], (infotext.points[2] - infotext.points[0]) + 1, out!, out.sem, to.scrolly?) VAL [][]BYTE text IS ["welcome to the upgraded bar simulation. now featuring an additional bar-tender, pool-table, jukebox and built-in game. ", "beer supplied by beer corp., purveyors of fine ale. songs provided by monty-python. ", "copyright (C) 2002 Fred Barnes . released under the GNU general public license. ", "player 1 controls are h,j,k,l or cursor-keys to move, / or . to fire/start. ", "player 2 controls are q,a,r,t to move and space to fire/start. ", "to change the way the bar-tenders behave: 0 = plain ALT, 1 = looping ALT, 2 = fair ALT. "]: VAL []BYTE text.lengths IS [121,86,97,75,62,87]: VAL []BYTE text.attrs IS [ANSI.FG.CYAN, ANSI.FG.GREEN, ANSI.FG.RED, ANSI.FG.YELLOW, ANSI.FG.CYAN, ANSI.FG.GREEN]: WHILE TRUE SEQ i = 0 FOR SIZE text.lengths SEQ to.scrolly ! set.attr; text.attrs[i] to.scrolly ! set.text; text.lengths[i]::text[i] to.scrolly ! set.speed; 80000 to.scrolly ! reset to.scrolly ! wait : --}}} --{{{ PROC table (...) PROC table (VAL INT id, CHAN SPROTO dpy!, SEMAPHORE dpy.sem, []CHAN PHIL.TAB in?, []CHAN TAB.PHIL out!, CHAN INT from.barkeep?, to.barkeep!) --{{{ local PROC PROC update.glass.count (VAL INT n) SEQ claim.semaphore (dpy.sem) dpy ! colour; ANSI.FG.MAGENTA dpy ! char.x.y; table.points[id][0] + 2; table.points[id][1] + 2; '0' + (BYTE ((n / 10) \ 10)) dpy ! char.x.y; table.points[id][0] + 3; table.points[id][1] + 2; '0' + (BYTE (n \ 10)) release.semaphore (dpy.sem) : --}}} --{{{ main table process SEQ ASSERT ((SIZE in) = 4) ASSERT ((SIZE out) = 4) --{{{ setup table SEQ update.glass.count (0) --}}} INITIAL INT n.sat.down IS 0: INITIAL INT n.glasses IS 0: INITIAL INT f IS 0: WHILE TRUE PRI ALT --{{{ bar-keeper query/collection INT n: from.barkeep ? n IF n = 0 to.barkeep ! n.glasses TRUE SEQ n.glasses := n.glasses - n update.glass.count (n.glasses) --}}} --{{{ philosopher action PRI ALT i = f FOR SIZE in VAL INT i IS i \ (SIZE in): VAL BYTE mid.y IS (table.points[id][3] - table.points[id][1]) / 2: in[i] ? CASE --{{{ sitting down INT pint.state: -- 0 = no pint, 3 = full pint sit.down; pint.state SEQ n.sat.down := n.sat.down + 1 f := i + 1 claim.semaphore (dpy.sem) CASE pint.state 0 dpy ! colour; ANSI.FG.BLACK 1 dpy ! colour; ANSI.FG.RED 2 dpy ! colour; ANSI.FG.YELLOW 3 dpy ! colour; ANSI.FG.GREEN CASE i 0 dpy ! char.x.y; table.points[id][0] + 1; table.points[id][1] + mid.y; 'B' 1 dpy ! char.x.y; table.points[id][0] + 2; table.points[id][1] + 1; 'B' 2 dpy ! char.x.y; table.points[id][2] - 1; table.points[id][1] + mid.y; 'B' 3 dpy ! char.x.y; table.points[id][2] - 2; table.points[id][3] - 1; 'B' release.semaphore (dpy.sem) --}}} --{{{ pint update INT pint.state: pint.update; pint.state SEQ f := i + 1 claim.semaphore (dpy.sem) CASE pint.state 1 dpy ! colour; ANSI.FG.RED 2 dpy ! colour; ANSI.FG.YELLOW 3 dpy ! colour; ANSI.FG.GREEN CASE i 0 dpy ! char.x.y; table.points[id][0] + 1; table.points[id][1] + mid.y; 'B' 1 dpy ! char.x.y; table.points[id][0] + 2; table.points[id][1] + 1; 'B' 2 dpy ! char.x.y; table.points[id][2] - 1; table.points[id][1] + mid.y; 'B' 3 dpy ! char.x.y; table.points[id][2] - 2; table.points[id][3] - 1; 'B' release.semaphore (dpy.sem) --}}} --{{{ standing up stand.up SEQ n.sat.down := n.sat.down - 1 f := i + 1 claim.semaphore (dpy.sem) CASE i 0 dpy ! char.x.y; table.points[id][0] + 1; table.points[id][1] + mid.y; ' ' 1 dpy ! char.x.y; table.points[id][0] + 2; table.points[id][1] + 1; ' ' 2 dpy ! char.x.y; table.points[id][2] - 1; table.points[id][1] + mid.y; ' ' 3 dpy ! char.x.y; table.points[id][2] - 2; table.points[id][3] - 1; ' ' release.semaphore (dpy.sem) --}}} --{{{ empty pint down glass.down SEQ n.glasses := n.glasses + 1 update.glass.count (n.glasses) f := i + 1 --}}} --{{{ how many how.many SEQ out[i] ! n.here; n.sat.down f := i + 1 --}}} --}}} --}}} : --}}} --{{{ PROC teleport (...) PROC teleport (CHAN SPROTO out!, SEMAPHORE out.sem, CHAN TELE.REQ req?, CHAN TELE.REP rep!, CHAN COLL.REQ c.req!, CHAN COLL.REP c.rep?, SEMAPHORE c.sem) #PRAGMA SHARED out, out.sem --{{{ local PROC PROC teleporter.anim (CHAN SPROTO out!, SEMAPHORE out.sem, CHAN BOOL ctrl?) VAL INT t.delay IS 100000: WHILE TRUE TIMER tim: INT t: SEQ --{{{ wait for start SEQ BOOL any: ctrl ? any --}}} --{{{ loop until signal SEQ tim ? t t := t PLUS t.delay INITIAL BOOL done IS FALSE: VAL BYTE n.steps IS (teleport.points[0][2] - teleport.points[0][0]) + 1: INITIAL BYTE i IS 0: INITIAL BYTE last.i IS n.steps - 1: WHILE NOT done SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.WHITE out ! char.x.y; teleport.points[0][0] + i; teleport.points[0][1]; '>' out ! char.x.y; teleport.points[0][2] - i; teleport.points[0][3]; '<' out ! char.x.y; teleport.points[1][0] + i; teleport.points[1][1]; '>' out ! char.x.y; teleport.points[1][2] - i; teleport.points[1][3]; '<' out ! colour; ANSI.FG.RED out ! char.x.y; teleport.points[0][0] + last.i; teleport.points[0][1]; '-' out ! char.x.y; teleport.points[0][2] - last.i; teleport.points[0][3]; '=' out ! char.x.y; teleport.points[1][0] + last.i; teleport.points[1][1]; '-' out ! char.x.y; teleport.points[1][2] - last.i; teleport.points[1][3]; '=' release.semaphore (out.sem) last.i := i i := (i + 1) \ n.steps PRI ALT BOOL any: ctrl ? any done := TRUE tim ? AFTER t t := t PLUS t.delay --}}} --{{{ put teleporter back together SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.RED SEQ i = 0 FOR SIZE teleport.points SEQ out ! string.x.y; teleport.points[i][0]; teleport.points[i][1]; 4::"----" out ! string.x.y; teleport.points[i][0]; teleport.points[i][3]; 4::"====" release.semaphore (out.sem) --}}} : --}}} CHAN BOOL anim: PAR teleporter.anim (out!, out.sem, anim?) VAL [2]BYTE pad.x IS [teleport.points[0][0] + 1, teleport.points[1][0] + 1]: VAL [2]BYTE pad.y IS [teleport.points[0][1] + 1, teleport.points[1][1] + 1]: INT seed: SEQ --{{{ initialise SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.RED SEQ i = 0 FOR SIZE teleport.points SEQ out ! string.x.y; teleport.points[i][0]; teleport.points[i][1]; 4::"----" out ! string.x.y; teleport.points[i][0]; teleport.points[i][3]; 4::"====" release.semaphore (out.sem) TIMER tim: tim ? seed seed := gen.seed.from.time (seed) --}}} VAL [][]BYTE pad0b IS [[teleport.points[0][0], teleport.points[0][1] + 1, teleport.points[0][2], teleport.points[0][3] - 1], [teleport.points[0][0], teleport.points[0][1] + 1, teleport.points[0][0], teleport.points[0][3] - 1], [teleport.points[0][2], teleport.points[0][1] + 1, teleport.points[0][2], teleport.points[0][3] - 1]]: VAL [][]BYTE pad1b IS [[teleport.points[1][0], teleport.points[1][1] + 1, teleport.points[1][2], teleport.points[1][3] - 1], [teleport.points[1][0], teleport.points[1][1] + 1, teleport.points[1][0], teleport.points[1][3] - 1], [teleport.points[1][2], teleport.points[1][1] + 1, teleport.points[1][2], teleport.points[1][3] - 1]]: --{{{ main loop WHILE TRUE BYTE x, y: BYTE t.attr, t.id: INT t.sprite: SEQ --{{{ get request SEQ req ? CASE activate; x; y; t.id; t.attr; t.sprite --}}} --{{{ shut doors SEQ --{{{ get space INITIAL BOOL got.space IS FALSE: WHILE NOT got.space BOOL bit1, bit2, bit3: SEQ bit1 := FALSE bit2 := FALSE bit3 := FALSE claim.semaphore (c.sem) --{{{ claim other pad IF (x = pad.x[0]) AND (y = pad.y[0]) c.req ! region.reserve; pad1b[0][0]; pad1b[0][1]; pad1b[0][2]; pad1b[0][3] (x = pad.x[1]) AND (y = pad.y[1]) c.req ! region.reserve; pad0b[0][0]; pad0b[0][1]; pad0b[0][2]; pad0b[0][3] c.rep ? CASE region.reply; bit1 --}}} --{{{ claim one door IF (x = pad.x[0]) AND (y = pad.y[0]) c.req ! region.reserve; pad0b[1][0]; pad0b[1][1]; pad0b[1][2]; pad0b[1][3] (x = pad.x[1]) AND (y = pad.y[1]) c.req ! region.reserve; pad1b[1][0]; pad1b[1][1]; pad1b[1][2]; pad1b[1][3] c.rep ? CASE region.reply; bit2 --}}} --{{{ then the other IF (x = pad.x[0]) AND (y = pad.y[0]) c.req ! region.reserve; pad0b[2][0]; pad0b[2][1]; pad0b[2][2]; pad0b[2][3] (x = pad.x[1]) AND (y = pad.y[1]) c.req ! region.reserve; pad1b[2][0]; pad1b[2][1]; pad1b[2][2]; pad1b[2][3] c.rep ? CASE region.reply; bit3 --}}} release.semaphore (c.sem) --{{{ if we have all 3 bits, good, if not, need to release the ones we do have IF (bit1 AND bit2) AND bit3 got.space := TRUE TRUE SEQ claim.semaphore (c.sem) IF bit1 IF (x = pad.x[0]) AND (y = pad.y[0]) c.req ! region.clear; pad1b[0][0]; pad1b[0][1]; pad1b[0][2]; pad1b[0][3] (x = pad.x[1]) AND (y = pad.y[1]) c.req ! region.clear; pad0b[0][0]; pad0b[0][1]; pad0b[0][2]; pad0b[0][3] TRUE SKIP IF bit2 IF (x = pad.x[0]) AND (y = pad.y[0]) c.req ! region.clear; pad0b[1][0]; pad0b[1][1]; pad0b[1][2]; pad0b[1][3] (x = pad.x[1]) AND (y = pad.y[1]) c.req ! region.clear; pad1b[1][0]; pad1b[1][1]; pad1b[1][2]; pad1b[1][3] TRUE SKIP IF bit3 IF (x = pad.x[0]) AND (y = pad.y[0]) c.req ! region.clear; pad0b[2][0]; pad0b[2][1]; pad0b[2][2]; pad0b[2][3] (x = pad.x[1]) AND (y = pad.y[1]) c.req ! region.clear; pad1b[2][0]; pad1b[2][1]; pad1b[2][2]; pad1b[2][3] TRUE SKIP release.semaphore (c.sem) --}}} --}}} --{{{ claim space SEQ claim.semaphore (c.sem) -- only need to claim the doors and clear the other pad c.req ! region.set; pad0b[1][0]; pad0b[1][1]; pad0b[1][2]; pad0b[1][3] c.req ! region.set; pad0b[2][0]; pad0b[2][1]; pad0b[2][2]; pad0b[2][3] c.req ! region.set; pad1b[1][0]; pad1b[1][1]; pad1b[1][2]; pad1b[1][3] c.req ! region.set; pad1b[2][0]; pad1b[2][1]; pad1b[2][2]; pad1b[2][3] IF (x = pad.x[0]) AND (y = pad.y[0]) c.req ! region.clear; pad.x[1]; pad.y[1]; pad.x[1] + 1; pad.y[1] (x = pad.x[1]) AND (y = pad.y[1]) c.req ! region.clear; pad.x[0]; pad.y[0]; pad.x[0] + 1; pad.y[0] release.semaphore (c.sem) --}}} --{{{ draw in doors SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.RED out ! char.x.y; pad0b[1][0]; pad0b[1][1]; '[' out ! char.x.y; pad0b[2][0]; pad0b[2][1]; ']' out ! char.x.y; pad1b[1][0]; pad1b[1][1]; '[' out ! char.x.y; pad1b[2][0]; pad1b[2][1]; ']' release.semaphore (out.sem) anim ! TRUE rand.delay (800000, 1200000, seed) --}}} --}}} --{{{ teleport VAL INT teleport.count IS 17: SEQ i = 0 FOR teleport.count SEQ rand.delay (200000 - (i * 10000), 300000 - (i * 14000), seed) claim.semaphore (out.sem) IF (x = pad.x[0]) AND (y = pad.y[0]) SEQ out ! colour; t.attr out ! sprite.x.y; pad.x[0]; pad.y[0]; SPR.CLEAR IF i = (teleport.count - 1) out ! sprite.x.y; pad.x[1]; pad.y[1]; t.sprite TRUE out ! sprite.x.y; pad.x[1]; pad.y[1]; SPR.SHOCKED x, y := pad.x[1], pad.y[1] (x = pad.x[1]) AND (y = pad.y[1]) SEQ out ! colour; t.attr out ! sprite.x.y; pad.x[1]; pad.y[1]; SPR.CLEAR IF i = (teleport.count - 1) out ! sprite.x.y; pad.x[0]; pad.y[0]; t.sprite TRUE out ! sprite.x.y; pad.x[0]; pad.y[0]; SPR.SHOCKED x, y := pad.x[0], pad.y[0] release.semaphore (out.sem) --}}} --{{{ move sprite in the eyes of the collision detector SEQ claim.semaphore (c.sem) IF (x = pad.x[0]) AND (y = pad.y[0]) SEQ c.req ! clear.sprite; pad.x[1]; pad.y[1]; t.id c.req ! init.sprite; pad.x[0]; pad.y[0]; t.id (x = pad.x[1]) AND (y = pad.y[1]) SEQ c.req ! clear.sprite; pad.x[0]; pad.y[0]; t.id c.req ! init.sprite; pad.x[1]; pad.y[1]; t.id release.semaphore (c.sem) --}}} --{{{ open doors SEQ rand.delay (800000, 1200000, seed) anim ! TRUE claim.semaphore (out.sem) out ! char.x.y; pad0b[1][0]; pad0b[1][1]; ' ' out ! char.x.y; pad0b[2][0]; pad0b[2][1]; ' ' out ! char.x.y; pad1b[1][0]; pad1b[1][1]; ' ' out ! char.x.y; pad1b[2][0]; pad1b[2][1]; ' ' release.semaphore (out.sem) claim.semaphore (c.sem) c.req ! region.clear; pad0b[1][0]; pad0b[1][1]; pad0b[1][2]; pad0b[1][3] c.req ! region.clear; pad0b[2][0]; pad0b[2][1]; pad0b[2][2]; pad0b[2][3] c.req ! region.clear; pad1b[1][0]; pad1b[1][1]; pad1b[1][2]; pad1b[1][3] c.req ! region.clear; pad1b[2][0]; pad1b[2][1]; pad1b[2][2]; pad1b[2][3] release.semaphore (c.sem) --}}} --{{{ let sprite continue SEQ rep ! done; x; y --}}} --}}} : --}}} --{{{ PROC bar (...) PROC bar (CHAN SPROTO out!, SEMAPHORE out.sem, []CHAN INT req.in?, req.out!, CHAN COLL.REQ c.req!, CHAN COLL.REP c.rep?, SEMAPHORE c.sem, CHAN INT to.cellar.door!, to.cellar.barrel!, SEMAPHORE barrel.sem, CHAN INT beer.in?, CHAN INT c.altmode?, []CHAN INT to.tables!, from.tables?, CHAN TELE.REQ tele.req!, CHAN TELE.REP tele.rep?) #PRAGMA SHARED out, out.sem, c.req, c.rep, c.sem, req.out, to.cellar.door, to.cellar.barrel #PRAGMA SHARED barrel.sem, to.tables, from.tables, tele.req, tele.rep --{{{ local procs/etc. PROC attendant (VAL INT id, CHAN CIF.PROTO out!, CHAN INT req.in?, SEMAPHORE req.sem, []CHAN INT req.out!, CHAN INT to.cellar.door!, CHAN INT to.cellar.barrel!, SEMAPHORE barrel.sem, []CHAN INT to.tables!, from.tables?, CHAN TELE.REQ tele.req!, CHAN TELE.REP tele.rep?, SEMAPHORE tele.sem) INITIAL BYTE x IS att.origin[id][0]: INITIAL BYTE y IS att.origin[id][1]: VAL [2]BYTE pad.x IS [teleport.points[0][0] + 1, teleport.points[1][0] + 1]: VAL [2]BYTE pad.y IS [teleport.points[0][1] + 1, teleport.points[1][1] + 1]: INT seed: SEQ --{{{ initialise TIMER tim: tim ? seed seed := gen.seed.from.time (seed TIMES (id + 1)) out ! set.x.y; x; y --}}} VAL INT collect.max IS 50: INITIAL INT collect.count IS (collect.max / 2) * (id + 1): WHILE TRUE INT cust, yp: SEQ --{{{ get job SEQ claim.semaphore (req.sem) req.in ? cust IF cust = (-1) --{{{ means go to the cellar and add barrel (20 pints here! -- 288 really..) SEQ --{{{ move to cellar and open door SEQ out ! move.x.y; x; y; cellar.door.points[0] + 1; cellar.door.points[1] - 1 x, y := cellar.door.points[0] + 1, cellar.door.points[1] - 1 to.cellar.door ! 0 --}}} --{{{ hide from screen SEQ out ! draw.at; x; y; x; y+1 rand.delay (200000, 400000, seed) out ! hide; x; y+1 rand.delay (1000000, 1000010, seed) --}}} --{{{ add barrel SEQ claim.semaphore (barrel.sem) to.cellar.barrel ! 1 release.semaphore (barrel.sem) --}}} -- this releases the block on the other attendant. release.semaphore (req.sem) --{{{ make visible SEQ rand.delay (1000000, 1000010, seed) out ! show; x; y+1 rand.delay (200000, 400000, seed) out ! draw.at; x; y+1; x; y --}}} --{{{ shut door SEQ to.cellar.door ! 0 --}}} --}}} TRUE SEQ req.in ? yp release.semaphore (req.sem) --}}} --{{{ maybe move to customer + serve IF cust = (-1) SKIP TRUE --{{{ move to customer and serve SEQ -- cust is Y location out ! move.x.y; x; y; 12; BYTE cust x, y := 12, BYTE cust rand.delay (200000, 400000, seed) #PRAGMA DEFINED yp req.out[yp] ! cust --}}} --}}} --{{{ maybe done serving IF cust = (-1) SKIP TRUE SEQ --{{{ move back a bit SEQ out ! move.x.y; x; y; x - 6; y x := x - 6 --}}} --{{{ breif pause SEQ rand.delay (200000, 300000, seed) --}}} --}}} --{{{ maybe go and collect glasses IF collect.count = 0 SEQ --{{{ move to just outside the first pad out ! move.x.y; x; y; pad.x[0] + 5; pad.y[0] x, y := pad.x[0] + 5, pad.y[0] --}}} --{{{ claim transporter semaphore claim.semaphore (tele.sem) --}}} --{{{ move onto pad out ! move.x.y; x; y; pad.x[0]; pad.y[0] x, y := pad.x[0], pad.y[0] --}}} --{{{ activate teleporter SEQ tele.req ! activate; x; y; BYTE (NUM.PHILS + id); ANSI.FG.CYAN; SPR.HAPPY tele.rep ? CASE done; x; y --}}} --{{{ move off pad out ! move.x.y; x; y; pad.x[1] + 3; pad.y[1] x, y := pad.x[1] + 3, pad.y[1] --}}} --{{{ release transporter semaphore release.semaphore (tele.sem) --}}} --{{{ go and collect glasses SEQ SEQ i = 0 FOR SIZE table.points INT n: SEQ out ! move.x.y; x; y; table.points[i][0] - 2; table.points[i][1] - 1 x, y := table.points[i][0] - 2, table.points[i][1] - 1 to.tables[i] ! 0 from.tables[i] ? n WHILE n > 0 SEQ rand.delay (50000, 60000, seed) to.tables[i] ! 1 n := (n - 1) --}}} --{{{ move back to pad out ! move.x.y; x; y; pad.x[1] + 5; pad.y[1] x, y := pad.x[1] + 5, pad.y[1] --}}} --{{{ claim transporter semaphore claim.semaphore (tele.sem) --}}} --{{{ move onto pad out ! move.x.y; x; y; pad.x[1]; pad.y[1] x, y := pad.x[1], pad.y[1] --}}} --{{{ activate teleporter SEQ tele.req ! activate; x; y; BYTE (NUM.PHILS + id); ANSI.FG.CYAN; SPR.HAPPY tele.rep ? CASE done; x; y --}}} --{{{ move off pad out ! move.x.y; x; y; pad.x[0] + 3; pad.y[0] x, y := pad.x[0] + 3, pad.y[0] --}}} --{{{ release transporter semaphore release.semaphore (tele.sem) --}}} collect.count := collect.max TRUE collect.count := collect.count - 1 --}}} : PROC beer.tank (CHAN INT req?, resp!, get?, put?, CHAN SCR.CTRL to.scrolly!) --{{{ PROC mkmsg ([]BYTE msg, VAL INT n) SEQ IF n = 1 msg[7] := ' ' TRUE msg[7] := 's' IF n < 10 [msg FOR 2] := [' ', '0' + (BYTE n)] TRUE [msg FOR 2] := ['0' + (BYTE (n / 10)), '0' + (BYTE (n \ 10))] : --}}} INT n.beers: [8]BYTE beer.msg: SEQ --{{{ initialise SEQ n.beers := 0 beer.msg := " 0 pints" mkmsg (beer.msg, n.beers) to.scrolly ! set.attr; ANSI.FG.CYAN to.scrolly ! set.text; 8::beer.msg to.scrolly ! set.speed; 80000 --}}} --{{{ main loop WHILE TRUE PRI ALT --{{{ requesting beer availability INT v: req ? v resp ! n.beers --}}} --{{{ add or remove beer INT any: (n.beers > 0) & get ? any SEQ n.beers := n.beers - 1 mkmsg (beer.msg, n.beers) to.scrolly ! set.text; 8::beer.msg INT n: put ? n SEQ n.beers := n.beers + n mkmsg (beer.msg, n.beers) to.scrolly ! set.text; 8::beer.msg --}}} --}}} : --}}} --{{{ main bar code SEQ --{{{ initialise with pretty colours claim.semaphore (out.sem) out ! colour; ANSI.FG.MAGENTA SEQ y = 1 FOR INT ((bar.points[3] - bar.points[1]) + 1) out ! string.x.y; bar.points[0]; BYTE y; 2::"||" out ! char.x.y; barstat.points[0] - 1; barstat.points[1]; '[' out ! char.x.y; barstat.points[2] + 1; barstat.points[3]; ']' out ! colour; ANSI.FG.WHITE SEQ i = 0 FOR SIZE bar.supports.y out ! string.x.y; bar.points[0]; bar.supports.y[i]; 2::"@@" release.semaphore (out.sem) --}}} --{{{ run attendant processes CHAN INT to.attend: #PRAGMA SHARED to.attend SEMAPHORE attend.sem: #PRAGMA SHARED attend.sem SEMAPHORE tele.sem: #PRAGMA SHARED tele.sem SEQ initialise.semaphore (attend.sem, 1) initialise.semaphore (tele.sem, 1) CHAN INT beer.req, beer.repl, beer.get: PAR --{{{ attendants PAR i = 0 FOR NUM.ATTENDANTS CHAN CIF.PROTO local: PAR attendant (i, local!, to.attend?, attend.sem, req.out!, to.cellar.door!, to.cellar.barrel!, barrel.sem, to.tables!, from.tables?, tele.req!, tele.rep?, tele.sem) CHAN BYTE dummy: common.ifcode (BYTE (NUM.PHILS + i), local?, out!, out.sem, c.req!, c.rep?, c.sem, ANSI.FG.CYAN, SPR.HAPPY, [40000,60000], dummy?) --}}} --{{{ bar status and beer CHAN SCR.CTRL local: PAR text.scrolly (barstat.points[0], barstat.points[1], (barstat.points[2] - barstat.points[0]) + 1, out!, out.sem, local?) beer.tank (beer.req?, beer.repl!, beer.get?, beer.in?, local!) --}}} --{{{ arbitrator INITIAL INT altmode IS 0: -- regular ALT INITIAL INT fav IS 0: -- for fair ALT(s) WHILE TRUE INITIAL BOOL do.service IS TRUE: INT y, s: SEQ CASE altmode 0 PRI ALT c.altmode ? altmode do.service := FALSE ALT i = 0 FOR SIZE req.in req.in[i] ? y s := i 1 PRI ALT c.altmode ? altmode do.service := FALSE PRI ALT i = fav FOR SIZE req.in VAL INT i IS i \ (SIZE req.in): req.in[i] ? y fav, s := (fav + 1) \ (SIZE req.in), i 2 PRI ALT c.altmode ? altmode do.service := FALSE PRI ALT i = fav FOR SIZE req.in VAL INT i IS i \ (SIZE req.in): req.in[i] ? y fav, s := i + 1, i IF #PRAGMA DEFINED s, y do.service SEQ --{{{ check for available beers INT n: SEQ beer.req ! -1 beer.repl ? n IF n = 0 --{{{ no beer, tell attendant to go get some to.attend ! -1 --}}} TRUE SKIP --}}} --{{{ tell attendant to serve customer SEQ to.attend ! y to.attend ! s --}}} --{{{ use beer SEQ beer.get ! 1 --}}} TRUE SKIP --}}} --}}} --}}} : --}}} --{{{ PROC nhs (...) PROC nhs (CHAN SPROTO out!, SEMAPHORE out.sem) VAL [3][]BYTE ambulance IS [".-----$$-. ", "| + |A__\ ", "`O-O`--*'O`-*""]: SKIP : --}}} --{{{ PROC beer.corp (...) PROC beer.corp (CHAN SPROTO out!, SEMAPHORE out.sem, CHAN INT need.beer?, got.beer!) VAL [3][]BYTE lorry IS ["|( beer )|@@\ ", "|( corp )|__ \.", "*"*'O*'O`---=*'O`-*""]: VAL []BYTE empty.string IS " ": INT seed: VAL [2]INT beer.truck.delay IS [50000,70000]: SEQ TIMER tim: tim ? seed seed := gen.seed.from.time (seed) WHILE TRUE SEQ --{{{ wait for call INT any: need.beer ? any --}}} --{{{ animate to pub SEQ i = 0 FOR SIZE lorry[0] SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.YELLOW SEQ y = 0 FOR 3 out ! string.x.y; beer.truck.points[2] - (BYTE i); beer.truck.points[1] + (BYTE y); ((BYTE i)+1)::lorry[y] release.semaphore (out.sem) rand.delay (beer.truck.delay[0], beer.truck.delay[1], seed) INITIAL INT anim.start IS INT ((beer.truck.points[2] - (BYTE (SIZE lorry[0]))) - 0): INITIAL INT anim.len IS INT (((BYTE anim.start) - beer.truck.points[0]) + 1): SEQ x = anim.start FOR anim.len STEP -1 SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.YELLOW SEQ y = 0 FOR 3 out ! string.x.y; BYTE x; beer.truck.points[1] + (BYTE y); BYTE (SIZE lorry[y])::lorry[y] SEQ y = 0 FOR 3 out ! char.x.y; (BYTE x) + (BYTE (SIZE lorry[y])); beer.truck.points[1] + (BYTE y); ' ' release.semaphore (out.sem) rand.delay (beer.truck.delay[0], beer.truck.delay[1], seed) --}}} --{{{ load up beer TIMER tim: INT t: SEQ SEQ i = 0 FOR 6 SEQ tim ? t tim ? AFTER (t PLUS 200000) got.beer ! 1 got.beer ! 0 tim ? t tim ? AFTER (t PLUS 200000) --}}} --{{{ drive off INITIAL INT anim.start IS INT (beer.truck.points[0] + 1): INITIAL INT anim.len IS INT (beer.truck.points[2] - ((BYTE (anim.start - 1)) + (BYTE (SIZE lorry[0])))): SEQ x = anim.start FOR anim.len SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.YELLOW SEQ y = 0 FOR 3 out ! string.x.y; BYTE x; beer.truck.points[1] + (BYTE y); BYTE (SIZE lorry[y])::lorry[y] SEQ y = 0 FOR 3 out ! char.x.y; (BYTE x) - 1; beer.truck.points[1] + (BYTE y); ' ' release.semaphore (out.sem) rand.delay (beer.truck.delay[0], beer.truck.delay[1], seed) SEQ i = 0 FOR SIZE lorry[0] VAL BYTE x IS (beer.truck.points[2] - (BYTE (SIZE lorry[0]))) + ((BYTE i) + 1): SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.YELLOW SEQ y = 0 FOR 3 SEQ out ! char.x.y; x - 1; beer.truck.points[1] + (BYTE y); ' ' out ! string.x.y; x; beer.truck.points[1] + (BYTE y); (BYTE ((SIZE lorry[0]) - i))::lorry[y] release.semaphore (out.sem) rand.delay (beer.truck.delay[0], beer.truck.delay[1], seed) claim.semaphore (out.sem) SEQ y = 0 FOR 3 out ! char.x.y; beer.truck.points[2]; beer.truck.points[1] + (BYTE y); ' ' release.semaphore (out.sem) --}}} : --}}} --{{{ PROC game.if (...) PROC game.if (VAL INT player, CHAN BYTE kyb?, CHAN SPROTO out!, SEMAPHORE out.sem, CHAN COLL.REQ c.req!, CHAN COLL.REP c.rep?, SEMAPHORE c.sem, CHAN BULLET.OUT b.out!, CHAN BULLET.IN b.in?, []CHAN BYTE ch.attr.out!, SEMAPHORE ch.attr.sem) VAL [][][][]BYTE buggy IS [[["|1~@\", "`O-O*""], ["/@~1|", "*"O-O*'"], ["0/~\0", "0|1|0"], ["0|1|0", "0\_/0"], ["|1x@\", "`^~^*""], ["/@x1|", "*"^~^*'"], ["^/x\^", "^|1|^"], ["^|1|^", "^\x/^"]], [["|2~@\", "`O-O*""], ["/@~2|", "*"O-O*'"], ["0/~\0", "0|2|0"], ["0|2|0", "0\_/0"], ["|2x@\", "`^~^*""], ["/@x2|", "*"^~^*'"], ["^/x\^", "^|2|^"], ["^|2|^", "^\x/^"]]]: VAL [][]BYTE init.strips IS ["> INIT <"," >INIT< "," >NI< "," >< "," "]: VAL BYTE buggy.width IS 5: VAL BYTE buggy.height IS 2: VAL INT DIR.RIGHT IS 0: VAL INT DIR.LEFT IS 1: VAL INT DIR.UP IS 2: VAL INT DIR.DOWN IS 3: INT seed: SEQ --{{{ initialise SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.MAGENTA out ! string.x.y; game.if.points[player][0]; game.if.points[player][1]; ((game.if.points[player][2] - game.if.points[player][0]) + 1)::"[ ]" TIMER tim: tim ? seed release.semaphore (out.sem) seed := gen.seed.from.time (seed) --}}} --{{{ game loop INITIAL INT in.game IS 0: INITIAL BOOL flash.on IS TRUE: INITIAL BYTE b.x IS 0: INITIAL BYTE b.y IS 0: INITIAL INT b.dir IS 0: INITIAL INT p.outstanding IS 0: -- bullets sent whose status isn't known WHILE TRUE CASE in.game 0 TIMER tim: INT t: SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.MAGENTA IF flash.on AND (player = 0) out ! string.x.y; game.if.points[player][0] + 1; game.if.points[player][1]; 8::"1P START" flash.on AND (player = 1) out ! string.x.y; game.if.points[player][0] + 1; game.if.points[player][1]; 8::"2P START" TRUE out ! string.x.y; game.if.points[player][0] + 1; game.if.points[player][1]; 8::" " release.semaphore (out.sem) flash.on := NOT flash.on tim ? t t := t /\ #FFF00000 PRI ALT tim ? AFTER (t PLUS #100000) SKIP BYTE any: kyb ? any CASE any '.', '/', ' ', '*n', '*c' in.game := 1 ELSE SKIP 1 SEQ b.x := game.entry.points[player][0] b.y := game.entry.points[player][1] b.dir := DIR.LEFT --{{{ try and reserve space on board INITIAL INT c IS 0: INITIAL BOOL reserved IS FALSE: WHILE NOT reserved SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.CYAN out ! string.x.y; game.if.points[player][0] + 1; game.if.points[player][1]; 8::init.strips[c] release.semaphore (out.sem) rand.delay (500000, 700000, seed) c := (c + 1) \ (SIZE init.strips) claim.semaphore (c.sem) c.req ! region.reserve; b.x; b.y; b.x + (buggy.width - 1); b.y + (buggy.height - 1) c.rep ? CASE region.reply; reserved release.semaphore (c.sem) --}}} --{{{ flash some "get ready" text VAL [][]BYTE ready.strings IS ["ready 2!", " ", "ready 1!", " "]: SEQ n = 0 FOR SIZE ready.strings TIMER tim: INT t: SEQ tim ? t claim.semaphore (out.sem) out ! colour; ANSI.FG.YELLOW out ! string.x.y; game.if.points[player][0] + 1; game.if.points[player][1]; 8::ready.strings[n] release.semaphore (out.sem) tim ? AFTER (t PLUS 750000) --}}} --{{{ claim space and pop in buggy SEQ claim.semaphore (c.sem) c.req ! region.set; b.x; b.y; b.x + (buggy.width - 1); b.y + (buggy.height - 1) release.semaphore (c.sem) claim.semaphore (out.sem) out ! colour; ANSI.FG.CYAN SEQ i = 0 FOR INT buggy.height out ! string.x.y; b.x; b.y + (BYTE i); buggy.width::buggy[player][b.dir][i] release.semaphore (out.sem) --}}} in.game := 2 2 --{{{ local PROC PROC update.timer (VAL INT time) SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.RED SEQ i = 0 FOR 2 IF i < time out ! char.x.y; game.if.points[player][0] + (1 + (BYTE i)); game.if.points[player][1]; '=' TRUE out ! char.x.y; game.if.points[player][0] + (1 + (BYTE i)); game.if.points[player][1]; ' ' out ! colour; ANSI.FG.YELLOW SEQ i = 2 FOR 2 IF i < time out ! char.x.y; game.if.points[player][0] + (1 + (BYTE i)); game.if.points[player][1]; '=' TRUE out ! char.x.y; game.if.points[player][0] + (1 + (BYTE i)); game.if.points[player][1]; ' ' out ! colour; ANSI.FG.GREEN SEQ i = 4 FOR 4 IF i < time out ! char.x.y; game.if.points[player][0] + (1 + (BYTE i)); game.if.points[player][1]; '=' TRUE out ! char.x.y; game.if.points[player][0] + (1 + (BYTE i)); game.if.points[player][1]; ' ' release.semaphore (out.sem) : --}}} SEQ --{{{ main loop TIMER tim: INT t: INITIAL INT seconds.left IS 8: WHILE seconds.left >= 0 SEQ update.timer (seconds.left) --{{{ inner loop tim ? t t := t PLUS 1000000 INITIAL BOOL timed.out IS FALSE: WHILE NOT timed.out PRI ALT tim ? AFTER t timed.out := TRUE INT status: b.in ? status SEQ p.outstanding := p.outstanding - 1 IF status >= 0 --{{{ hit something worthy SEQ seconds.left := 8 update.timer (seconds.left) tim ? t t := t PLUS 1000000 IF (status /\ #FF) < (SIZE ch.attr.out) SEQ claim.semaphore (ch.attr.sem) ch.attr.out[status /\ #FF] ! BYTE (status >> 8) release.semaphore (ch.attr.sem) TRUE SKIP --}}} TRUE SKIP BYTE key: kyb ? key INITIAL BOOL redraw IS FALSE: INITIAL INT target.dir IS (-1): INITIAL BOOL reserved IS FALSE: INITIAL BOOL fire IS FALSE: SEQ --{{{ process key-press CASE key '/','.',' ' -- fire! IF p.outstanding >= MAX.BULLETS SKIP TRUE fire := TRUE 'h','r' -- left IF b.dir = DIR.RIGHT b.dir, redraw := DIR.LEFT, TRUE TRUE b.dir, target.dir := DIR.LEFT, 0 'j','q' -- up IF b.dir = DIR.DOWN b.dir, redraw := DIR.UP, TRUE TRUE b.dir, target.dir := DIR.UP, 1 'k','a' -- down IF b.dir = DIR.UP b.dir, redraw := DIR.DOWN, TRUE TRUE b.dir, target.dir := DIR.DOWN, 3 'l','t' -- right IF b.dir = DIR.LEFT b.dir, redraw := DIR.RIGHT, TRUE TRUE b.dir, target.dir := DIR.RIGHT, 2 #1B --{{{ could be cursor-key SEQ kyb ? key IF key = #5B SEQ kyb ? key CASE key #44 -- left IF b.dir = DIR.RIGHT b.dir, redraw := DIR.LEFT, TRUE TRUE b.dir, target.dir := DIR.LEFT, 0 #41 -- up IF b.dir = DIR.DOWN b.dir, redraw := DIR.UP, TRUE TRUE b.dir, target.dir := DIR.UP, 1 #43 -- right IF b.dir = DIR.LEFT b.dir, redraw := DIR.RIGHT, TRUE TRUE b.dir, target.dir := DIR.RIGHT, 2 #42 -- down IF b.dir = DIR.UP b.dir, redraw := DIR.DOWN, TRUE TRUE b.dir, target.dir := DIR.DOWN, 3 ELSE SKIP TRUE SKIP --}}} ELSE SKIP --}}} --{{{ check target direction if any PROC local.reserve (VAL BYTE x1, y1, x2, y2) SEQ claim.semaphore (c.sem) c.req ! region.reserve; x1; y1; x2; y2 c.rep ? CASE region.reply; reserved release.semaphore (c.sem) : CASE target.dir 0 --{{{ want to go left local.reserve (b.x - 1, b.y, b.x - 1, b.y + (buggy.height - 1)) --}}} 1 --{{{ want to go up local.reserve (b.x, b.y - 1, b.x + (buggy.width - 1), b.y - 1) --}}} 2 --{{{ want to go right local.reserve (b.x + buggy.width, b.y, b.x + buggy.width, b.y + (buggy.height - 1)) --}}} 3 --{{{ want to go down local.reserve (b.x, b.y + buggy.height, b.x + (buggy.width - 1), b.y + buggy.height) --}}} ELSE SKIP --}}} --{{{ if reserved, claim new space IF reserved PROC local.set (VAL BYTE x1, y1, x2, y2) SEQ claim.semaphore (c.sem) c.req ! region.set; x1; y1; x2; y2 release.semaphore (c.sem) : CASE target.dir 0 --{{{ going left SEQ local.set (b.x - 1, b.y, b.x - 1, b.y + (buggy.height - 1)) b.x := b.x - 1 redraw := TRUE --}}} 1 --{{{ going up SEQ local.set (b.x, b.y - 1, b.x + (buggy.width - 1), b.y - 1) b.y := b.y - 1 redraw := TRUE --}}} 2 --{{{ going right SEQ local.set (b.x + buggy.width, b.y, b.x + buggy.width, b.y + (buggy.height - 1)) b.x := b.x + 1 redraw := TRUE --}}} 3 --{{{ going down SEQ local.set (b.x, b.y + buggy.height, b.x + (buggy.width - 1), b.y + buggy.height) b.y := b.y + 1 redraw := TRUE --}}} TRUE SKIP --}}} --{{{ if firing, dispatch projectile IF fire BYTE attr: SEQ IF player = 0 attr := ANSI.FG.GREEN TRUE attr := ANSI.FG.RED CASE b.dir DIR.LEFT b.out ! b.x - 1; b.y + (buggy.height - 1); 0; attr DIR.UP b.out ! b.x + (buggy.width / 2); b.y - 1; 1; attr DIR.RIGHT b.out ! b.x + buggy.width; b.y + (buggy.height - 1); 2; attr DIR.DOWN b.out ! b.x + (buggy.width / 2); b.y + buggy.height; 3; attr p.outstanding := p.outstanding + 1 TRUE SKIP --}}} --{{{ re-draw buggy if needed IF redraw --{{{ redraw buggy SEQ claim.semaphore (out.sem) out ! colour; ANSI.FG.CYAN SEQ i = 0 FOR INT buggy.height out ! string.x.y; b.x; b.y + (BYTE i); buggy.width::buggy[player][b.dir][i] release.semaphore (out.sem) --}}} TRUE SKIP --}}} --{{{ if reserved, clear and free old space IF reserved PROC local.clear (VAL BYTE x1, y1, x2, y2) SEQ claim.semaphore (out.sem) IF x1 = x2 SEQ y = INT y1 FOR INT ((y2 - y1) + 1) out ! char.x.y; x1; BYTE y; ' ' TRUE out ! string.x.y; x1; y1; ((x2 - x1) + 1)::" " release.semaphore (out.sem) claim.semaphore (c.sem) c.req ! region.clear; x1; y1; x2; y2 release.semaphore (c.sem) : CASE target.dir 0 --{{{ clear bit on right local.clear (b.x + buggy.width, b.y, b.x + buggy.width, b.y + (buggy.height - 1)) --}}} 1 --{{{ clear bit on bottom local.clear (b.x, b.y + buggy.height, b.x + (buggy.width - 1), b.y + buggy.height) --}}} 2 --{{{ clear bit on left local.clear (b.x - 1, b.y, b.x - 1, b.y + (buggy.height - 1)) --}}} 3 --{{{ clear bit on top local.clear (b.x, b.y - 1, b.x + (buggy.width - 1), b.y - 1) --}}} TRUE SKIP --}}} --}}} seconds.left := seconds.left - 1 --}}} in.game := 3 3 SEQ --{{{ notify about game-over TIMER tim: INT t: SEQ tim ? t claim.semaphore (out.sem) out ! colour; ANSI.FG.CYAN SEQ i = 0 FOR INT buggy.height out ! string.x.y; b.x; b.y + (BYTE i); buggy.width::buggy[player][b.dir + 4][i] out ! string.x.y; game.if.points[player][0] + 1; game.if.points[player][1]; 8::"- GAME -" release.semaphore (out.sem) tim ? AFTER (t PLUS 2000000) t := t PLUS 4000000 claim.semaphore (out.sem) out ! colour; ANSI.FG.CYAN out ! string.x.y; game.if.points[player][0] + 1; game.if.points[player][1]; 8::"- OVER -" release.semaphore (out.sem) tim ? AFTER t --}}} --{{{ collect remaining projectile status's WHILE p.outstanding > 0 SEQ INT any: b.in ? any p.outstanding := p.outstanding - 1 --}}} --{{{ soak up any keys INITIAL BOOL nowt IS FALSE: WHILE NOT nowt PRI ALT BYTE any: kyb ? any SKIP TRUE & SKIP nowt := TRUE --}}} in.game := 4 4 SEQ --{{{ remove buggy from screen claim.semaphore (out.sem) SEQ i = 0 FOR INT buggy.height out ! string.x.y; b.x; b.y + (BYTE i); buggy.width::" " release.semaphore (out.sem) --}}} --{{{ remove from board claim.semaphore (c.sem) c.req ! region.clear; b.x; b.y; b.x + (buggy.width - 1); b.y + (buggy.height - 1) release.semaphore (c.sem) --}}} in.game := 0 ELSE STOP --}}} : --}}} --{{{ PROC display (...) PROC display (CHAN SPROTO in?, CHAN BYTE out!) INITIAL BYTE last.colour IS ANSI.FG.WHITE: WHILE TRUE PRI ALT in ? CASE --{{{ colour BYTE c: colour; c IF c <> last.colour SEQ out.string ("*#1B[", 0, out!) out.byte (c, 0, out!) out.string ("m*#FF", 0, out!) last.colour := c TRUE SKIP --}}} --{{{ clear.screen clear.screen out.string ("*#1B[2J*#FF", 0, out!) --}}} --{{{ string.x.y BYTE x, y, len: [255]BYTE data: string.x.y; x; y; len::data SEQ cursor.x.y (x, y, out!) out.string ([data FOR (INT len)], 0, out!) out ! #FF --}}} --{{{ int.x.y BYTE x, y: INT v: int.x.y; x; y; v SEQ cursor.x.y (x, y, out!) out.int (v, 0, out!) out ! #FF --}}} --{{{ char.x.y BYTE x, y, ch: char.x.y; x; y; ch SEQ cursor.x.y (x, y, out!) out ! ch out ! #FF --}}} --{{{ sprite.x.y BYTE x, y: INT spr: sprite.x.y; x; y; spr SEQ cursor.x.y (x, y, out!) out.string (sprites[spr], 0, out!) out ! #FF --}}} (last.colour <> ANSI.FG.WHITE) & SKIP SEQ out.string ("*#1B[37m*#FF", 0, out!) last.colour := ANSI.FG.WHITE : --}}} --{{{ PROC collision.detector (...) PROC collision.detector (CHAN COLL.REQ in?, CHAN COLL.REP out!, CHAN SPROTO disp.chan!, SEMAPHORE disp.sem) VAL INT scr.width IS (INT (screen.points[2] - screen.points[0])) + 1: VAL INT scr.height IS (INT (screen.points[3] - screen.points[1])) + 1: [scr.height][scr.width]BYTE array: -- the "array" is BYTEs for each location: -- #80 invalid/scenary -- #40 reserved by sprite -- #20 space occupied by sprite -- #1F sprite number [MAX.SPRITES][2]BYTE spr.xy: VAL BOOL DEBUG.COLL IS FALSE: SEQ --{{{ clear array SEQ y = 0 FOR scr.height SEQ x = 0 FOR scr.width array[y][x] := #00 --}}} --{{{ put in invalid regions SEQ z = 0 FOR SIZE bad.regions VAL INT region.x IS INT (bad.regions[z][0]): VAL INT region.y IS INT (bad.regions[z][1]): VAL INT region.width IS INT ((bad.regions[z][2] - bad.regions[z][0]) + 1): VAL INT region.height IS INT ((bad.regions[z][3] - bad.regions[z][1]) + 1): SEQ y = (region.y - 1) FOR region.height SEQ x = (region.x - 1) FOR region.width SEQ array[y][x] := #80 claim.semaphore (disp.sem) -- disp.chan ! char.x.y; BYTE (x + 1); BYTE (y + 1); 'R' release.semaphore (disp.sem) --}}} --{{{ clear sprite positions SEQ i = 0 FOR MAX.SPRITES spr.xy[i] := [0, 0] --}}} --{{{ loop processing stuff BYTE FUNCTION id.to.ar (VAL BYTE id) IS ((id /\ #1F) \/ #20): WHILE TRUE in ? CASE --{{{ initialise sprite BYTE x, y, id: init.sprite; x; y; id VAL INT ar.x IS INT (x - 1): VAL INT ar.y IS INT (y - 1): SEQ array[ar.y][ar.x] := id.to.ar (id) array[ar.y][ar.x + 1] := id.to.ar (id) spr.xy[INT id] := [BYTE ar.x, BYTE ar.y] --{{{ DEBUG IF DEBUG.COLL SEQ claim.semaphore (disp.sem) disp.chan ! char.x.y; BYTE (ar.x + 1); BYTE (ar.y + 1); 'I' disp.chan ! char.x.y; BYTE (ar.x + 2); BYTE (ar.y + 1); 'I' release.semaphore (disp.sem) TRUE SKIP --}}} --}}} --{{{ clear sprite BYTE x, y, id: clear.sprite; x; y; id VAL INT ar.x IS INT (x - 1): VAL INT ar.y IS INT (y - 1): SEQ array[ar.y][ar.x] := #00 array[ar.y][ar.x + 1] := #00 spr.xy[INT id] := [0, 0] --}}} --{{{ reserve region BYTE x1, y1, x2, y2: region.reserve; x1; y1; x2; y2 VAL INT ar.x IS (INT x1) - 1: VAL INT ar.y IS (INT y1) - 1: VAL INT ar.width IS INT ((x2 - x1) + 1): VAL INT ar.height IS INT ((y2 - y1) + 1): BOOL can.reserve: SEQ --{{{ check availability IF (ar.y < 0) OR ((ar.y + ar.height) >= scr.height) can.reserve := FALSE (ar.x < 0) OR ((ar.x + ar.width) >= scr.width) can.reserve := FALSE IF y = ar.y FOR ar.height IF x = ar.x FOR ar.width array[y][x] <> #00 can.reserve := FALSE TRUE SEQ can.reserve := TRUE SEQ y = ar.y FOR ar.height SEQ x = ar.x FOR ar.width array[y][x] := #40 --}}} --{{{ reply out ! region.reply; can.reserve --}}} --}}} --{{{ region set (sets to #80 -- invalid scenary type) BYTE x1, y1, x2, y2: region.set; x1; y1; x2; y2 VAL INT ar.x IS INT (x1 - 1): VAL INT ar.y IS INT (y1 - 1): VAL INT ar.width IS INT ((x2 - x1) + 1): VAL INT ar.height IS INT ((y2 - y1) + 1): SEQ y = ar.y FOR ar.height SEQ x = ar.x FOR ar.width array[y][x] := #80 --}}} --{{{ region clear (sets to #00 -- open space type) BYTE x1, y1, x2, y2: region.clear; x1; y1; x2; y2 VAL INT ar.x IS INT (x1 - 1): VAL INT ar.y IS INT (y1 - 1): VAL INT ar.width IS INT ((x2 - x1) + 1): VAL INT ar.height IS INT ((y2 - y1) + 1): SEQ y = ar.y FOR ar.height SEQ x = ar.x FOR ar.width array[y][x] := #00 --}}} --{{{ query BYTE x, y: query.x.y; x; y VAL INT ar.x IS (INT x) - 1: VAL INT ar.y IS (INT y) - 1: SEQ IF ((ar.x < 0) OR (ar.y < 0)) OR ((ar.x >= scr.width) OR (ar.y >= scr.height)) out ! query.reply; #FF TRUE out ! query.reply; array[ar.y][ar.x] --}}} --{{{ reserve location for possible move BYTE x, y, id: reserve.x.y; x; y; id VAL INT ar.x IS (INT x) - 1: VAL INT ar.y IS (INT y) - 1: [4]BYTE result: -- possibly locations are left, right, up and down INITIAL INT i IS 0: SEQ --{{{ can go left ? IF (ar.x > 0) AND (array[ar.y][ar.x - 1] = 0) SEQ result[i] := 0 i := i + 1 array[ar.y][ar.x - 1] := #40 --{{{ DEBUG IF DEBUG.COLL SEQ claim.semaphore (disp.sem) disp.chan ! char.x.y; BYTE ar.x; BYTE (ar.y + 1); 'R' release.semaphore (disp.sem) TRUE SKIP --}}} TRUE SKIP --}}} --{{{ can go up ? IF (ar.y > 0) AND ((array[ar.y - 1][ar.x] = 0) AND (array[ar.y - 1][ar.x + 1] = 0)) SEQ result[i] := 1 i := i + 1 array[ar.y - 1][ar.x] := #40 array[ar.y - 1][ar.x + 1] := #40 --{{{ DEBUG IF DEBUG.COLL SEQ claim.semaphore (disp.sem) disp.chan ! char.x.y; BYTE (ar.x + 1); BYTE ar.y; 'R' disp.chan ! char.x.y; BYTE (ar.x + 2); BYTE ar.y; 'R' release.semaphore (disp.sem) TRUE SKIP --}}} TRUE SKIP --}}} --{{{ can go right ? IF (ar.x < (scr.width - 2)) AND (array[ar.y][ar.x + 2] = 0) SEQ result[i] := 2 i := i + 1 array[ar.y][ar.x + 2] := #40 --{{{ DEBUG IF DEBUG.COLL SEQ claim.semaphore (disp.sem) disp.chan ! char.x.y; BYTE (ar.x + 3); BYTE (ar.y + 1); 'R' release.semaphore (disp.sem) TRUE SKIP --}}} TRUE SKIP --}}} --{{{ can go down ? IF (ar.y < (scr.height - 2)) AND ((array[ar.y + 1][ar.x] = 0) AND (array[ar.y + 1][ar.x + 1] = 0)) SEQ result[i] := 3 i := i + 1 array[ar.y + 1][ar.x] := #40 array[ar.y + 1][ar.x + 1] := #40