Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. MODULE filler;          (* filler game, color more fields than the opponent *)
  2. IMPORT SYSTEM, out, unix, gr;
  3.  
  4. CONST
  5.         Side = 14;      (* nr of pixels of a field side *)
  6.         width = 62; height = 48;        (* board size *)
  7.         nrFields = width * height;
  8.         BackGroundColor = 0B0B050H;
  9.  
  10. VAR fdRandom :INTEGER;  (* /dev/urandom *)
  11.         base, stride, screenBufSize :INTEGER;
  12.         palette :ARRAY 6 OF INTEGER;
  13.         field :ARRAY nrFields OF INTEGER;       (* color 0..5 *)
  14.         visit :ARRAY nrFields OF INTEGER;       (* 0 unvisited, 1 neighbour to do, 2 done *)
  15.         Acount, Acolor, Bcount, Bcolor :INTEGER;        (* player conquered fields and current color *)
  16.         rndSeed, rndIndex :INTEGER;
  17.  
  18. PROCEDURE check (b :BOOLEAN; n :INTEGER);
  19. BEGIN
  20.         IF ~b THEN
  21.                 out.formatInt ("internal check failed: filler.mod: %", n); out.nl;
  22.                 out.exit(1)
  23.         END
  24. END check;
  25.  
  26. PROCEDURE random6 () :INTEGER;  (* return random 0..5 *)
  27. VAR n :INTEGER;
  28.         b :BYTE;
  29. BEGIN
  30.         IF rndIndex = 3 THEN
  31.                 (* 6 ^ 3 = 216 so 3 random6 nrs fit in one random byte, don't waste entropy *)
  32.                 n := unix.readByte (fdRandom, b); ASSERT (n = 1);
  33.                 rndSeed := b; rndIndex := 0;
  34.         END;
  35.         n := rndSeed MOD 6; rndSeed := rndSeed DIV 6; INC (rndIndex)
  36. RETURN n
  37. END random6;
  38.  
  39. PROCEDURE drawRect (x, y, color :INTEGER);
  40. VAR p, i, j :INTEGER;
  41. BEGIN
  42.         p := (y*stride + x*4)*Side;
  43.         check (p + (Side-1)*stride + (Side-1)*4 <= screenBufSize, 20);
  44.         p := base + p;
  45.         FOR j := 0 TO Side-1 DO
  46.                 FOR i := 0 TO Side-1 DO SYSTEM.PUT32 (p, color); INC(p, 4) END;
  47.                 p := p + stride - Side*4;
  48.         END;
  49. END drawRect;
  50.  
  51. PROCEDURE clearVisit;
  52. VAR i :INTEGER;
  53. BEGIN FOR i := 0 TO nrFields-1 DO visit[i] := 0 END; END clearVisit;
  54.  
  55. PROCEDURE doNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN);
  56.         (* helper routine for connect() *)
  57. BEGIN
  58.         IF visit[i] = 0 THEN
  59.                 IF (v = 1) & (field[i] = old) THEN visit[i] := 1; changed := TRUE END;
  60.                 IF field[i] = new THEN visit[i] := 2; changed := TRUE END
  61.         END
  62. END doNeighbour;
  63. (*
  64.         all visit := 0; count := 0; visit[corner] := 1
  65.         repeat
  66.                 changed := false;
  67.                 foreach:
  68.                         if (visit = 1) or (visit = 2) then
  69.                                 curVisit = visit
  70.                                 color := new; visit := 3; count++
  71.                                 foreach neighbour:
  72.                                         if visit = 0 then
  73.                                                 if curVisit = 1 then
  74.                                                         if color = old then visit := 1; changed := true
  75.                                                         if color = new then visit := 2; changed := true
  76.                                                 if curVisit = 2 then
  77.                                                         if color = new then visit := 2; changed := true
  78.         until no changes
  79. *)
  80. PROCEDURE connect (old, new :INTEGER) :INTEGER;
  81. VAR     count, i, x, y, v :INTEGER;
  82.         changed :BOOLEAN;
  83. BEGIN
  84. out.formatInt2 ("connect: old new  % %   ", old+1, new+1);
  85.         count := 0;
  86.         REPEAT
  87.                 changed := FALSE;
  88.                 FOR i := 0 TO nrFields-1 DO
  89.                         v := visit[i];
  90.                         IF (v=1) OR (v=2) THEN
  91.                                 field[i] := new; visit[i] := 3; INC(count);
  92.                                 x := i MOD width; y := i DIV width;
  93.                                 IF x > 0 THEN doNeighbour (i-1, old, new, v, changed) END;
  94.                                 IF x < width-1 THEN doNeighbour (i+1, old, new, v, changed) END;
  95.                                 IF y > 0 THEN doNeighbour (i-width, old, new, v, changed) END;
  96.                                 IF y < height-1 THEN doNeighbour (i+width, old, new, v, changed) END;
  97.                         END
  98.                 END
  99.         UNTIL ~changed
  100. RETURN count
  101. END connect;
  102.  
  103. PROCEDURE doMaxGainNeighbour (i, old, new, v :INTEGER; VAR changed :BOOLEAN);
  104.         (* helper routine for maxGain() *)
  105. BEGIN
  106.         IF visit[i] = 0 THEN
  107.                 IF v = 1 THEN
  108.                         IF field[i] = old THEN visit[i] := 1 ELSE visit[i] := 2 END;
  109.                         changed := TRUE
  110.                 ELSE
  111.                         IF field[i] = new THEN visit[i] := 2; changed := TRUE END
  112.                 END
  113.         END
  114. END doMaxGainNeighbour;
  115. (*  v=1 & field=old -> visit := 1
  116.         v=1 & field # old  -> visit := 2
  117.         v=2 & field = new -> visit := 2
  118. *)
  119.  
  120. PROCEDURE maxGain (old :INTEGER) :INTEGER;
  121.         (* return the color which will conquer the most fields *)
  122. VAR
  123.         i, x, y, new, v :INTEGER;
  124.         max :ARRAY 6 OF INTEGER;
  125.         changed :BOOLEAN;
  126. BEGIN
  127.         FOR i := 0 TO 5 DO max[i] := 0 END;
  128.         REPEAT
  129.                 changed := FALSE;
  130.                 FOR i := 0 TO nrFields-1 DO
  131.                         v := visit[i];
  132.                         IF (v=1) OR (v=2) THEN
  133.                                 visit[i] := 3; new := field[i]; INC (max[new]);
  134.                                 x := i MOD width; y := i DIV width;
  135.                                 IF x > 0 THEN doMaxGainNeighbour (i-1, old, new, v, changed) END;
  136.                                 IF x < width-1 THEN doMaxGainNeighbour (i+1, old, new, v, changed) END;
  137.                                 IF y > 0 THEN doMaxGainNeighbour (i-width, old, new, v, changed) END;
  138.                                 IF y < height-1 THEN doMaxGainNeighbour (i+width, old, new, v, changed) END;
  139.                         END
  140.                 END
  141.         UNTIL ~changed;
  142.         x := -1; y := -1; max[Acolor] := -1; max[Bcolor] := -1;
  143. out.str ("maxGain"); out.nl;
  144. FOR i := 0 TO 5 DO out.formatInt2 ("  %  %", i+1, max[i]); out.nl END;
  145.         FOR i := 0 TO 5 DO IF (max[i] > y) & (i # old) THEN x := i; y := max[i] END END
  146. RETURN x
  147. END maxGain;
  148.  
  149. PROCEDURE drawAll;
  150. VAR x, y :INTEGER;
  151. BEGIN
  152.         gr.screenBegin;
  153.         gr.clear (BackGroundColor);
  154.         FOR y := 0 TO 5 DO drawRect (0, 6 + y DIV 3 + 2*y, palette[y]) END;
  155.         FOR y := 0 TO 47 DO
  156.                 FOR x := 0 TO 61 DO drawRect (x+2, y, palette[ field[y*width + x] ]) END
  157.         END;
  158.         gr.screenEnd;
  159. END drawAll;
  160.  
  161. PROCEDURE run*;
  162. VAR stop :BOOLEAN;
  163.         ev :gr.EventPars;
  164.         x, y, i, old :INTEGER;
  165.         ch :CHAR;
  166. BEGIN
  167.         FOR i := 0 TO nrFields-1 DO field[i] := random6() END;
  168.         Acolor := field[47*width]; field[47*width+1] := Acolor; field[46*width] := Acolor; field[46*width+1] := Acolor;
  169.         Bcolor := field[width-1]; field[width-2] := Bcolor; field[2*width-2] := Bcolor; field[2*width-1] := Bcolor;
  170.         base := gr.base; stride := gr.stride;
  171.         gr.createWindow (1000, 700);
  172.         screenBufSize := gr.winHeight * stride;
  173.         stop := FALSE;
  174.         drawAll;
  175.         REPEAT
  176.                 gr.nextEvent (0, ev);
  177.                 IF ev[0] = gr.EventKeyPressed THEN
  178.                         (* o.formatInt("key pressed %",ev[2]);o.nl; *)
  179.                         (* ev[2]: q=24, ESC=9, CR=36 *)
  180.                         ch := CHR (ev[4]);
  181.                         IF ev[2] = 9 THEN stop := TRUE END;  (* ESC *)
  182.                         (* IF ch = "q" THEN stop := TRUE END; *)
  183.                         IF (ch >= "1") & (ch <= "6") THEN
  184.                                 i := ev[4] - ORD("1");
  185.                                 IF (i # Acolor) & (i # Bcolor) THEN
  186.                                                 (* player A *)
  187.                                         old := Acolor; Acolor := i;
  188. out.formatInt ("play color %", Acolor+1); out.nl;
  189.                                         clearVisit; visit[47*width] := 1;
  190.                                         Acount := connect (old, Acolor)
  191. ;out.formatInt ("count A = %", Acount); out.nl; out.nl;
  192.                                                 (* player B *)
  193.                                         clearVisit; visit[width-1] := 1; old := field[width-1];
  194.                                         Bcolor := maxGain (old);
  195.                                         clearVisit; visit[width-1] := 1;
  196.                                         Bcount := connect (old, Bcolor);
  197. out.formatInt ("count B = %", Bcount); out.nl; out.nl;
  198.                                         drawAll;
  199.                                 END
  200.                         END;
  201.                 ELSIF ev[0] = gr.EventButtonPressed THEN
  202.                         x := ev[2] DIV Side; y := ev[3] DIV Side;
  203.                 END;
  204.         UNTIL stop;
  205.         gr.finish;
  206.         unix.finish;
  207. END run;
  208.  
  209. BEGIN
  210.         fdRandom := unix.open ("/dev/urandom", unix.O_RDONLY, 0); ASSERT (fdRandom # -1);
  211.         rndIndex := 3;
  212.       (* a partial copy of the lexaloffle pico-8 16-color palette *)
  213.         palette[0] := 0FF004DH;  (* red *)
  214.         palette[1] := 0FFA300H;  (* orange *)
  215.         palette[2] := 07E2553H;  (* dark purple *)
  216.         palette[3] := 0008751H;  (* dark green *)
  217.         palette[4] := 029ADFFH;  (* blue *)
  218.         palette[5] := 0FF77A8H;  (* pink *)
  219.         run;
  220. END filler.
  221.  
  222.