Mathematica
Este código fue escrito en Mathematica por Xiangdong Wen y en realidad puede reproducirse en un navegador web aquí: Shape Descender (haga clic en los gráficos para iniciar las teclas de flechas). A continuación se muestran la captura de pantalla y el código completo, lo cual es bastante bueno para una aplicación web completa de este juego.
Código
allBlocks = {{{{1, 0, 0, 0}, {1, 1, 1, 0}, {0, 0, 0, 0}, {0, 0, 0,
0}}, {{0, 1, 1, 0}, {0, 1, 0, 0}, {0, 1, 0, 0}, {0, 0, 0,
0}}, {{0, 0, 0, 0}, {1, 1, 1, 0}, {0, 0, 1, 0}, {0, 0, 0,
0}}, {{0, 1, 0, 0}, {0, 1, 0, 0}, {1, 1, 0, 0}, {0, 0, 0,
0}}}, {{{0, 2, 0, 0}, {2, 2, 2, 0}, {0, 0, 0, 0}, {0, 0, 0,
0}}, {{0, 2, 0, 0}, {0, 2, 2, 0}, {0, 2, 0, 0}, {0, 0, 0,
0}}, {{0, 0, 0, 0}, {2, 2, 2, 0}, {0, 2, 0, 0}, {0, 0, 0,
0}}, {{0, 2, 0, 0}, {2, 2, 0, 0}, {0, 2, 0, 0}, {0, 0, 0,
0}}}, {{{0, 0, 3, 0}, {3, 3, 3, 0}, {0, 0, 0, 0}, {0, 0, 0,
0}}, {{0, 3, 0, 0}, {0, 3, 0, 0}, {0, 3, 3, 0}, {0, 0, 0,
0}}, {{0, 0, 0, 0}, {3, 3, 3, 0}, {3, 0, 0, 0}, {0, 0, 0,
0}}, {{3, 3, 0, 0}, {0, 3, 0, 0}, {0, 3, 0, 0}, {0, 0, 0, 0}}},
{{{0, 0, 0, 0}, {0, 4, 4, 0}, {0, 4, 4, 0}, {0, 0, 0, 0}}, {{0, 0,
0, 0}, {0, 4, 4, 0}, {0, 4, 4, 0}, {0, 0, 0, 0}}, {{0, 0, 0,
0}, {0, 4, 4, 0}, {0, 4, 4, 0}, {0, 0, 0, 0}}, {{0, 0, 0,
0}, {0, 4, 4, 0}, {0, 4, 4, 0}, {0, 0, 0, 0}}}, {{{0, 0, 0,
0}, {5, 5, 5, 5}, {0, 0, 0, 0}, {0, 0, 0, 0}}, {{0, 0, 5,
0}, {0, 0, 5, 0}, {0, 0, 5, 0}, {0, 0, 5, 0}}, {{0, 0, 0,
0}, {5, 5, 5, 5}, {0, 0, 0, 0}, {0, 0, 0, 0}}, {{0, 0, 5,
0}, {0, 0, 5, 0}, {0, 0, 5, 0}, {0, 0, 5, 0}}}, {{{6, 6, 0,
0}, {0, 6, 6, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}, {{0, 0, 6,
0}, {0, 6, 6, 0}, {0, 6, 0, 0}, {0, 0, 0, 0}}, {{6, 6, 0,
0}, {0, 6, 6, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}, {{0, 0, 6,
0}, {0, 6, 6, 0}, {0, 6, 0, 0}, {0, 0, 0, 0}}}, {{{0, 7, 7,
0}, {7, 7, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}, {{0, 7, 0,
0}, {0, 7, 7, 0}, {0, 0, 7, 0}, {0, 0, 0, 0}}, {{0, 7, 7,
0}, {7, 7, 0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0}}, {{0, 7, 0,
0}, {0, 7, 7, 0}, {0, 0, 7, 0}, {0, 0, 0, 0}}}};
smallBoard =
Table[If[i == 1 || j == 1 || i == 6 || j == 6, 9, 0], {i, 1, 6}, {j,
1, 6}];
color[v_] :=
Switch[v, 0, Black, 1, Yellow, 2, Blue, 3, Magenta, 4, Cyan, 5, Red,
6, Orange, 7, Green, 9, Gray, _, Gray];
showSquare[{i_, j_}, v_] := {color[v],
Rectangle[{i + 0.05, j + 0.05}, {i + 0.95, j + 0.95}]};
showHintBlock[n_, p_, x_, y_] :=
Table[showSquare[{i + x, j + y}, allBlocks[[n, p, i, j]]], {i, 1,
4}, {j, 1, 4}];
initBoard[
Hold[board_, num_]] := {board =
Table[If[i <= 3 || j <= 3 || i >= 14 || j >= 24, 9, 0], {i, 1,
16}, {j, 1, 28}],
Table[board[[i, 24]] = 0; board[[i, 25]] = 0;
board[[i, 26]] = 0, {i, 7, 10}];
Table[board[[i, 25]] = 0, {i, 1, 16}]; board[[6, 25]] = 9,
board[[11, 25]] = 9,
Table[If[Mod[j + i, 2] == 0, board[[j, i + 3]] = 9], {i, 1,
num}, {j, 4, 13}]};
bMoveTo[n_, p_, x_, y_, Hold[board_]] :=
Total[Table[
allBlocks[[n, p, i, j]]* board[[i + x, j + y]], {i, 1, 4}, {j, 1,
4}], 2] == 0;
bGameOver[n_, p_, Hold[board_]] :=
Not[bMoveTo[n, p, 6, 22, Hold[board]]];
bLeft[n_, p_, x_, y_, Hold[board_]] :=
bMoveTo[n, p, x - 1, y, Hold[board]];
bRight[n_, p_, x_, y_, Hold[board_]] :=
bMoveTo[n, p, x + 1, y, Hold[board]];
bDown[n_, p_, x_, y_, Hold[board_]] :=
bMoveTo[n, p, x, y - 1, Hold[board]];
bRotateAnticlock[n_, p_, x_, y_, Hold[board_]] :=
Module[{tp}, tp = p - 1; If[tp == 0, tp = 4];
bMoveTo[n, tp, x, y, Hold[board]]];
bRotateClockwise[n_, p_, x_, y_, Hold[board_]] :=
Module[{tp}, tp = p + 1; If[tp == 5, tp = 1];
bMoveTo[n, tp, x, y, Hold[board]]];
showBoard[Hold[board_]] :=
Table[showSquare[{i, j}, board[[i, j]]], {i, 3, 14}, {j, 3, 25}];
showDropBlock[n_, p_, x_, y_] :=
Table[If[allBlocks[[n, p, i, j]] != 0,
showSquare[{i + x, j + y}, allBlocks[[n, p, i, j]]], Black], {i,
1, 4}, {j, 1, 4}];
updateBoard[n_, p_, x_, y_,
Hold[board_, score_]] := {Table[
board[[i + x, j + y]] += allBlocks[[n, p, i, j]], {i, 1, 4}, {j,
1, 4}]; score +=
10 + 100*(2^
Sum[updateLine[i, Hold[board]], {i, y + 4, y + 1, -1}] -
1)};
updateLine[line_, Hold[board_]] :=
If[line <= 23 &&
line >= 4 && (Apply[And,
Table[board[[i, line]] != 0, {i, 4, 13}]]) == True,
Table[board[[i, j]] = board[[i, j + 1]], {i, 4, 13}, {j, line,
22}]; Table[board[[i, 23]] = 0, {i, 4, 13}]; 1, 0];
newGame[Hold[n_, p_, x_, y_, board_, nextItem_, gameOver_, pause_,
num_]] := {initBoard[
Hold[board, num]]; {n, p, x, y} = {nextItem, 2, 6, 22};
nextItem = RandomInteger[6] + 1; gameOver = False; pause = False};
newBlock[Hold[n_, p_, x_, y_, board_, score_, gameOver_, nextItem_,
pause_]] := {If[! pause && ! gameOver,
updateBoard[n, p, x, y, Hold[board, score]];
gameOver = bGameOver[nextItem, 2, Hold[board]];
If[gameOver == False, {n, p, x, y} = {nextItem, 2, 6, 22};
nextItem = RandomInteger[6] + 1]]};
shapeDescend[Hold[level_, state_, num_]] :=
DynamicModule[{score = 0, gameOver = False, pause = False,
board = Table[
If[i <= 3 || j <= 3 || i >= 14 || j >= 24, 0, 0], {i, 1,
16}, {j, 1, 28}], n, p, x, y, nextItem},
SeedRandom[level*10 + num]; nextItem = RandomInteger[6] + 1;
newGame[Hold[n, p, x, y, board, nextItem, gameOver, pause, num]];
EventHandler[
Graphics[{Text[Style["Level", Blue, Italic, 24], {18, 12}],
Text[Style["Score", Blue, Italic, 24], {18, 9}],
Table[showSquare[{i + 16, j + 13}, smallBoard[[i, j]]], {i, 1,
6}, {j, 1, 6}],
Dynamic[Refresh[
Switch[state, 1,
newGame[Hold[n, p, x, y, board, nextItem, gameOver, pause,
num]]; state = 3,
2, pause = True,
3, pause = False], UpdateInterval -> Infinity,
TrackedSymbols -> {state}];
Refresh[If[! pause && ! gameOver &&
bDown[n, p, x, y, Hold[board]], y--,
newBlock[
Hold[n, p, x, y, board, score, gameOver, nextItem, pause]]],
UpdateInterval -> 3./level, TrackedSymbols -> {}];
Join[{{Text[
Style[ToString[level], Green, Italic, 24], {20, 11}],
Text[Style[ToString[score], Green, Italic, 24], {20, 8}]}},
showBoard[Hold[board]], showDropBlock[n, p, x, y],
showHintBlock[nextItem, 2, 17, 14]],
TrackedSymbols -> {x, y, n, p, level}]}, Background -> Black,
ImageSize -> {400, 400}], {"LeftArrowKeyDown" :>
If[! pause && ! gameOver && bLeft[n, p, x, y, Hold[board]], x--],
"RightArrowKeyDown" :>
If[! pause && ! gameOver && bRight[n, p, x, y, Hold[board]],
x++], "DownArrowKeyDown" :> (If[! pause && ! gameOver &&
bRotateClockwise[n, p, x, y, Hold[board]], p++;
If[p == 5, p = 1]]),
"UpArrowKeyDown" :> (If[! pause && ! gameOver &&
bRotateAnticlock[n, p, x, y, Hold[board]], p--;
If[p == 0, p = 4]]), {"KeyDown", " "} :>
If[! pause && ! gameOver && bDown[n, p, x, y, Hold[board]], y--,
newBlock[
Hold[n, p, x, y, board, score, gameOver, nextItem, pause]]],
"EscapeKeyDown" :> {newGame[
Hold[n, p, x, y, board, nextItem, gameOver, pause, num]]}}]];
Manipulate[
shapeDescend[Hold[level, state, initLine]],
{{level, 5}, 1, 9, 1},
{{initLine, 3, "height of bottom level"}, 0, 9, 1},
{{state, 3, ""}, {1 -> "new game", 2 -> "pause", 3 -> "continue"}},
ContentSize -> {480, 450}, SynchronousUpdating -> False,
SaveDefinitions -> True, Alignment -> Center, TrackedSymbols -> {}]