-- -- matrix.occ -- matrix-style thingie -- Copyright (C) 2001 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. -- --{{{ includes, protocols, consts #INCLUDE "consts.inc" #USE "course.lib" #INCLUDE "semaphore.inc" #INCLUDE "crew.inc" VAL BYTE COLOUR.FG.GREEN IS 32: VAL BYTE COLOUR.FG.WHITE IS 37: VAL BYTE COLOUR.WHATEVER IS #FF: PROTOCOL SCREEN.PROTO CASE clear char.xy.col; BYTE; BYTE; BYTE; BYTE -- char, x, y, colour int; INT -- num : VAL INT min.wait IS 10000: VAL INT max.wait IS 300000: --}}} --{{{ PROC get.screen.dimensions (RESULT INT x, y) -- Gets the terminal/screen dimensions through the LINES -- and COLUMNS environment vars. Set to -1 on error. -- One of these days I'll do ncurses.. PROC get.screen.dimensions (RESULT INT x, y) #INCLUDE "hostio.inc" #USE "hostio.lib" #USE "convert.lib" PROC env.to.int (VAL []BYTE env, RESULT INT v, RESULT BOOL ok) VAL INT maxvalsize IS 8: [maxvalsize]BYTE buf: INITIAL INT buflen IS maxvalsize: BYTE res: CHAN OF SP fs, ts: -- dummy channels SEQ so.getenv (fs?, ts!, env, buflen, buf, res) IF res <> spr.ok v, ok := (-1), FALSE TRUE SEQ STRINGTOINT (ok, v, [buf FOR buflen]) ok := NOT ok -- actually "error" in STRINGTOINT : BOOL ok: SEQ env.to.int ("COLUMNS", x, ok) IF NOT ok SEQ x := (-1) y := (-1) TRUE SEQ env.to.int ("LINES", y, ok) IF NOT ok x, y := (-1), (-1) TRUE SKIP : --}}} --{{{ PROC matrix.line (VAL INT t.range, x, height, CHAN SCREEN.PROTO out, SEMAPHORE out.sem, INT t.wait, CREW t.wait.crew) INT FUNCTION gen.seed (VAL INT time) IS ((time >> 2) + 1): TIMER tim: INT t, seed: VAL INT num.chars IS 128: [num.chars]BYTE chars: INT orig.base, t.base: BOOL is.white: SEQ claim.read.crew (t.wait.crew) orig.base := t.wait t.base := t.wait release.read.crew (t.wait.crew) --{{{ staggered read-timer SEQ claim.semaphore (out.sem) tim ? t tim ? AFTER (t PLUS 1000) t := t PLUS (x TIMES 913) release.semaphore (out.sem) --}}} seed := gen.seed (t) --{{{ generate random characters VAL INT char.range IS 94: VAL BYTE char.base IS '!': SEQ i = 0 FOR num.chars INT v: SEQ v, seed := random (char.range, seed) chars[i] := char.base PLUS (BYTE v) --}}} tim ? t seed := gen.seed (t) --{{{ per-thingie time-base INT n.base: SEQ n.base, seed := random (orig.base / 2, seed) t.base := (orig.base / 3) + n.base IF t.base < min.wait t.base := min.wait t.base > max.wait t.base := max.wait TRUE SKIP --}}} --{{{ 2/3'rds chance of being white IF (seed \ 3) = 0 is.white := TRUE TRUE is.white := FALSE --}}} INITIAL BYTE y IS 1: INITIAL BYTE x IS BYTE x: INITIAL BYTE height IS BYTE height: INITIAL INT c.pos IS (seed \ num.chars): INITIAL BYTE tail.size IS #FF: WHILE TRUE INT v: SEQ --{{{ wait random amount of time SEQ v, seed := random (t.range + 1, seed) tim ? t t := (t PLUS (t.base + v)) tim ? AFTER t claim.read.crew (t.wait.crew) orig.base := t.wait release.read.crew (t.wait.crew) --}}} --{{{ new tail size if needed IF tail.size = #FF INT new.tail: SEQ new.tail, seed := random (((INT height) / 3), seed) new.tail := new.tail + ((INT height) / 3) tail.size := (BYTE new.tail) TRUE SKIP --}}} --{{{ update screen SEQ claim.semaphore (out.sem) --{{{ green-ify old char ? IF (y >= 1) AND (y <= height) out ! char.xy.col; chars[c.pos]; x; y; COLOUR.FG.GREEN TRUE SKIP --}}} --{{{ erase tail char ? IF y > tail.size out ! char.xy.col; ' '; x; (y - tail.size); COLOUR.WHATEVER (y + height) > tail.size out ! char.xy.col; ' '; x; ((y + height) - tail.size); COLOUR.WHATEVER TRUE SKIP --}}} c.pos := (c.pos + 1) \ num.chars y := y + 1 --{{{ new char ? IF y > height SEQ y := 1 --{{{ 1/3'rd chance of being white IF (seed \ 3) = 0 is.white := TRUE TRUE is.white := FALSE --}}} --{{{ per-thingie time-base INT n.base: SEQ n.base, seed := random ((orig.base / 2), seed) t.base := (orig.base / 3) + n.base IF t.base < min.wait t.base := min.wait t.base > max.wait t.base := max.wait TRUE SKIP --}}} is.white VAL BYTE ch IS chars[c.pos]: out ! char.xy.col; ch; x; y; COLOUR.FG.WHITE TRUE SKIP --}}} release.semaphore (out.sem) --}}} : --}}} --{{{ PROC matrix.screen (CHAN SCREEN.PROTO in?, CHAN BYTE out!, CHAN BOOL pause?) INITIAL BYTE x IS 1: INITIAL BYTE y IS 1: INITIAL BYTE colour IS COLOUR.FG.WHITE: SEQ cursor.invisible (out!) cursor.x.y (x, y, out!) erase.screen (out!) out ! FLUSH WHILE TRUE PRI ALT BOOL any: pause ? any pause ? any in ? CASE --{{{ clear screen clear erase.screen (out!) --}}} --{{{ char.xy.col BYTE ch, ix, iy, icol: char.xy.col; ch; ix; iy; icol SEQ IF (ix <> (x + 1)) OR (y <> iy) cursor.x.y (ix, iy, out!) TRUE SKIP x, y := ix, iy IF ((icol <> COLOUR.WHATEVER) AND (icol <> colour)) SEQ colour := icol out ! ESCAPE out ! '[' out.byte (colour, 0, out!) out ! 'm' TRUE SKIP out ! ch out ! FLUSH --}}} --{{{ int INT v: int; v SEQ out.string (" [", 0, out!) out.int (v, 0, out!) out.string ("] ", 0, out!) out ! FLUSH --}}} : --}}} --{{{ PROC matrix.keyboard (CHAN BYTE in?, err!, INT t.wait, CREW t.wait.crew, CHAN BOOL pause!) INT i.wait: SEQ SETPRI (0) claim.read.crew (t.wait.crew) i.wait := t.wait release.read.crew (t.wait.crew) WHILE TRUE BYTE b: in ?? b SEQ IF b = '.' i.wait := i.wait + 10000 b = ',' i.wait := i.wait - 10000 b = 'f' pause ! TRUE TRUE err ! BELL IF i.wait < min.wait SEQ err ! BELL i.wait := min.wait i.wait > max.wait SEQ err ! BELL i.wait := max.wait TRUE SKIP claim.write.crew (t.wait.crew) t.wait := i.wait release.write.crew (t.wait.crew) : --}}} --{{{ PROC matrix.network (VAL INT width, height, CHAN BYTE in?, out!, err!) CHAN SCREEN.PROTO s.chan: CHAN BOOL pause: PAR SEQ SETPRI (1) matrix.screen (s.chan?, out!, pause?) --{{{ lots of little processes SEMAPHORE s.sem: #PRAGMA SHARED s.sem CHAN SCREEN.PROTO s.chan! IS s.chan!: #PRAGMA SHARED s.chan INT t.wait: #PRAGMA SHARED t.wait CREW t.wait.crew: #PRAGMA SHARED t.wait.crew SEQ t.wait := 100000 initialise.crew (t.wait.crew) initialise.semaphore (s.sem, 1) PAR matrix.keyboard (in?, err!, t.wait, t.wait.crew, pause!) SEQ SETPRI (2) PAR x = 1 FOR (width / 2) STEP 2 matrix.line (1000, x, height, s.chan!, s.sem, t.wait, t.wait.crew) SEQ SETPRI (31) WHILE TRUE RESCHEDULE () --}}} : --}}} --{{{ PROC matrix (CHAN BYTE kyb?, scr!, err!) PROC matrix (CHAN BYTE kyb?, scr!, err!) INT x.dim, y.dim: SEQ --{{{ get screen dimensions get.screen.dimensions (x.dim, y.dim) IF (x.dim < 0) OR (y.dim < 0) SEQ out.string ("please set the LINES and COLUMNS environment vars.*n", 0, err!) RESCHEDULE () STOP TRUE SKIP --}}} --{{{ info SEQ out.string ("screen is ", 0, scr!) out.int (x.dim, 0, scr!) out.string (" by ", 0, scr!) out.int (y.dim, 0, scr!) out.string (" chars.*n", 0, scr!) --}}} --{{{ do it! matrix.network (x.dim, y.dim, kyb?, scr!, err!) --}}} : --}}}