Programming the fiver game

Question

Obviously, even if I ask a lot of question I am, obviously, still a dummy!!!!

I want to program the fiver game. It's a very simple game played solitary on a $5 \times 5$ the rule is elementary : if you click with the mouse on a cell it changes color along with its von-Neuman neighbours --- north, south, east and west. The solution is far from trivial and can be obtain by integer programming. You win if you manage to change all the cells to the alternative color.

So according to my analysis

Initialization

$\forall (i,j) \in \{1, 5\}^2$ color c[i,j] = LightBlue

This I can do

cell[i_, j_] := Graphics[{LightBlue, EdgeForm[Directive[Thick, Blue]], 
     Scale[Rectangle[{i, j}], .5]}]
GraphicsGrid[Table[cell[i, j], {i, 1, 5}, {j, 1, 5}], 
     Background -> LightYellow, Spacings -> Scaled[-.03]]

Here I have a two problems secondary problems :

1) The Spacings seems to have nearly no effects --- I want the minimum spacing

2) If I click with the mouse on a square, I can displace it which, in this case, must be forbiden.

Then follows the analysis of the cases ---~I hope not to have make a mistake.

A) If I click on $cell[i,j]$ for ${i,j} \in \{2, 3, 4\}^2$ then the cells $cell[i-1, j]$, $cell[i, j]$, $cell[i+1, j]$, $cell[i, j+1]$ and $cell[i, j-1]$ must have a change in color --- say from LightBlue to LightRed or from LightRed to LightBlue.

B) If I click on $cell[i,j]$ for $\{i,j\} \in \{1\}\times\{2,3,4\}$ then cells $cell[1, j-1]$, $cell[1, j]$, $cell[1, j+1]$ and $cell[2, j]$ must have a change in color.

C) If I click on $cell[i,j]$ for $\{i,j\} \in \{5\}\times\{2,3,4\}$ then cells $cell[5, j-1]$, $cell[5, j]$, $cell[5, j+1]$ and $cell[4, j]$ must have a change in color.

D) If I click on $cell[i,j]$ for $\{i,j\} \in \{2,3,4\}\times \{1\}$ then cells $cell[i-1, 1]$, $cell[i, 1]$, $cell[i+1, 1]$ and $cell[i, 2]$ must have a change in color.

E) If I click on $cell[i,j]$ for $\{i,j\} \in \{2,3,4\}\times \{5\}$ then cells $cell[i-1, 5]$, $cell[i, 5]$, $cell[i+1, 5]$ and $cell[i, 4]$ must have a change in color.

F) If I click on $cell[1,1]$ then $cell[1,1]$, $cell[2,1]$ and $cell[1,2]$ must have a change in color.

G) If I click on $cell[1,5]$ then $cell[1,5]$, $cell[1,4]$ and $cell[2,5]$ must have a change in color.

H) If I click on $cell[5,5]$ then $cell[5,5]$, $cell[4,5]$ and $cell[5,4]$ must have a change in color.

I) If I click on $cell[5,1]$ then $cell[5,1]$, $cell[4,1]$ and $cell[5,2]$ must have a change in color.

If I understand correctly the Mma commands, I need EventHandler and DynamicModule. Unfortunatelly, I have made some trials which gives nothing because, I think, I do not know how to program the fact that any click inside a square must trigger the change.

I do not ask the work be done for me completelly but I need some help. Thanks

Answer 1

In this case I don't know how to post something helpful without providing full code so I'll just do that and hope this wasn't homework. My emphasis is on clarity (hopefully) rather than brevity or peak efficiency.

flip = # /. {LightRed -> LightBlue, LightBlue -> LightRed} &;

