用 MMA 模拟万象物语魂盘

思路

用 Graphics 函数绘制图像，用 EventHandler 处理鼠标点击和拖动事件。两条魂的颜色用一个矩阵记录，形如：

{
{黑, 白, ......},
{金, 黑, ......}
}

消魂时，先将要消的混变成灰色，然后用 AppendTo 补充魂，最后将所有灰色的元素全部删掉。

Code

Zdorika`CreateSoulBar[func_] := DynamicModule[
  {
   current = {0, 0},
   start = {0, 0},
   end = {0, 0},
   table = 
    Table[RandomChoice[{White, Black, Orange}], {i, 1, 2}, {j, 1, 10}],
   selecting = {},
   OnRefresh,
   Update,
   x0, y0, x1, y1, selectedparts = {},
   lastSkillColor,
   lastSkillRank = 0
   },
  Update[] := (
    x0 = IntegerPart[start[[1]] + 1];
    y0 = IntegerPart[start[[2]] + 1];
    x1 = IntegerPart[current[[1]] + 1];
    y1 = IntegerPart[current[[2]] + 1];
    If[
     And[Abs[x0 - x1] <= 1,
      Abs[y0 - y1] <= 1],
     selectedparts = 
      DeleteDuplicates@{{x0, y0}, {x1, y1}, {x0, y1}, {x1, y0}};
     If[
      Equal @@ ((table[[Sequence @@ Reverse[#]]]) & /@ selectedparts),
      selecting = 
        Table[Rectangle[{i[[1]] - 1, i[[2]] - 1}, {i[[1]], 
           i[[2]]}], {i, selectedparts}];
      ];
     ]
    );
  OnRefresh[] := (
    selecting = {};
    x0 = IntegerPart[start[[1]] + 1];
    y0 = IntegerPart[start[[2]] + 1];
    x1 = IntegerPart[current[[1]] + 1];
    y1 = IntegerPart[current[[2]] + 1];
    If[
     And[Abs[x0 - x1] <= 1,
      Abs[y0 - y1] <= 1],
     selectedparts = 
      DeleteDuplicates@{{x0, y0}, {x1, y1}, {x0, y1}, {x1, y0}};
     If[
      Equal @@ ((table[[Sequence @@ Reverse[#]]]) & /@ selectedparts),
      lastSkillColor = table[[y0, x0]];
      Table[table = ReplacePart[table, Reverse[i] -> Gray]; 
       AppendTo[table[[i[[2]]]], 
        RandomChoice[{White, Black, Orange}]], {i, selectedparts}];
      table = DeleteCases[table, Gray, Infinity];
      lastSkillRank = Length[selectedparts];
      func[lastSkillColor, lastSkillRank];
      ];
     ]
    );
  EventHandler[Dynamic[Framed@Graphics[
      {
       Table[{table[[1, i + 1]], Rectangle[{i, 0}, {i + 1, 1}]}, {i, 
         0, 9}],
       Table[{table[[2, i + 1]], Rectangle[{i, 1}, {i + 1, 2}]}, {i, 
         0, 9}],
       EdgeForm[{Red, Thick}], Opacity[0.2], Red, selecting
       },
      PlotRange -> {{0, 10}, {0, 2}},
      Background -> Gray,
      ImageSize -> Large]
    ],
   {
    "MouseDragged" :> (current = MousePosition["Graphics"]; Update[]),
    "MouseDown" :> (start = MousePosition["Graphics"]; Update[]),
    "MouseUp" :> (current = MousePosition["Graphics"]; Update[]; 
      OnRefresh[])
    }
   ]
  ]

效果

2018-11-20_2-00-58.gif