2048的又一次改良

闲来无事,我扒出了十年前在网上复制粘贴的mma2048代码,并对其进行了改良,将2048与Threes!结合起来,形成了如下代码。

(由于涉及键盘操作,网页版的编译器无法操作,请自行下载mma8.0及以上版本运行)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
[] = # //. {{x___, 1, a_ /; a > 1, y___} :> {x, a, 1, y}, {x___, 
a_ /; a > 1, a_, y___} :> {x, 2 抓住[a], 1, y}} /. 抓住[a_] :> a &;
[] = Composition[Transpose,[], Transpose];
[] = Composition[Reverse,[], Reverse];
[] = Composition[Transpose,[], Transpose];
加块瓦 = ReplacePart[#, RandomChoice@Position[#, 1] -> RandomChoice[{2, 3}]] &;
按键 = If[格子 !=[#][格子], 格子 = 加块瓦[[#][格子]]; 总分 = Total[Total[格子]];
Which[And @@ (格子 ==[#][格子] & /@ {,,,}),
状态 = "你的得分为" ToString[总分]]] &;
格子 = 加块瓦[ConstantArray[1, {5, 5}]];
状态 = "";
EventHandler[
Dynamic[ArrayPlot[Log2@格子/17, ColorFunction -> Hue,
ColorFunctionScaling -> False, Mesh -> All,
Epilog -> {MapIndexed[
Text[If[#1 == 1, "", Style[#1, "Section"]], #2 - {0.5, 0.5}] &,
Transpose@Reverse@格子, {2}],
Text[Style[状态, Blue, 24], {2.5, 2}]}]], {"LeftArrowKeyDown" :>
按键[], "RightArrowKeyDown" :> 按键[], "UpArrowKeyDown" :> 按键[],
"DownArrowKeyDown" :> 按键[]}]

计分方式就是所有数字的和,不是2048合成就加分的方式,因此得分会缩水50%左右。

感觉这个版本的难度增加了不少,目前最高分621,我太菜了,有能力的可以在评论区晒分截图。