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.