123 lines
3.2 KiB
Plaintext
123 lines
3.2 KiB
Plaintext
CO
|
|
Wireworld implementation.
|
|
CO
|
|
|
|
PROC exception = ([]STRING args)VOID:(
|
|
putf(stand error, ($"Exception"$, $", "g$, args, $l$));
|
|
stop
|
|
);
|
|
|
|
PROC assertion error = (STRING message)VOID:exception(("assertion error", message));
|
|
|
|
MODE CELL = CHAR;
|
|
MODE WORLD = FLEX[0, 0]CELL;
|
|
CELL head="H", tail="t", conductor=".", empty = " ";
|
|
STRING all states := empty;
|
|
|
|
BOOL wrap = FALSE; # is the world round? #
|
|
|
|
STRING nl := REPR 10;
|
|
|
|
STRING in string :=
|
|
"tH........."+nl+
|
|
". ."+nl+
|
|
" ..."+nl+
|
|
". ."+nl+
|
|
"Ht.. ......"+nl
|
|
;
|
|
|
|
OP +:= = (REF FLEX[]FLEX[]CELL lines, FLEX[]CELL line)VOID:(
|
|
[UPB lines + 1]FLEX[0]CELL new lines;
|
|
new lines[:UPB lines]:=lines;
|
|
lines := new lines;
|
|
lines[UPB lines]:=line
|
|
);
|
|
|
|
PROC read file = (REF FILE in file)WORLD: (
|
|
# file > initial world configuration" #
|
|
FLEX[0]CELL line;
|
|
FLEX[0]FLEX[0]CELL lines;
|
|
INT upb x:=0, upb y := 0;
|
|
BEGIN
|
|
# on physical file end(in file, exit read line); #
|
|
make term(in file, nl);
|
|
FOR x TO 5 DO
|
|
get(in file, (line, new line));
|
|
upb x := x;
|
|
IF UPB line > upb y THEN upb y := UPB line FI;
|
|
lines +:= line
|
|
OD;
|
|
exit read line: SKIP
|
|
END;
|
|
[upb x, upb y]CELL out;
|
|
FOR x TO UPB out DO
|
|
out[x,]:=lines[x]+" "*(upb y-UPB lines[x])
|
|
OD;
|
|
out
|
|
);
|
|
|
|
PROC new cell = (WORLD current world, INT x, y)CELL: (
|
|
CELL istate := current world[x, y];
|
|
IF INT pos; char in string (istate, pos, all states); pos IS REF INT(NIL) THEN
|
|
assertion error("Wireworld cell set to unknown value "+istate) FI;
|
|
IF istate = head THEN
|
|
tail
|
|
ELIF istate = tail THEN
|
|
conductor
|
|
ELIF istate = empty THEN
|
|
empty
|
|
ELSE # istate = conductor #
|
|
[][]INT dxy list = ( (-1,-1), (-1,+0), (-1,+1),
|
|
(+0,-1), (+0,+1),
|
|
(+1,-1), (+1,+0), (+1,+1) );
|
|
INT n := 0;
|
|
FOR enum dxy TO UPB dxy list DO
|
|
[]INT dxy = dxy list[enum dxy];
|
|
IF wrap THEN
|
|
INT px = ( x + dxy[1] - 1 ) MOD 1 UPB current world + 1;
|
|
INT py = ( y + dxy[2] - 1 ) MOD 2 UPB current world + 1;
|
|
n +:= ABS (current world[px, py] = head)
|
|
ELSE
|
|
INT px = x + dxy[1];
|
|
INT py = y + dxy[2];
|
|
IF px >= 1 LWB current world AND px <= 1 UPB current world AND
|
|
py >= 2 LWB current world AND py <= 2 UPB current world THEN
|
|
n +:= ABS (current world[px, py] = head)
|
|
FI
|
|
FI
|
|
OD;
|
|
IF 1 <= n AND n <= 2 THEN head ELSE conductor FI
|
|
FI
|
|
);
|
|
|
|
PROC next gen = (WORLD world)WORLD:(
|
|
# compute next generation of wireworld #
|
|
WORLD new world := world;
|
|
FOR x TO 1 UPB world DO
|
|
FOR y TO 2 UPB world DO
|
|
new world[x,y] := new cell(world, x, y)
|
|
OD
|
|
OD;
|
|
new world
|
|
);
|
|
|
|
PROC world2string = (WORLD world) STRING:(
|
|
STRING out:="";
|
|
FOR x TO UPB world DO
|
|
out +:= world[x,]+nl
|
|
OD;
|
|
out
|
|
);
|
|
|
|
FILE in file;
|
|
associate(in file, in string);
|
|
|
|
WORLD ww := read file(in file);
|
|
close(in file);
|
|
|
|
FOR gen TO 10 DO
|
|
printf ( ($lg(-3)" "$, gen-1, $g$,"="* (2 UPB ww-4), $l$));
|
|
print ( world2string(ww) );
|
|
ww := next gen(ww)
|
|
OD
|