Skip to content

Instantly share code, notes, and snippets.

@vertexcite

vertexcite/Game2048.elm

Forked from JoeyEremondi/game2048.elm
Last active August 29, 2015 14:01
Show Gist options
  • Save vertexcite/d12af786c4ca35285d26 to your computer and use it in GitHub Desktop.
Save vertexcite/d12af786c4ca35285d26 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
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>
Raw
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
Raw
license:LICENSE
--2048 in Elm
--Originally written by Joey Eremondi
[email protected]
--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.
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment