2048的又一次改良

发表于 更新于 分类于 本文字数： 1.3k 阅读时长 ≈ 1 分钟

闲来无事，我扒出了十年前在网上复制粘贴的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，我太菜了，有能力的可以在评论区晒分截图。