Very nice! I like the use of CreateDialog as well. I recently made a similar one myself, with some different stylings: one where I scraped the CSS from the original, and one where I used spikeys instead of numbers! You can download the spikey images
here (the code looks for the images at ~/Downloads/Spikeys/, but you can change it).
Also a notebook is attached to this post which you can simply run and the game will start - all images are already inside.
Spikey images look like this once imported:
Here's the code (the bulk of it is styling stuff, and I put everything inside of the Initialization of the DynamicModule):
start2048[] := With[{size = 4},
CreateDialog[
DynamicModule[
{board = Table[$empty, {size}, {size}], tile, score = 0, s, oldBoard, gameover = False, won = False},
Dynamic[
Column[{
Row[{
"Styling: ",
Button["Default", ($emptyColor = RGBColor[0.75436, 0.701427, 0.642634];
$backgroundColor = RGBColor[0.676677, 0.616403, 0.559747];
drawTile = drawTileDefault;)],
Button["Wolfram", ($backgroundColor = LightGray; $emptyColor = Lighter[$backgroundColor, .6];
drawTile = drawTileWolfram;)],
Spacer[220],
Button["Reset", (board = Table[$empty, {size}, {size}]; score = 0; gameover = False; won = False;
Do[tile = newTile[board]; board[[Sequence @@ tile[[2]]]] = tile[[1]], {2}];)]
}],
Row[{
Which[
gameover,
Overlay[{#, Text[Style["Gameover", Red, Bold, FontFamily -> "Helvetica",
FontSize -> Scaled[0.1]]]}, Alignment -> Center] &,
won,
Overlay[{#, Text[Style["You win!", Yellow, Bold, FontFamily -> "Helvetica",
FontSize -> Scaled[0.1]]]}, Alignment -> Center] &,
True,
Identity
] @ drawGrid[board],
Spacer[50],
Column[{
Style[score, Bold, colorForNumber[2, "Color"], FontFamily -> "Helvetica", FontSize -> 70],
Show[drawTile[Max[board /. $empty -> 0]], ImageSize -> Small]},
Alignment -> Center, Spacings -> 5]
}]
}]
],
Initialization :> (
SetOptions[EvaluationNotebook[], NotebookEventActions ->
{"KeyDown" :>
With[{key = ToCharacterCode[CurrentValue["EventKey"]][[1]]},
If[MemberQ[keymap[[All, 1]], key],
If[!gameover && !won,
oldBoard = board;
{board, s} = Reap[shift[board, key /. keymap]];
If[board =!= oldBoard,
tile = newTile[board];
board[[Sequence @@ tile[[2]]]] = tile[[1]]
];
If[s =!= {}, score += Total[s[[1]]]];
Which[Max[board /. $empty -> 0] >= 2048, won = True,
!movesAvailable[board], gameover = True];
]
]
]
}];
$empty = "";
keymap = {28 -> "Left", 29 -> "Right", 30 -> "Up", 31 -> "Down"};
newTile[board : {{__} ..}] := With[{pos = Position[board, $empty]},
If[pos === {}, {}, {RandomChoice[{.9, .1} -> {2, 4}], RandomChoice[pos]}]];
combineLeft[l_List] := Flatten[Split[
Cases[l, Except[$empty]]] //. {a___, x_Integer, x_Integer, b___} :> (Sow[x + x]; {a, {x + x}, b})];
combineRight[l_List] := Reverse[combineLeft[Reverse[l]]];
shift[board : {{__} ..}, "Left"] := PadRight[combineLeft[#], Length[board], $empty] & /@ board;
shift[board : {{__} ..}, "Right"] := PadLeft[combineRight[#], Length[board], $empty] & /@ board;
shift[board : {{__} ..}, "Up"] := Transpose[shift[Transpose[board], "Left"]];
shift[board : {{__} ..}, "Down"] := Transpose[shift[Transpose[board], "Right"]];
matchesAvailable[board : {{__} ..}] :=
Or @@ (Cases[#, {___, x_Integer, x_Integer, ___}, {1}] =!= {} &) /@ {board, Transpose[board]};
movesAvailable[board : {{__} ..}] := !FreeQ[board, $empty] || matchesAvailable[board];
logos = Import[FileNameJoin[{$HomeDirectory, "Downloads", "Spikeys", # <> ".png"}]] &
/@ {"1", "1b", "2", "3", "4", "5", "6", "7", "8", "9", "alpha"};
roundedLogos = SetAlphaChannel[#, ColorNegate@Graphics@Rectangle[{0, 0}, ImageDimensions[#],
RoundingRadius -> 20]] & /@ logos;
drawTileWolfram[$empty] := Graphics[{$emptyColor, Rectangle[RoundingRadius -> 0.05]}, ImageSize -> 250,
ContentSelectable -> False, PlotRangePadding -> 0];
drawTileWolfram[n_Integer] /; IntegerQ[Log2[n]] := Image[roundedLogos[[Log2[n]]], ImageSize -> 250];
hexToRGB[s_String] := RGBColor @@ (IntegerDigits[FromDigits[StringTake[s, -6], 16], 256, 3]/255.);
css = Import["http://gabrielecirulli.github.io/2048/style/main.css", "XHTML"];
colors = StringCases[css, ".tile.tile-" ~~ b : Alternatives @@ ToString /@ Table[2^i, {i, 11}] ~~ " " ~~
Shortest[___] ~~ "{" ~~ Shortest[a___] ~~ "}"
:> (Flatten[{b, StringCases[a, {"color: " ~~ Shortest[c__] ~~ ";" :> ("Color" -> c),
"background: " ~~ Shortest[d__] ~~ ";" :> ("Background" -> d)}]}] /. {_} -> Sequence[])];
defaultColor = First@StringCases[css, "body {" ~~ Shortest[Except["{"] ..] ~~ "color: " ~~
Shortest[c__] ~~ ";" ~~ Shortest[Except["}"] ..] ~~ "}" :> c];
colors = If[!MemberQ[#, "Color", Infinity], #~Join~{"Color" -> defaultColor}, #] & /@ colors;
colorForNumber[n_Integer, s : "Background" | "Color"] /; MemberQ[Table[2^i, {i, 11}], n] :=
hexToRGB[First[Cases[colors, {ToString[n], r___} :> (s /. {r})]]];
colorForNumber[_Integer, "Background"] := hexToRGB["#3c3a32"];
colorForNumber[_Integer, "Color"] := hexToRGB["#f9f6f2"];
$emptyColor = RGBColor[0.75436, 0.701427, 0.642634];
$backgroundColor = RGBColor[0.676677, 0.616403, 0.559747];
drawTileDefault[$empty] := Graphics[{$emptyColor, Rectangle[RoundingRadius -> 0.05]},
ImageSize -> 250, ContentSelectable -> False];
drawTileDefault[n_Integer] := Graphics[{colorForNumber[n, "Background"],
Rectangle[{-1/2, -1/2}, RoundingRadius -> 0.05],
colorForNumber[n, "Color"],
Text[Style[n, Bold, FontFamily -> "Helvetica",
FontSize -> Scaled[Switch[IntegerLength[n], 1 | 2, .5, 3, .4, _, .34]]], {0, 0}]},
ImageSize -> 250, ContentSelectable -> False];
drawGrid[board : {{__} ..}] := Framed[GraphicsGrid[Map[drawTile, board, {2}],
ContentSelectable -> False, ImageSize -> 450],
FrameMargins -> 10, Background -> $backgroundColor, RoundingRadius -> 10, FrameStyle -> None];
drawTile = drawTileDefault;
If[MatchQ[board, {{$empty ..} ..}],
Do[tile = newTile[board]; board[[Sequence @@ tile[[2]]]] = tile[[1]], {2}]
];
)
],
WindowSize -> {800, 520},
Background -> White
]
]
Attachments: