2048: Difference between revisions

=={{header|Mathematica}}==

<lang Mathematica>SetOptions[InputNotebook[],NotebookEventActions->{

"LeftArrowKeyDown":>(stat=Coalesce[stat];AddNew[]),

"RightArrowKeyDown":>(stat=Reverse/@Coalesce[Reverse/@stat];AddNew[]),

"UpArrowKeyDown":>(stat=Coalesce[stat\[Transpose]]\[Transpose];AddNew[]),

"DownArrowKeyDown":>(stat=(Reverse/@(Coalesce[Reverse/@(stat\[Transpose])]))\[Transpose];AddNew[])

}

];

n=4;

bgcolor=GrayLevel[0.84];

colorfunc=Blend[{{0,Gray},{1/2,Red},{1,Blend[{Yellow,Orange}]}},#]&;

ClearAll[AddNew,PrintStat,Coalesce,SubCoalesce,AddRandomNumber]

AddNew[]:=(stat=AddRandomNumber[stat])

PrintStat[stat_]:=Module[{gr1,gr2,gr3,dr=0.2,cols,nstat=stat,positions},

gr1={bgcolor,Rectangle[-dr{1,1},n+dr{1,1},RoundingRadius->dr]};

cols=Map[If[#==0,0,Log2[#]]&,nstat,{2}];

cols=Map[If[#==0,Lighter@bgcolor,colorfunc[#/Max[cols]]]&,cols,{2}];

positions=Table[{i,n-j+1},{j,n},{i,n}];

gr2=MapThread[{#2,Rectangle[#3-{1,1}(1-dr/3),#3-{1,1}dr/3,RoundingRadius->dr/2]}&,{stat,cols,positions},2];

gr3=MapThread[If[#1>0,Style[Text[#1,#2-0.5{1,1}],20,White],{}]&,{stat,positions},2];

Graphics[{gr1,gr2,gr3},PlotRange->{{-0.5,n+0.5},{-0.5,n+0.5}},ImageSize->500]

]

Coalesce[stat_]:=SubCoalesce/@stat

SubCoalesce[statlist_]:=Module[{st=statlist,n=Length[statlist],pairs},

st=Split[DeleteCases[st,0]];

st=Partition[#,2,2,1,{}]&/@st;

st=Map[If[Length[#]==2,Total[#],#]&,st,{2}];

Join[Flatten[st],ConstantArray[0,n-Length[Flatten[st]]]]

]

AddRandomNumber[stat_,n_:2]:=With[{pos=Position[stat,0,{2}]},If[Length[pos]>0,ReplacePart[stat,RandomChoice[pos]->n],stat]]

stat=Nest[AddRandomNumber[#,RandomChoice[{2,4}]]&,ConstantArray[0,{n,n}],4];

Dynamic[PrintStat@stat]</lang>