# helper functions fun replica(x, y) { if (x == 0) [] else y :: replica(x - 1, y) } sig transpose: ([[a]]) ~> [[a]] fun transpose(xs) { switch (xs) { case ([]::_) -> [] case x -> map(hd, x) :: transpose(map(tl, x)) } } # the game 2048 # ported from https://github.com/gregorulm/h2048/blob/master/h2048.hs typename Grid = [[Int]]; var leftKeyCode = 37; var rightKeyCode = 39; var upKeyCode = 38; var downKeyCode = 40; fun start() { var gridprim = addTile(replica(4, [0, 0, 0, 0])); addTile(gridprim) } fun merge(xs) { fun combine(xx) { switch (xx) { case x::y::xs -> if (x == y) { (x * 2) :: combine(xs) } else { x :: combine(y::xs) } case x -> x } } var merged = combine(filter(fun(x) { not(x == 0) }, xs)); var padding = replica(length(xs) - length(merged), 0); merged ++ padding } fun move(m, grid) { switch (m) { case 37 -> map(merge, grid) # left case 39 -> map(compose(reverse, compose(merge, reverse)), grid) # right case 38 -> transpose(move(37, transpose(grid))) # up case 40 -> transpose(move(39, transpose(grid))) # down case _ -> grid } } fun getZeroes(grid) { fun singleRow(n) { zip(replica(4, n), [0..3]) } var coordinates = concatMap(singleRow, [0..3]); filter(fun ((row, col)) { ((grid !! row) !! col) == 0 }, coordinates) } fun setSquare(grid, (row, col), val) { var pre = take(row, grid); var mid = take(col, (grid !! row)) ++ [val] ++ drop((col + 1), (grid !! row)); var post = drop((row + 1), grid); pre ++ [mid] ++ post } fun isMoveLeft(grid) { var directions = [leftKeyCode, rightKeyCode, upKeyCode, downKeyCode]; var allChoices = map(compose(length, compose(getZeroes, fun (dir) { move(dir, grid) })), directions); sum(allChoices) > 0 } fun printGrid(grid) client { replaceNode(
{ concatMap(showRow, grid) }
, getNodeById("grid") ) } fun showRow(r) client {
{ showRowHelper(r) }
} fun showRowHelper(r) client { for (x <- r) <#>
{ if (x == 0) stringToXml("") else stringToXml(intToString(x)) }
} fun check2048(grid) { not([] == filter(fun (x) { x == 2048 }, concat(grid))) } fun addTile(grid) { var candidates = getZeroes(grid); var pick = choose(candidates); var val = choose([2,2,2,2,2,2,2,2,2,4]); var newGridprim = setSquare(grid, pick, val); newGridprim } fun choose(xs) { var i = floatToInt(random() *. intToFloat(length(xs) - 1)); xs !! i } fun newGrid(grid, msg) { var newGridprim = move(msg, grid); newGridprim } fun gameLoop(grid) { printGrid(grid); if (isMoveLeft(grid)) { if (check2048(grid)) { replaceNode(
You win!
, getNodeById("win")); replaceNode(
, getNodeById("n")) } else { var newGridprim = move(recv(), grid); if (not(grid == newGridprim)) { var new = addTile(newGridprim); gameLoop(new) } else { gameLoop(grid) } } } else { replaceNode(
You lose!
, getNodeById("lose")); replaceNode(
, getNodeById("n")) } } fun mesg(str) { replaceNode(
{stringToXml(str)}
, getNodeById("msg") ) } fun main() { var grid = start(); var gameProc = spawnClient { gameLoop(grid) }; page

2048 in Links

Click on the board to play.
The board must be focused for the input to work.
} main()