forked from KolibriOS/kolibrios
2f54c7de00
git-svn-id: svn://kolibrios.org@8097 a494cfbc-eb01-0410-851d-a64ba20cac60
222 lines
9.0 KiB
Plaintext
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.
|
|
|