The issue with such multicontroller dynamic interfaces is that one usually wants to store the state of all controllers in one variable for convenience (e.g. store status of position {i, j}
as state[{i, j}] := "flagged"
or state = <|{1, 1} -> 2, {1, 2} -> "flagged", ...|>
). On one hand, this makes assignments easy during updating, but on the other hand, any change to state
triggers an interface update of all cells as they all track the single variable state
. And in this case, it involves the visual updating of 480 cells. Using Graphic
-s or Image
-s makes updating even slower.
Unfortunately, there is no mechanism to dynamically track parts of expressions in Mathematica yet, something like:
Dynamic[display[state[{1, 2}]], TrackedSymbols :> {state[{1, 2}]}
One possible solution is to introduce 480 independent symbols as variables, one for each cell, but this requires metaprogramming methods to generate and set the symbols.
Here is a proof-of-principle for this approach that uses the excellent method of programmatic symbol assignment from Kuba & John Fultz. I've replaced the imported graphics with domestic frame-and-style ones, as those are much faster printed. One can make code even faster by fine-tuning recursive reveal
to only visit every relevant cell once. Now it is quite redundant, but the fact is that this extra traversal is marginal compared to the time needed for visual updating of the interface. A large part of the code is to detect simultaneous L-R clicks.
ClearAll[toString, set, reveal, neighbors, reset, end, lr];
{m, n, k} = {9, 9, 10}; (* Beginner *)
{m, n, k} = {16, 16, 40};(* Intermediate *)
{m, n, k} = {16, 30, 99};(* Expert *)
seed = 1;
pos = Flatten[Table[{i, j}, {i, m}, {j, n}], 1];
st = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, "N", "F"};
bg = {"N" | "F" -> [email protected], _ -> [email protected]};
fg = {
1 -> RGBColor[0.247, 0.314, 0.737],
2 -> RGBColor[0.122, 0.408, 0.004],
3 -> RGBColor[0.682, 0.008, 0.02],
4 -> RGBColor[0.027, 0.004, 0.502],
5 -> RGBColor[0.49, 0, 0],
6 -> RGBColor[0, 0.49, 0.495],
"F" -> RGBColor[1, 0, 0], _ -> GrayLevel[0]};
lbl = {9 -> "\[MathematicaIcon]", 0 -> "", "F" -> "\[SpadeSuit]", x_Integer :> x, _ -> ""};
pics = AssociationMap[
Framed[Style[# /. lbl, Bold, # /. fg], Background -> (# /. bg),
ImageSize -> {20, 20}, Alignment -> {Center, Baseline},
FrameMargins -> 0, ImageMargins -> 0, FrameStyle -> None] &, st];
(* Convert position to symbol name *)
toString[{i_, j_}] := StringJoin["s", ToString@i, "x", ToString@j];
(* Assign `val` to symbol of name `str` *)
set[str_, val_] := ToExpression@MakeBoxes[RawBoxes@str = val];
(* Reveal cell at position `p` and update symbol `s` (string) *)
reveal[p_, s_] := Module[{c}, If[ToExpression@s === "N", c = counts@p;
If[c == 9, end@False, set[s, c];
If[c == 0, reveal[#, toString@#] & /@ neighbors@p]]]];
(* Return 3x3 submatrix centered at position `{i, j}` *)
neighbors[{i_, j_}] := Flatten[Outer[List, Range[Max[1, i - 1], Min[m, i + 1]],
Range[Max[1, j - 1], Min[n, j + 1]]], 1];
(* Reset game *)
reset[s_: Automatic] := Module[{mines},
{msg, f, m1, m2} = {"", 0, 0, 0};
seed = If[s === Automatic, RandomInteger@999999, s];
SeedRandom@seed;
mines = AssociationThread[pos -> RandomSample@PadRight[Table[1, {k}], m n]];
counts = AssociationMap[If[mines@# > 0, 9, Total@Lookup[mines, neighbors@#]] &, pos];
str = toString /@ pos; (* generate a symbol name for each cell *)
ClearAll /@ str; (* clear these symbols in case they exist *)
set[#, "N"] & /@ str; (* set all symbols to "N" (not clicked) *)
];
(* Terminate game *)
end[win_] := (MapThread[set[#1, counts@#2] &, {str, pos}];
msg = Style[If[win, "\[HappySmiley]", "\[SadSmiley]"], 16]);
(* Event for simultaneous L-R click *)
lr[p_, s_] := (If[ToExpression@s =!= "N" && ToExpression@s =!= "F",
m1 = m2 = 0; Module[{c = counts@p, nb = neighbors@p, v},
v = ToExpression@*toString /@ nb;
If[c === 0 || Count[v, "F"] === c,
reveal[#, toString@#] & /@ Pick[nb, v, "N"]]]]);
reset@seed;
Deploy@Grid[{
{Button["New", reset[]], Button["Reset", reset@seed],
InputField[Dynamic[seed, (seed = #; reset@#) &], Number,
FieldSize -> 5]},
{Dynamic@(k - f), Dynamic@msg, Invisible@Dynamic@{m1, m2}},
{Deploy@Grid[Partition[MapThread[
EventHandler[Dynamic@pics@ToExpression@#2, {
{"MouseClicked", 1} :> (m1 = SessionTime[];
If[0 < m1 - m2 < .2, lr[#1, #2], reveal[#1, #2]];
If[(Count[ToExpression /@ str, "N"] + f) === k,
end@True]),
{"MouseClicked", 2} :> (m2 = SessionTime[];
If[0 < m2 - m1 < .2, lr[#1, #2];,
Switch[ToExpression@#2, "N", f++; set[#2, "F"], "F", f--;
set[#2, "N"], _, Null]])
}] &, {pos, str}], n], Spacings -> {.1, .1},
Background -> Black], SpanFromLeft}
}, Spacings -> {.1, .1}, Alignment -> Left]