ruberon/samples/linux/x11/filler.ob07

MODULE filler;          (* filler game, color more fields than the opponent *)

IMPORT

    SYSTEM,
    out IN "./common/out.ob07",
    unix IN "./common/unix.ob07",
    gr IN "./common/gr.ob07";


CONST
        Side = 11;      (* 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 (800, 600);
        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.