Create a simple 2048 game clone

GolfScript, 323 characters

1,16*{16,{1$=!},.,rand=)/()2++\[]*+4/{.['-----']4*'+'*'++'1/*n+:^\{'|''     ':X'|'+4*n++:Y.@{X\`+-5>'|'\+}%'|'+n+Y+Y+^+}%+puts}:P~"wasd":Q{1$.@{Q\?[{zip}{}{-1%zip-1%}{{-1%}%}]=\1$~{0-[{.2$={+)}*}*0...]4<{1|(}%}%\~}:^~=!},:F{0{;'"#{'9.?rand';STDIN.getc()}"'++~.F\?0<}do^[]*.2048?0<.!{'you win'@@}*}{'you lose'@@*0}if}do 4/P;

The keys you have to use are wasd but you can change the constant in the code to whatever keys you like. It gracefully ignores any unknown key or illegal move. Unfortunately you have to press enter after each key.

Example 2048ascii

256 character solution

1,16*{16,{1$=!},.,rand=)/())+\[]*+4/{.{{.9>7*+48+}%n+}%puts}:P~"wasd":Q{1$.@{Q\?[{zip}{}{-1%zip-1%}{{-1%}%}]=\1$~{0-[{.2$={;21+}*}*0...]4<{20%}%}%\~}:^~=!},:F{0{;'"#{'9.?rand';STDIN.getc()}"'++~.F\?0<}do^[]*.10?0<.!{'you win'@@}*}{'you lose'@@*0}if}do 4/P;

Here the output is hexadecimal logarithmic, i.e. 0 stands for ., 1 for 2, 2 for 4, 3 for 8 ... B for 2048. Since we all know hexadecimals and the powers of two this shouldn't be a limitation at all.

Example run (first moves):

0000
0000
0010
0000
w
0011
0000
0000
0000
a
2000
0000
0001
0000
s
0000
0000
0100
2001
d
0000
0000
1001
0021
w
1022
0000
0001
0000
a
1301
0000
1000
0000
s
0000
1000
0000
2301
d
0000
1001
0000
0231

J - 240 230 216 char

This counts the trailing newline, because you need it to start running the game at the console. Play by typing one of udlr and then hitting Enter. Moves that do nothing to the board are handled properly, but the program will get mad at you if you give it any bad input.

'you ',>lose`win{~$:@".@('o b=:2 t}^:(1-b-:])s ',' b',~1!:1@1:)`w@.((w=:2048 e.,)+(s d-:s u=:l d=:r(&.|:))*s r-:(s=:[:p(2(=/(0,+/^:)@{.,}.),)/@p=:\:=&0)l=:&.|.r=:"1)(o=:[2:1!:2~4<@":"0])b=:2(t=:(?&#{])[:I.0=,)}4 4$0

The readable version and explanation are a little too large to fit comfortably into the post: you can find a writeup at this link.

Usage:

   'you ',>lose`win{~$:@".@('o b=:2 t}^:(1-b-:])s ',' b',~1!:1@1:)`w@.((w=:2048 e.,)+(s d-:s u=:l d=:r(&.|:))*s r-:(s=:[:p(2(=/(0,+/^:)@{.,}.),)/@p=:\:=&0)l=:&.|.r=:"1)(o=:[2:1!:2~4<@":"0])b=:2(t=:(?&#{])[:I.0=,)}4 4$0
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   2|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
r
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   2|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   2|   0|   0|
+----+----+----+----+
u
+----+----+----+----+
|   0|   2|   0|   2|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   2|
+----+----+----+----+
d
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   2|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   2|   0|   4|
+----+----+----+----+
l
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   2|   0|   0|   0|
+----+----+----+----+
|   0|   0|   2|   0|
+----+----+----+----+
|   2|   4|   0|   0|
+----+----+----+----+
d
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   2|   0|   0|
+----+----+----+----+
|   4|   4|   2|   0|
+----+----+----+----+
r
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   2|
+----+----+----+----+
|   0|   0|   0|   2|
+----+----+----+----+
|   0|   0|   8|   2|
+----+----+----+----+
d
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   0|   0|   0|
+----+----+----+----+
|   0|   2|   0|   2|
+----+----+----+----+
|   0|   0|   8|   4|
+----+----+----+----+

Mathematica, 484 chars

Very ugly.

m@l=#//.{{x___,0,a_/;a>0,y___}:>{x,a,0,y},{x___,a_/;a>0,a_,y___}:>{x,2 h@a,0,y}}/.h@a_:>a&;{m@u,m@d,m@r}=Composition[#,m@#2,#]&@@@{{Thread,l},{Reverse,u},{Thread,d}};a=ReplacePart[#,RandomChoice@Position[#,0]->2]&;g=a@ConstantArray[0,{4,4}];EventHandler[Dynamic[GraphicsGrid@Map[Graphics@Text@#&,g,{2}]],(#2<>"ArrowKeyDown":>If[g!=m[#]@g,g=a[m[#]@g];Which[And@@(g==m[#]@g&/@{u,l,r,d}),Print@"you lose",!FreeQ[g,2048],Print@"you win"]])&@@@{{l,"Left"},{r,"Right"},{u,"Up"},{d,"Down"}}]

Controlled by arrow keys.

enter image description here

Ungolfed:

move[Left] = # //. {{x___, 1, a_ /; a > 1, y___} :> {x, a, 1, y},
      {x___, a_ /; a > 1, a_, y___} :> {x, 2 Hold@a, 1, y}} /. 
    Hold@a_ :> a &;
move[Up] = Composition[Transpose, move[Left], Transpose];
move[Down] = Composition[Reverse, move[Up], Reverse];
move[Right] = Composition[Transpose, move[Down], Transpose];
addTile = ReplacePart[#, RandomChoice@Position[#, 1] -> 2] &;
keyDown = If[grid != move[#][grid], grid = addTile[move[#][grid]];
    Which[And @@ (grid == move[#][grid] & /@ {Left, Right, Up, Down}),
      status = "Can't move...",
     ! FreeQ[grid, 2048], status = "2048!"]] &;
grid = addTile@ConstantArray[1, {4, 4}];
status = "";
EventHandler[Dynamic[ArrayPlot[Log2@grid/11,
   ColorFunction -> "StarryNightColors",
   ColorFunctionScaling -> False,
   Mesh -> All,
   Epilog -> {MapIndexed[
      Text[Style[#1, "Section"] //. 1 -> "", #2 - {0.5, 0.5}] &, 
      Transpose@Reverse@grid, {2}],
     Text[Style[status, "Section"], {2, 2}]}]],
 {"LeftArrowKeyDown" :> keyDown[Left],
  "RightArrowKeyDown" :> keyDown[Right],
  "UpArrowKeyDown" :> keyDown[Up],
  "DownArrowKeyDown" :> keyDown[Down]}]

enter image description here

Tags:

Code Golf

Game

Sliding Puzzle

Recent Posts