kolibrios/programs/develop/oberon07/Samples/Linux/X11/filler/filler.ob07
maxcodehack 2f54c7de00 Update oberon07 from akron1's github
git-svn-id: svn://kolibrios.org@8097 a494cfbc-eb01-0410-851d-a64ba20cac60
2020-10-13 07:58:51 +00:00

222 lines
9.0 KiB
Plaintext

MODULE filler; (* filler game, color more fields than the opponent *)
IMPORT SYSTEM, out, unix, gr;
CONST
Side = 14; (* nr of pixels of a field side *)
width = 62; height = 48; (* board size *)
nrFields = width * height;
BackGroundColor = 0B0B050H;
VAR fdRandom :INTEGER; (* /dev/urandom *)
base, stride, screenBufSize :INTEGER;
palette :ARRAY 6 OF INTEGER;
field :ARRAY nrFields OF INTEGER; (* color 0..5 *)
visit :ARRAY nrFields OF INTEGER; (* 0 unvisited, 1 neighbour to do, 2 done *)
Acount, Acolor, Bcount, Bcolor :INTEGER; (* player conquered fields and current color *)
rndSeed, rndIndex :INTEGER;
PROCEDURE check (b :BOOLEAN; n :INTEGER);
BEGIN
IF ~b THEN
out.formatInt ("internal check failed: filler.mod: %", n); out.nl;
out.exit(1)
END
END check;
PROCEDURE random6 () :INTEGER; (* return random 0..5 *)
VAR n :INTEGER;
b :BYTE;
BEGIN
IF rndIndex = 3 THEN
(* 6 ^ 3 = 216 so 3 random6 nrs fit in one random byte, don't waste entropy *)
n := unix.readByte (fdRandom, b); ASSERT (n = 1);
rndSeed := b; rndIndex := 0;
END;
n := rndSeed MOD 6; rndSeed := rndSeed DIV 6; INC (rndIndex)
RETURN n
END random6;
PROCEDURE drawRect (x, y, color :INTEGER);
VAR p, i, j :INTEGER;
BEGIN
p := (y*stride + x*4)*Side;
check (p + (Side-1)*stride + (Side-1)*4 <= screenBufSize, 20);
p := base + p;
FOR j := 0 TO Side-1 DO
FOR i := 0 TO Side-1 DO SYSTEM.PUT32 (p, color); INC(p, 4) END;
p := p + stride - Side*4;
END;
END drawRect;
PROCEDURE clearVisit;
VAR i :INTEGER;
BEGIN FOR i := 0 TO nrFields-1 DO visit[i] := 0 END; END clearVisit;
PROCEDURE doNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN);
(* helper routine for connect() *)
BEGIN
IF visit[i] = 0 THEN
IF (v = 1) & (field[i] = old) THEN visit[i] := 1; changed := TRUE END;
IF field[i] = new THEN visit[i] := 2; changed := TRUE END
END
END doNeighbour;
(*
all visit := 0; count := 0; visit[corner] := 1
repeat
changed := false;
foreach:
if (visit = 1) or (visit = 2) then
curVisit = visit
color := new; visit := 3; count++
foreach neighbour:
if visit = 0 then
if curVisit = 1 then
if color = old then visit := 1; changed := true
if color = new then visit := 2; changed := true
if curVisit = 2 then
if color = new then visit := 2; changed := true
until no changes
*)
PROCEDURE connect (old, new :INTEGER) :INTEGER;
VAR count, i, x, y, v :INTEGER;
changed :BOOLEAN;
BEGIN
out.formatInt2 ("connect: old new % % ", old+1, new+1);
count := 0;
REPEAT
changed := FALSE;
FOR i := 0 TO nrFields-1 DO
v := visit[i];
IF (v=1) OR (v=2) THEN
field[i] := new; visit[i] := 3; INC(count);
x := i MOD width; y := i DIV width;
IF x > 0 THEN doNeighbour (i-1, old, new, v, changed) END;
IF x < width-1 THEN doNeighbour (i+1, old, new, v, changed) END;
IF y > 0 THEN doNeighbour (i-width, old, new, v, changed) END;
IF y < height-1 THEN doNeighbour (i+width, old, new, v, changed) END;
END
END
UNTIL ~changed
RETURN count
END connect;
PROCEDURE doMaxGainNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN);
(* helper routine for maxGain() *)
BEGIN
IF visit[i] = 0 THEN
IF v = 1 THEN
IF field[i] = old THEN visit[i] := 1 ELSE visit[i] := 2 END;
changed := TRUE
ELSE
IF field[i] = new THEN visit[i] := 2; changed := TRUE END
END
END
END doMaxGainNeighbour;
(* v=1 & field=old -> visit := 1
v=1 & field # old -> visit := 2
v=2 & field = new -> visit := 2
*)
PROCEDURE maxGain (old :INTEGER) :INTEGER;
(* return the color which will conquer the most fields *)
VAR
i, x, y, new, v :INTEGER;
max :ARRAY 6 OF INTEGER;
changed :BOOLEAN;
BEGIN
FOR i := 0 TO 5 DO max[i] := 0 END;
REPEAT
changed := FALSE;
FOR i := 0 TO nrFields-1 DO
v := visit[i];
IF (v=1) OR (v=2) THEN
visit[i] := 3; new := field[i]; INC (max[new]);
x := i MOD width; y := i DIV width;
IF x > 0 THEN doMaxGainNeighbour (i-1, old, new, v, changed) END;
IF x < width-1 THEN doMaxGainNeighbour (i+1, old, new, v, changed) END;
IF y > 0 THEN doMaxGainNeighbour (i-width, old, new, v, changed) END;
IF y < height-1 THEN doMaxGainNeighbour (i+width, old, new, v, changed) END;
END
END
UNTIL ~changed;
x := -1; y := -1; max[Acolor] := -1; max[Bcolor] := -1;
out.str ("maxGain"); out.nl;
FOR i := 0 TO 5 DO out.formatInt2 (" % %", i+1, max[i]); out.nl END;
FOR i := 0 TO 5 DO IF (max[i] > y) & (i # old) THEN x := i; y := max[i] END END
RETURN x
END maxGain;
PROCEDURE drawAll;
VAR x, y :INTEGER;
BEGIN
gr.screenBegin;
gr.clear (BackGroundColor);
FOR y := 0 TO 5 DO drawRect (0, 6 + y DIV 3 + 2*y, palette[y]) END;
FOR y := 0 TO 47 DO
FOR x := 0 TO 61 DO drawRect (x+2, y, palette[ field[y*width + x] ]) END
END;
gr.screenEnd;
END drawAll;
PROCEDURE run*;
VAR stop :BOOLEAN;
ev :gr.EventPars;
x, y, i, old :INTEGER;
ch :CHAR;
BEGIN
FOR i := 0 TO nrFields-1 DO field[i] := random6() END;
Acolor := field[47*width]; field[47*width+1] := Acolor; field[46*width] := Acolor; field[46*width+1] := Acolor;
Bcolor := field[width-1]; field[width-2] := Bcolor; field[2*width-2] := Bcolor; field[2*width-1] := Bcolor;
base := gr.base; stride := gr.stride;
gr.createWindow (1000, 700);
screenBufSize := gr.winHeight * stride;
stop := FALSE;
drawAll;
REPEAT
gr.nextEvent (0, ev);
IF ev[0] = gr.EventKeyPressed THEN
(* o.formatInt("key pressed %",ev[2]);o.nl; *)
(* ev[2]: q=24, ESC=9, CR=36 *)
ch := CHR (ev[4]);
IF ev[2] = 9 THEN stop := TRUE END; (* ESC *)
(* IF ch = "q" THEN stop := TRUE END; *)
IF (ch >= "1") & (ch <= "6") THEN
i := ev[4] - ORD("1");
IF (i # Acolor) & (i # Bcolor) THEN
(* player A *)
old := Acolor; Acolor := i;
out.formatInt ("play color %", Acolor+1); out.nl;
clearVisit; visit[47*width] := 1;
Acount := connect (old, Acolor)
;out.formatInt ("count A = %", Acount); out.nl; out.nl;
(* player B *)
clearVisit; visit[width-1] := 1; old := field[width-1];
Bcolor := maxGain (old);
clearVisit; visit[width-1] := 1;
Bcount := connect (old, Bcolor);
out.formatInt ("count B = %", Bcount); out.nl; out.nl;
drawAll;
END
END;
ELSIF ev[0] = gr.EventButtonPressed THEN
x := ev[2] DIV Side; y := ev[3] DIV Side;
END;
UNTIL stop;
gr.finish;
unix.finish;
END run;
BEGIN
fdRandom := unix.open ("/dev/urandom", unix.O_RDONLY, 0); ASSERT (fdRandom # -1);
rndIndex := 3;
(* a partial copy of the lexaloffle pico-8 16-color palette *)
palette[0] := 0FF004DH; (* red *)
palette[1] := 0FFA300H; (* orange *)
palette[2] := 07E2553H; (* dark purple *)
palette[3] := 0008751H; (* dark green *)
palette[4] := 029ADFFH; (* blue *)
palette[5] := 0FF77A8H; (* pink *)
run;
END filler.