flipNeighbors[i_, j_] :=
 (color[##] = flip @ color[##];) & @@@ 
   {{i, j}, {i + 1, j}, {i - 1, j}, {i, j + 1}, {i, j - 1}}

ClearAll[color]
color[_, _] = LightBlue;

Grid[
  Array[
    Button[
      Spacer[{50, 50}]
      , flipNeighbors[##]
      , Background -> Dynamic @ color[##]
    ] &
    , {5, 5}
  ]
  , Spacings -> {-0.03, -0.01}
]

Notes

• Negative Spacings values are used to snug up the buttons.
• ClearAll[color]; color[_, _] = LightBlue; should be evaluated to reset the board.
• DynamicModule should be used, with localization for flip, flipNeighbors, and color, if you want the game to appear correctly when you first open a Notebook containing it.
• Appearance -> None may be used as a Option for Button if you do not like the "3D" border.
• I made the value of the Button Background Dynamic, rather than the entire Grid, for improved performance.

---

The full monty

This is a fun little game so I wrote code for my own reuse. I might as well share it. :-)

The output may be copied and used independently, with controls to reset the board and change the colors when your eyes get tired.

DynamicModule[{flip, v, c, square, gui},
 flip[i_, j_] :=
  (v[##] *= -1;) & @@@
   {{i, j}, {i + 1, j}, {i - 1, j}, {i, j + 1}, {i, j - 1}};

 _v = 1;
 {c[1], c[-1], c[0]} = {LightBlue, LightRed, Gray};

 square =
  Button[
    Spacer[{51, 51}], flip @ ##
    , Background -> Dynamic @ c @ v @ ##
    , Appearance -> None
  ] &;

 gui =
  Labeled[ #
    , {Button["Reset", ClearAll[v]; _v = 1],
        ColorSetter@*Dynamic@*c /@ {1, -1, 0} // Column}
    , {Bottom, Right}
  ] &;

 Grid[
     Array[square, {5, 5}]
     , Frame -> c[0]
     , Background -> c[0]
     , Spacings -> {{5, {1}, 5}, {5, {1}, 5}}/10
 ] // gui // Deploy
]

Answer 2

Here is a version that uses only the Front End, which can be verified using LinkSnooper. This is mostly a useless optimisation/exploration.

width = 3;
height = 3;
n = width*height;
heldStates = 
  Join @@ (ToExpression["state" <> ToString[#], InputForm, Hold] & /@ 
     Range[n]);
groupedEdges =
  Flatten[#, 1] &@
   Table[Block[
     {sqs = {0}, index = xii + width (yjj - 1)}
     ,
     If[xii != width, AppendTo[sqs, 1]];
     If[xii != 1, AppendTo[sqs, -1]];
     If[yjj != height, AppendTo[sqs, width]];
     If[yjj != 1, AppendTo[sqs, -width]];
     index + # & /@ sqs]
    ,
    {yjj, 1, height},
    {xii, 1, width}
    ];
heldConnectedStates = heldStates[[#]] & /@ groupedEdges;
dynModVars =
  List @@@ 
   Hold@Evaluate[
     Set @@@ Thread[{heldStates, Hold @@ ConstantArray[False, n]}, 
       Hold]];

Heres the graphical stuff

interactiveRectangleMaker =
  Function[{sA, boxDirective, action},
   {DynamicBox[If[sA, RGBColor[1, 0, 1], RGBColor[0, 1, 0]]], 
    EventHandler[boxDirective, {"MouseDown" :> action}]}, HoldAll];
actionsHeld =
  Join @@ (CompoundExpression @@@ Hold[Evaluate[
         Join @@ 
          Function[Null, Hold[FEPrivate`Set[#, SameQ[#, False]]], 
            HoldAll] /@ #
         ]] & /@ heldConnectedStates);
doubleRange = Transpose@Outer[List, Range[width], Range[height]];
rectBoxes = Flatten@Map[RectangleBox, doubleRange, {2}];
argsHeld = 
  Thread[{heldStates, Hold @@ rectBoxes, actionsHeld }, Hold];

This makes the DynamicModule

DynamicModule @@
 {Unevaluated @@ dynModVars,
  Graphics[
   List @@ interactiveRectangleMaker @@@ argsHeld
   ,
   GridLines -> {Range[2, width], Range[2, height]}
   ]}