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: