vertexcite/Game2048.elm

## game2048-Elm.html
<html>

<head>
<title>Game - 2048 - in Elm</title>
<script type="text/javascript" src="elm.js"></script>

</head>

<body>
<div id="game2048" style="width:100%; height:100%;"></div>
</body>

<script type="text/javascript">
var game2048Div = document.getElementById('game2048');
Elm.embed(Elm.Game2048, game2048Div, { seed: Math.floor(Math.random() * Math.pow(2, 32))} );
</script>

</html>

## Game2048.elm
module Game2048 where

import Graphics.Collage as Collage
import Keyboard
import Random
import Transform2D as TF
import List exposing (..)
import Color exposing (rgb, green, black, grey)
import Graphics.Element exposing (show, color, centered, Element)
import Graphics.Collage exposing (Form)
import Text exposing (fromString)
import Signal exposing (..)

---- Button Imports

import Char
import Color exposing (..)
import Graphics.Element exposing (..)
import Graphics.Input as Input
import Result
import String
import Text
import Window
import Signal exposing ((<~), (~))


---- Touch Imports

import Touch.Cardinal as Cardinal
import Touch.Gestures as Gestures

import Window

dim : Int
dim = 4

--Represent each square of the game
type alias GridSquare = {contents: Int, x:Int, y:Int}

--The whole game is just the list of squares
type alias Grid = List GridSquare

--Represent different states of play possible
type PlayState = Playing | GameWon | GameLost

type alias History = List Grid

type alias GameState = (PlayState, Grid, History, Random.Seed)

--Get the color for a particular number's square
colorFor n = case n of
  2 -> rgb 238 238 218
  4 -> rgb 237 224 200
  8 -> rgb 242 177 121
  16 -> rgb 245 149 99
  32 -> rgb 246 130 96
  64 -> rgb 246 94 59
  128 -> rgb 237 207 114
  256 -> rgb 237 204 97
  512 -> rgb 237 201 82
  1024 -> rgb 237 197 63
  2048 -> rgb 237 194 46
  _ -> green

--Get the scale factor for a number
--More digits means bigger number
--We assume none have 5 digits
scaleForNumber n = if
  | n >= 1000 -> 1/60.0
  | n >= 100 -> 1/30.0
  | n >= 10 -> 1/20.0
  | otherwise -> 1/15.0

--Apply a function n times
--We use this for shifting: we shift squares as much as we can
--By shifting them 1 square dim times
apply : Int -> (a -> a) -> (a -> a)
apply n f =
  if | n == 0 -> f
     | otherwise -> f << apply (n-1) f

--Get the square at a given position in the grid
squareAt : Grid -> (Int, Int) -> Maybe GridSquare
squareAt grid (x,y) = case List.filter (\sq -> sq.x == x && sq.y == y) grid of
  [] -> Nothing
  [sq] -> Just sq

--Get square's coordinates as a tuple (x, y)
squareCoord : GridSquare -> (Int, Int)
squareCoord sq = (sq.x, sq.y)

--Returns true if the grid has a 2048
has2048 : Grid -> Bool
has2048 grid = case List.filter (\sq -> sq.contents >= 2048) grid of
    [] -> False
    _ -> True

--Delete a square from a given position, if it exists
deleteSquare : (Int, Int) -> Grid -> Grid
deleteSquare (x,y) = List.filter (\sq -> not <| sq.x == x && sq.y == y)

--Double the value of a given square
--Fails if the square does not exist
doubleSquare : (Int, Int) -> Grid -> Grid
doubleSquare coords grid = let
    sq = case squareAt grid coords of
      Just s -> s
    removedGrid = deleteSquare coords grid
  in ({sq | contents <- sq.contents*2} :: removedGrid)

type alias Direction = GridSquare -> GridSquare

flipy : GridSquare -> GridSquare
flipy sq =  {sq | y <- dim - sq.y + 1}

transpose : GridSquare -> GridSquare
transpose sq = {sq | y <- sq.x, x <- sq.y }

up : Direction
up = identity
-- up , sorting = \sq ->  sq.y, atEdge = \sq -> sq.y == dim }

down : Direction
down = flipy

right : Direction
right = transpose

-- Could have used left = flipy . transpose, but then would need to reverse the effect of left with a different transform.  This one is its own inverse.
left : Direction
left sq = {sq | y <- dim - sq.x + 1, x <- dim - sq.y + 1}

move : GridSquare -> GridSquare
move sq = {sq | y <- sq.y + 1}

atEdge: GridSquare -> Bool
atEdge sq = sq.y == dim

--If there's an empty spot in target space (i.e. above, below, etc.)
--Shift the given square into it, otherwise put it in its original place
--Takes in a "partial" grid of squares (above or below, etc.) already placed
shiftSquare :  GridSquare -> Grid -> Grid
shiftSquare sq grid =
  if atEdge sq
    then (sq :: grid)
    else case squareAt grid (squareCoord (move sq)) of
      Nothing -> (move sq :: grid)
      _ -> (sq :: grid)

--Functions to shift the squares for each time the player moves
--To move down, a square moves to the position in the grid where
--Except when squares get combined
--Similar math is performed for left, right, etc.
shift : Grid -> Grid
shift grid = let
    shiftFold = (foldr (shiftSquare) []) << (sortBy (\sq -> sq.y))
  in (apply dim shiftFold) grid --apply dim times, move as far as can

--Functions to look at a given square, and see if it can be merged with
--the square above (below, left of, right of) it
--Note that we sort in the opposite order of shifting
--Since if we're moving up, the bottom square gets absorbed
mergeSquare : GridSquare -> Grid -> Grid
mergeSquare sq grid = case squareAt grid (squareCoord (move sq)) of
  Nothing -> (sq::grid)
  Just adj ->
    if adj.contents == sq.contents
      then doubleSquare (squareCoord (move sq)) grid
      else (sq::grid)

--Apply the merges to tiles in the correct order
applyInOrder mergeFun sortFun = (foldl mergeFun []) << sortFun

--Given a grid and a square, see if that square can be merged
--by moving up (down, left, right) and if so, do the merge
--And double the tile that absorbs it
mergeGrid = applyInOrder mergeSquare (sortBy (\sq -> -sq.y))


newTile : Grid -> Int -> Maybe GridSquare
newTile g n = let coord = case blanks g of
      [] -> Nothing
      bs -> Just <| nth1 (n % length bs) bs
  in case coord of
    Nothing -> Nothing
    Just (x,y) -> Just {x=x, y=y, contents = 2 * (1 + (n % 2)) }

blanks : Grid -> List (Int,Int)
blanks g = let f x = case squareAt g x of
    Nothing -> True
    _       -> False
  in List.filter f allTiles

makeMove : Direction -> Grid -> Grid
makeMove dir grid = List.map dir <| shift <| mergeGrid <| shift <| List.map dir grid

direction : Cardinal.Direction -> Maybe Direction
direction move =
  case move of
    Cardinal.Right -> Just right
    Cardinal.Left  -> Just left
    Cardinal.Up    -> Just up
    Cardinal.Down  -> Just down
    _ -> Nothing

--Given the current state of the game, and a change in input from the user
--Generate the new state of the game
coreUpdate : Maybe Direction -> GameState -> GameState
coreUpdate mdir ((_, grid, hist, seed) as gs) =
  case mdir of
    Nothing -> gs
    Just dir ->
      let
        penUpdatedGrid = makeMove dir grid
      in
        if sameGrid penUpdatedGrid grid then gs
          else if has2048 penUpdatedGrid && (not <| has2048 grid) then (GameWon, penUpdatedGrid, grid :: hist, seed)
            else
              let (n, seed') = Random.generate (Random.int 1 Random.maxInt) seed
              in case (newTile penUpdatedGrid n) of
                Just t -> let updatedGrid = t::penUpdatedGrid
                  in if canMove updatedGrid then (Playing, updatedGrid, grid :: hist, seed') else (GameLost, updatedGrid, grid :: hist, seed)
                Nothing -> if canMove grid then gs else (GameLost, penUpdatedGrid, grid :: hist, seed)

sameGrid : Grid -> Grid -> Bool
sameGrid g1 g2 =
  if length g1 /= length g2 then False else
    let
      hasMatchingSquareInGrid1 s2 = case squareAt g1 (squareCoord s2) of
        Nothing -> False
        Just s1 -> s1.contents == s2.contents
    in all hasMatchingSquareInGrid1 g2

canMove : Grid -> Bool
canMove grid =  let
    possibleGrids : List Grid
    possibleGrids = List.map (\x -> makeMove x grid) [up, down, left, right]
    live : Grid -> Bool
    live x = not (sameGrid grid x)
  in any live possibleGrids

--The different coordinates and value a new tile can have
--We randomly permute this to add new tiles to the board
allTiles : List (Int, Int)
allTiles = product [1..dim] [1..dim]

product : List a -> List b -> List (a,b)
product a b = concatMap (\x -> List.map (\y -> (x,y)) b) a

startGrid : Random.Seed -> Grid
startGrid seed = let
    (n, _) = Random.generate (Random.int 1 Random.maxInt) seed
    m1 = newTile [] n
    m2 = case m1 of
      Just t1 -> newTile [t1] (n // 2)
      _ -> Nothing
  in case (m1, m2) of
    (Nothing, _) -> []
    (Just t1, _) ->
      case m2 of
        Just t2 -> [t1, t2]
        _ -> [t1]

startState : Random.Seed -> GameState
startState seed = (Playing, startGrid seed, [], seed)

--Extracts the nth element of a list, starting at 0
--Fails on empty lists
nth1 : Int -> List a -> a
nth1 n (h::t) = case n of
  0 -> h
  _ -> nth1 (n-1) t

-- --------------- Everything above this line is pure functional, below is FRP, rendering, or utils for those -------------------
offset : Float
offset = (toFloat dim)/2.0 + 0.5

--Draw an individual square, and translate it into the right position
--We assume each square is 1 "unit" wide, and positioned somewhere in [1,dim]*[1,dim]
drawSquare : GridSquare -> Form
drawSquare square = let
    rawSquare = Collage.filled (colorFor square.contents) <| Collage.square 0.9
    numElem = Collage.scale (scaleForNumber square.contents)<| Collage.toForm <| show square.contents
    completeSquare = Collage.group [rawSquare, numElem]
  in Collage.move (toFloat square.x, toFloat square.y) completeSquare

--Convert the list of squares to a Form to be drawn
drawGrid : Grid -> Form
drawGrid grid = let
    gridForms = List.map drawSquare grid
    background =  Collage.move (offset, offset) <| Collage.filled black <| Collage.square (toFloat dim)
  in Collage.group <| [background]++gridForms

drawMessageAndGrid : String -> Grid -> Form
drawMessageAndGrid message grid = let messageForm = Collage.move (offset, offset) <| Collage.scale (1/40.0) <| Collage.toForm <| color grey (centered <| fromString message )
    in Collage.group [drawGrid grid, messageForm ]

--Given a game state, convert it to a form to be drawn
drawGame : GameState -> Form
drawGame (playState, grid, _, _) = case playState of
  Playing -> drawGrid grid
  GameLost -> drawMessageAndGrid "GameOver" grid
  GameWon -> drawMessageAndGrid "Congratulations!" grid

arrows : Signal Cardinal.Direction
arrows = merge (Cardinal.fromArrows <~ Keyboard.arrows) Gestures.ray

--Datatype wrapping all of our input signals together
--Has moves from the user, and a random ordering of squares
type Input = Move Cardinal.Direction | ButtonAction ()

inputSignal : Signal Input
inputSignal = merge (Move <~ arrows) (ButtonAction <~ commands.signal)

updateGameState : Input -> GameState -> GameState
updateGameState input ((_, grid, history, seed) as state) =
  if grid == [] then
    let (n, seed') = Random.generate (Random.int 1 Random.maxInt) seed in (Playing, startGrid seed, [], seed')
  else case input of
         Move (Cardinal.Nowhere) -> state
         Move move -> coreUpdate (direction move) state
         ButtonAction _ ->
           case history of
             []    -> state
             g::gs -> (Playing, g, gs, seed)

port seed : Int

gameState : Signal GameState
gameState = foldp updateGameState (startState (Random.initialSeed seed)) inputSignal

rawFormList : Signal (List Form)
rawFormList = (\x -> [drawGame x]) <~ gameState

scaleFor : Int -> Int -> Float
scaleFor x y = (toFloat (min x y))/(2 * toFloat dim)

makeTform : (Int, Int) -> TF.Transform2D
makeTform (x,y) = TF.multiply (TF.translation (toFloat x/(-(toFloat dim))) (toFloat y/(-(toFloat dim)) )) (TF.scale <| scaleFor x y)

tform : Signal TF.Transform2D
tform = makeTform <~ Window.dimensions

gameForm : Signal Form
gameForm = Collage.groupTransform <~ tform ~ rawFormList

formList : Signal (List Form)
formList = (\x -> [x]) <~ gameForm

collageFunc : Signal (List Form -> Element)
collageFunc = (\(x,y) -> Collage.collage x y) <~ Window.dimensions

--Wrap everything together: take the game state
--Get the form to draw it, transform it into screen coordinates
--Then convert it to an Element and draw it to the screen
main1 = collageFunc ~ formList

-- main2 = show <~ gameState -- Useful for debugging
-- main = Graphics.Element.above <~ main1 ~ main2
main = Graphics.Element.above  (simpleButton "Undo") <~ main1


------------- Button, based on calculator example from Elm examples.


commands : Signal.Mailbox ()
commands = Signal.mailbox ()

buttonSize : number
buttonSize = 300

txt : Float -> Color -> String -> Element
txt p clr string =
    Text.fromString string
      |> Text.color clr
      |> Text.typeface ["Helvetica Neue","Sans-serif"]
      |> Text.height (p * buttonSize)
      |> leftAligned


button : Color -> Color -> Int -> Int -> String -> Element
button background foreground w h name =
    let n = min w h
        btn alpha =
            layers [ container n n middle (txt 0.3 foreground name)
                      |> container (w-1) (h-1) midLeft
                      |> color background
                      |> container w h bottomRight
                      |> color black
                   , color (rgba 0 0 0 alpha) (spacer w h)
                   ]
    in  Input.customButton (Signal.message commands.address ()) (btn 0) (btn 0.05) (btn 0.1)

simpleButton : String -> Element
simpleButton name = button grey black buttonSize buttonSize name


## license:LICENSE
--2048 in Elm
--Originally written by Joey Eremondi
--jmitdase@gmail.com
--Majorly revised by Randall Britten
--Based on 2048 by Gabriele Cirulli
--which was based on 1024 by Veewo Studio
--and similar to Threes by Asher Vollme

{- Original version Copyright (c) 2014, Joey Eremondi,
   Revisions Copyright (c) 2014, Randall Britten

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Joey Eremondi nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
	<html>

	<head>
	<title>Game - 2048 - in Elm</title>
	<script type="text/javascript" src="elm.js"></script>

	</head>

	<body>
	<div id="game2048" style="width:100%; height:100%;"></div>
	</body>

	<script type="text/javascript">
	var game2048Div = document.getElementById('game2048');
	Elm.embed(Elm.Game2048, game2048Div, { seed: Math.floor(Math.random() * Math.pow(2, 32))} );
	</script>

	</html>
	module Game2048 where

	import Graphics.Collage as Collage
	import Keyboard
	import Random
	import Transform2D as TF
	import List exposing (..)
	import Color exposing (rgb, green, black, grey)
	import Graphics.Element exposing (show, color, centered, Element)
	import Graphics.Collage exposing (Form)
	import Text exposing (fromString)
	import Signal exposing (..)

	---- Button Imports

	import Char
	import Color exposing (..)
	import Graphics.Element exposing (..)
	import Graphics.Input as Input
	import Result
	import String
	import Text
	import Window
	import Signal exposing ((<~), (~))


	---- Touch Imports

	import Touch.Cardinal as Cardinal
	import Touch.Gestures as Gestures

	import Window

	dim : Int
	dim = 4

	--Represent each square of the game
	type alias GridSquare = {contents: Int, x:Int, y:Int}

	--The whole game is just the list of squares
	type alias Grid = List GridSquare

	--Represent different states of play possible
	type PlayState = Playing \| GameWon \| GameLost

	type alias History = List Grid

	type alias GameState = (PlayState, Grid, History, Random.Seed)

	--Get the color for a particular number's square
	colorFor n = case n of
	2 -> rgb 238 238 218
	4 -> rgb 237 224 200
	8 -> rgb 242 177 121
	16 -> rgb 245 149 99
	32 -> rgb 246 130 96
	64 -> rgb 246 94 59
	128 -> rgb 237 207 114
	256 -> rgb 237 204 97
	512 -> rgb 237 201 82
	1024 -> rgb 237 197 63
	2048 -> rgb 237 194 46
	_ -> green

	--Get the scale factor for a number
	--More digits means bigger number
	--We assume none have 5 digits
	scaleForNumber n = if
	\| n >= 1000 -> 1/60.0
	\| n >= 100 -> 1/30.0
	\| n >= 10 -> 1/20.0
	\| otherwise -> 1/15.0

	--Apply a function n times
	--We use this for shifting: we shift squares as much as we can
	--By shifting them 1 square dim times
	apply : Int -> (a -> a) -> (a -> a)
	apply n f =
	if \| n == 0 -> f
	\| otherwise -> f << apply (n-1) f

	--Get the square at a given position in the grid
	squareAt : Grid -> (Int, Int) -> Maybe GridSquare
	squareAt grid (x,y) = case List.filter (\sq -> sq.x == x && sq.y == y) grid of
	[] -> Nothing
	[sq] -> Just sq

	--Get square's coordinates as a tuple (x, y)
	squareCoord : GridSquare -> (Int, Int)
	squareCoord sq = (sq.x, sq.y)

	--Returns true if the grid has a 2048
	has2048 : Grid -> Bool
	has2048 grid = case List.filter (\sq -> sq.contents >= 2048) grid of
	[] -> False
	_ -> True

	--Delete a square from a given position, if it exists
	deleteSquare : (Int, Int) -> Grid -> Grid
	deleteSquare (x,y) = List.filter (\sq -> not <\| sq.x == x && sq.y == y)

	--Double the value of a given square
	--Fails if the square does not exist
	doubleSquare : (Int, Int) -> Grid -> Grid
	doubleSquare coords grid = let
	sq = case squareAt grid coords of
	Just s -> s
	removedGrid = deleteSquare coords grid
	in ({sq \| contents <- sq.contents*2} :: removedGrid)

	type alias Direction = GridSquare -> GridSquare

	flipy : GridSquare -> GridSquare
	flipy sq = {sq \| y <- dim - sq.y + 1}

	transpose : GridSquare -> GridSquare
	transpose sq = {sq \| y <- sq.x, x <- sq.y }

	up : Direction
	up = identity
	-- up , sorting = \sq -> sq.y, atEdge = \sq -> sq.y == dim }

	down : Direction
	down = flipy

	right : Direction
	right = transpose

	-- Could have used left = flipy . transpose, but then would need to reverse the effect of left with a different transform. This one is its own inverse.
	left : Direction
	left sq = {sq \| y <- dim - sq.x + 1, x <- dim - sq.y + 1}

	move : GridSquare -> GridSquare
	move sq = {sq \| y <- sq.y + 1}

	atEdge: GridSquare -> Bool
	atEdge sq = sq.y == dim

	--If there's an empty spot in target space (i.e. above, below, etc.)
	--Shift the given square into it, otherwise put it in its original place
	--Takes in a "partial" grid of squares (above or below, etc.) already placed
	shiftSquare : GridSquare -> Grid -> Grid
	shiftSquare sq grid =
	if atEdge sq
	then (sq :: grid)
	else case squareAt grid (squareCoord (move sq)) of
	Nothing -> (move sq :: grid)
	_ -> (sq :: grid)

	--Functions to shift the squares for each time the player moves
	--To move down, a square moves to the position in the grid where
	--Except when squares get combined
	--Similar math is performed for left, right, etc.
	shift : Grid -> Grid
	shift grid = let
	shiftFold = (foldr (shiftSquare) []) << (sortBy (\sq -> sq.y))
	in (apply dim shiftFold) grid --apply dim times, move as far as can

	--Functions to look at a given square, and see if it can be merged with
	--the square above (below, left of, right of) it
	--Note that we sort in the opposite order of shifting
	--Since if we're moving up, the bottom square gets absorbed
	mergeSquare : GridSquare -> Grid -> Grid
	mergeSquare sq grid = case squareAt grid (squareCoord (move sq)) of
	Nothing -> (sq::grid)
	Just adj ->
	if adj.contents == sq.contents
	then doubleSquare (squareCoord (move sq)) grid
	else (sq::grid)

	--Apply the merges to tiles in the correct order
	applyInOrder mergeFun sortFun = (foldl mergeFun []) << sortFun

	--Given a grid and a square, see if that square can be merged
	--by moving up (down, left, right) and if so, do the merge
	--And double the tile that absorbs it
	mergeGrid = applyInOrder mergeSquare (sortBy (\sq -> -sq.y))


	newTile : Grid -> Int -> Maybe GridSquare
	newTile g n = let coord = case blanks g of
	[] -> Nothing
	bs -> Just <\| nth1 (n % length bs) bs
	in case coord of
	Nothing -> Nothing
	Just (x,y) -> Just {x=x, y=y, contents = 2 * (1 + (n % 2)) }

	blanks : Grid -> List (Int,Int)
	blanks g = let f x = case squareAt g x of
	Nothing -> True
	_ -> False
	in List.filter f allTiles

	makeMove : Direction -> Grid -> Grid
	makeMove dir grid = List.map dir <\| shift <\| mergeGrid <\| shift <\| List.map dir grid

	direction : Cardinal.Direction -> Maybe Direction
	direction move =
	case move of
	Cardinal.Right -> Just right
	Cardinal.Left -> Just left
	Cardinal.Up -> Just up
	Cardinal.Down -> Just down
	_ -> Nothing

	--Given the current state of the game, and a change in input from the user
	--Generate the new state of the game
	coreUpdate : Maybe Direction -> GameState -> GameState
	coreUpdate mdir ((_, grid, hist, seed) as gs) =
	case mdir of
	Nothing -> gs
	Just dir ->
	let
	penUpdatedGrid = makeMove dir grid
	in
	if sameGrid penUpdatedGrid grid then gs
	else if has2048 penUpdatedGrid && (not <\| has2048 grid) then (GameWon, penUpdatedGrid, grid :: hist, seed)
	else
	let (n, seed') = Random.generate (Random.int 1 Random.maxInt) seed
	in case (newTile penUpdatedGrid n) of
	Just t -> let updatedGrid = t::penUpdatedGrid
	in if canMove updatedGrid then (Playing, updatedGrid, grid :: hist, seed') else (GameLost, updatedGrid, grid :: hist, seed)
	Nothing -> if canMove grid then gs else (GameLost, penUpdatedGrid, grid :: hist, seed)

	sameGrid : Grid -> Grid -> Bool
	sameGrid g1 g2 =
	if length g1 /= length g2 then False else
	let
	hasMatchingSquareInGrid1 s2 = case squareAt g1 (squareCoord s2) of
	Nothing -> False
	Just s1 -> s1.contents == s2.contents
	in all hasMatchingSquareInGrid1 g2

	canMove : Grid -> Bool
	canMove grid = let
	possibleGrids : List Grid
	possibleGrids = List.map (\x -> makeMove x grid) [up, down, left, right]
	live : Grid -> Bool
	live x = not (sameGrid grid x)
	in any live possibleGrids

	--The different coordinates and value a new tile can have
	--We randomly permute this to add new tiles to the board
	allTiles : List (Int, Int)
	allTiles = product [1..dim] [1..dim]

	product : List a -> List b -> List (a,b)
	product a b = concatMap (\x -> List.map (\y -> (x,y)) b) a

	startGrid : Random.Seed -> Grid
	startGrid seed = let
	(n, _) = Random.generate (Random.int 1 Random.maxInt) seed
	m1 = newTile [] n
	m2 = case m1 of
	Just t1 -> newTile [t1] (n // 2)
	_ -> Nothing
	in case (m1, m2) of
	(Nothing, _) -> []
	(Just t1, _) ->
	case m2 of
	Just t2 -> [t1, t2]
	_ -> [t1]

	startState : Random.Seed -> GameState
	startState seed = (Playing, startGrid seed, [], seed)

	--Extracts the nth element of a list, starting at 0
	--Fails on empty lists
	nth1 : Int -> List a -> a
	nth1 n (h::t) = case n of
	0 -> h
	_ -> nth1 (n-1) t

	-- --------------- Everything above this line is pure functional, below is FRP, rendering, or utils for those -------------------
	offset : Float
	offset = (toFloat dim)/2.0 + 0.5

	--Draw an individual square, and translate it into the right position
	--We assume each square is 1 "unit" wide, and positioned somewhere in [1,dim]*[1,dim]
	drawSquare : GridSquare -> Form
	drawSquare square = let
	rawSquare = Collage.filled (colorFor square.contents) <\| Collage.square 0.9
	numElem = Collage.scale (scaleForNumber square.contents)<\| Collage.toForm <\| show square.contents
	completeSquare = Collage.group [rawSquare, numElem]
	in Collage.move (toFloat square.x, toFloat square.y) completeSquare

	--Convert the list of squares to a Form to be drawn
	drawGrid : Grid -> Form
	drawGrid grid = let
	gridForms = List.map drawSquare grid
	background = Collage.move (offset, offset) <\| Collage.filled black <\| Collage.square (toFloat dim)
	in Collage.group <\| [background]++gridForms

	drawMessageAndGrid : String -> Grid -> Form
	drawMessageAndGrid message grid = let messageForm = Collage.move (offset, offset) <\| Collage.scale (1/40.0) <\| Collage.toForm <\| color grey (centered <\| fromString message )
	in Collage.group [drawGrid grid, messageForm ]

	--Given a game state, convert it to a form to be drawn
	drawGame : GameState -> Form
	drawGame (playState, grid, _, _) = case playState of
	Playing -> drawGrid grid
	GameLost -> drawMessageAndGrid "GameOver" grid
	GameWon -> drawMessageAndGrid "Congratulations!" grid

	arrows : Signal Cardinal.Direction
	arrows = merge (Cardinal.fromArrows <~ Keyboard.arrows) Gestures.ray

	--Datatype wrapping all of our input signals together
	--Has moves from the user, and a random ordering of squares
	type Input = Move Cardinal.Direction \| ButtonAction ()

	inputSignal : Signal Input
	inputSignal = merge (Move <~ arrows) (ButtonAction <~ commands.signal)

	updateGameState : Input -> GameState -> GameState
	updateGameState input ((_, grid, history, seed) as state) =
	if grid == [] then
	let (n, seed') = Random.generate (Random.int 1 Random.maxInt) seed in (Playing, startGrid seed, [], seed')
	else case input of
	Move (Cardinal.Nowhere) -> state
	Move move -> coreUpdate (direction move) state
	ButtonAction _ ->
	case history of
	[] -> state
	g::gs -> (Playing, g, gs, seed)

	port seed : Int

	gameState : Signal GameState
	gameState = foldp updateGameState (startState (Random.initialSeed seed)) inputSignal

	rawFormList : Signal (List Form)
	rawFormList = (\x -> [drawGame x]) <~ gameState

	scaleFor : Int -> Int -> Float
	scaleFor x y = (toFloat (min x y))/(2 * toFloat dim)

	makeTform : (Int, Int) -> TF.Transform2D
	makeTform (x,y) = TF.multiply (TF.translation (toFloat x/(-(toFloat dim))) (toFloat y/(-(toFloat dim)) )) (TF.scale <\| scaleFor x y)

	tform : Signal TF.Transform2D
	tform = makeTform <~ Window.dimensions

	gameForm : Signal Form
	gameForm = Collage.groupTransform <~ tform ~ rawFormList

	formList : Signal (List Form)
	formList = (\x -> [x]) <~ gameForm

	collageFunc : Signal (List Form -> Element)
	collageFunc = (\(x,y) -> Collage.collage x y) <~ Window.dimensions

	--Wrap everything together: take the game state
	--Get the form to draw it, transform it into screen coordinates
	--Then convert it to an Element and draw it to the screen
	main1 = collageFunc ~ formList

	-- main2 = show <~ gameState -- Useful for debugging
	-- main = Graphics.Element.above <~ main1 ~ main2
	main = Graphics.Element.above (simpleButton "Undo") <~ main1





	------------- Button, based on calculator example from Elm examples.


	commands : Signal.Mailbox ()
	commands = Signal.mailbox ()

	buttonSize : number
	buttonSize = 300

	txt : Float -> Color -> String -> Element
	txt p clr string =
	Text.fromString string
	\|> Text.color clr
	\|> Text.typeface ["Helvetica Neue","Sans-serif"]
	\|> Text.height (p * buttonSize)
	\|> leftAligned


	button : Color -> Color -> Int -> Int -> String -> Element
	button background foreground w h name =
	let n = min w h
	btn alpha =
	layers [ container n n middle (txt 0.3 foreground name)
	\|> container (w-1) (h-1) midLeft
	\|> color background
	\|> container w h bottomRight
	\|> color black
	, color (rgba 0 0 0 alpha) (spacer w h)
	]
	in Input.customButton (Signal.message commands.address ()) (btn 0) (btn 0.05) (btn 0.1)

	simpleButton : String -> Element
	simpleButton name = button grey black buttonSize buttonSize name
	--2048 in Elm
	--Originally written by Joey Eremondi
	--jmitdase@gmail.com
	--Majorly revised by Randall Britten
	--Based on 2048 by Gabriele Cirulli
	--which was based on 1024 by Veewo Studio
	--and similar to Threes by Asher Vollme

	{- Original version Copyright (c) 2014, Joey Eremondi,
	Revisions Copyright (c) 2014, Randall Britten

	All rights reserved.

	Redistribution and use in source and binary forms, with or without
	modification, are permitted provided that the following conditions are met:

	* Redistributions of source code must retain the above copyright
	notice, this list of conditions and the following disclaimer.

	* Redistributions in binary form must reproduce the above
	copyright notice, this list of conditions and the following
	disclaimer in the documentation and/or other materials provided
	with the distribution.

	* Neither the name of Joey Eremondi nor the names of other
	contributors may be used to endorse or promote products derived
	from this software without specific prior written permission.

	THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
	LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
	A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
	OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
	SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
	LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
	DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
	THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
	(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
	OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
	-}