Source code in the elm programming language

module Main exposing (..)

import Html exposing (Html, div, p, text, button, span, h2)
import Html.Attributes exposing (class, style)
import Html.Events exposing (onClick)
import Keyboard exposing (KeyCode)
import Random
import Tuple


main =
    Html.program
        { init = ( { initialModel | waitingForRandom = True }, generateRandomTiles 2 )
        , view = view
        , update = update
        , subscriptions = always (Keyboard.downs KeyPress)
        }



-- MODEL


-- tiles either have a value (2, 4, 8, ...) or are empty
type alias Tile =
    Maybe Int


type alias Model =
    { score : Int
    , tiles : List Tile
    , hasLost : Bool
    , winKeepPlaying : Bool
    , waitingForRandom : Bool -- prevent user from giving input while waiting for Random Cmd to return
    }


initialModel : Model
initialModel =
    { score = 0, tiles = List.repeat 16 Nothing, waitingForRandom = False, hasLost = False, winKeepPlaying = False}



-- UPDATE


type alias RandomTileInfo =
    ( Int, Int )


type Msg
    = KeyPress KeyCode
    | AddRandomTiles (List RandomTileInfo)
    | NewGame
    | KeepPlaying



-- asks the random generator to generate the information required for later adding random tiles
-- generate a random position for the and value (4 10%, 2 90%) for each tile 
-- this uses Random.pair and Random.list to get a variable number of such pairs with one Cmd
generateRandomTiles : Int -> Cmd Msg
generateRandomTiles num =
    let
        randomPosition =
            Random.int 0 15

        randomValue =
            Random.int 1 10
                |> Random.map
                    (\rnd ->
                        if rnd == 10 then
                            4
                        else
                            2
                    )

        -- 10% chance
        randomPositionAndValue =
            Random.pair randomPosition randomValue
    in
        Random.list num randomPositionAndValue |> Random.generate AddRandomTiles



-- actually add a random tile to the model
addRandomTile : RandomTileInfo -> List Tile -> List Tile
addRandomTile ( newPosition, newValue ) tiles =
    let
        -- newPosition is a value between 0 and 15
        -- go through the list and count the amount of empty tiles we've seen.
        -- if we reached the newPosition % emptyTileCount'th empty tile, set its value to newValue
        emptyTileCount =
            List.filter ((==) Nothing) tiles |> List.length

        -- if there are less than 16 empty tiles this is the number of empty tiles we pass
        targetCount =
            newPosition % emptyTileCount

        set_ith_empty_tile tile ( countEmpty, newList ) =
            case tile of
                Just value ->
                    ( countEmpty, (Just value) :: newList )

                Nothing ->
                    if countEmpty == targetCount then
                        -- replace this empty tile with the new value
                        ( countEmpty + 1, (Just newValue) :: newList )
                    else
                        ( countEmpty + 1, Nothing :: newList )
    in
        List.foldr set_ith_empty_tile ( 0, [] ) tiles |> Tuple.second



-- core game mechanic: move numbers (to the left,
-- moving to the right is equivalent to moving left on the reversed array)
-- this function works on single columns/rows
moveNumbers : List Tile -> ( List Tile, Int )
moveNumbers tiles =
    let
        last =
            List.head << List.reverse
    
        -- init is to last what tail is to head
        init =
           List.reverse << List.drop 1 << List.reverse

        doMove tile ( newTiles, addScore ) =
            case tile of
                -- omit empty tiles when shifting
                Nothing ->
                    ( newTiles, addScore )

                Just value ->
                    case last newTiles of
                        -- if the last already moved tile ...
                        Just (Just value2) ->
                            -- ... has the same value, add a tile with the summed value
                            if value == value2 then
                                ( (init newTiles) ++ [ Just (2 * value) ]
                                , addScore + 2 * value )
                            else
                                -- ... else just add the tile
                                ( newTiles ++ [ Just value ], addScore )

                        _ ->
                            -- ... else just add the tile
                            ( newTiles ++ [ Just value ], addScore )

        ( movedTiles, addScore ) =
            List.foldl doMove ( [], 0 ) tiles
    in
        ( movedTiles ++ List.repeat (4 - List.length movedTiles) Nothing, addScore )


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        -- new game button press
        NewGame ->
            if not model.waitingForRandom then
                ( { initialModel | waitingForRandom = True }, generateRandomTiles 2 )
            else
                ( model, Cmd.none )

        -- "keep playing" button on win screen
        KeepPlaying ->
            ( { model | winKeepPlaying = True }, Cmd.none)

        -- Random generator Cmd response
        AddRandomTiles tileInfos ->
            let
                newTiles =
                    List.foldl addRandomTile model.tiles tileInfos
            in
                ( { model | tiles = newTiles, waitingForRandom = False }, Cmd.none )


        KeyPress code ->
            let
                -- zip list and indices, apply filter, unzip
                indexedFilter func list =
                    List.map2 (,) (List.range 0 (List.length list - 1)) list
                        |> List.filter func
                        |> List.map Tuple.second

                -- the i'th row (of 4) contains elements i*4, i*4+1, i*4+2, i*4+3
                -- so all elements for which index//4 == i
                i_th_row list i =
                    indexedFilter (((==) i) << (flip (//) 4) << Tuple.first) list

                -- the i'th col (of 4) contain elements i, i+4, i+2*4, i+3*4
                -- so all elements for which index%4 == i
                i_th_col list i =
                    indexedFilter (((==) i) << (flip (%) 4) << Tuple.first) list
            
                -- rows and columns of the grid
                rows list =
                    List.map (i_th_row list) (List.range 0 3)

                cols list =
                    List.map (i_th_col list) (List.range 0 3)

                -- move each row or column and unzip the results from each call to moveNumbers
                move =
                    List.unzip << List.map moveNumbers

                moveReverse =
                    List.unzip << List.map (Tuple.mapFirst List.reverse << moveNumbers << List.reverse)

                -- concat rows back into a flat array and sum all addScores
                unrows =
                    Tuple.mapSecond List.sum << Tuple.mapFirst List.concat

                -- turn columns back into a flat array and sum all addScores
                uncols =
                    Tuple.mapSecond List.sum << Tuple.mapFirst (List.concat << cols << List.concat)
    
    
                -- when shifting left or right each row can be (reverse-) shifted separately
                -- when shifting up or down each column can be (reveerse-) shifted separately
                ( newTiles, addScore ) =
                    case code of
                        37 ->
                            -- left
                            unrows <| move <| rows model.tiles

                        38 ->
                            -- up
                            uncols <| move <| cols model.tiles

                        39 ->
                            -- right
                            unrows <| moveReverse <| rows model.tiles

                        40 ->
                            -- down
                            uncols <| moveReverse <| cols model.tiles

                        _ ->
                            ( model.tiles, 0 )
                
               
                containsEmptyTiles =
                    List.any ((==) Nothing)
                    
                containsAnySameNeighbours : List Tile -> Bool
                containsAnySameNeighbours list =
                    let
                        tail = List.drop 1 list
                        init = List.reverse <| List.drop 1 <| List.reverse list
                    in
                        List.any (uncurry (==)) <| List.map2 (,) init tail
                hasLost =
                     -- grid full
                    (not (containsEmptyTiles newTiles))
                        -- and no left/right move possible
                        && (not <| List.any containsAnySameNeighbours <| rows newTiles)
                        -- and no up/down move possible
                        && (not <| List.any containsAnySameNeighbours <| cols newTiles)

                ( cmd, waiting ) =
                    if List.all identity <| List.map2 (==) model.tiles newTiles then
                        ( Cmd.none, False )
                    else
                        ( generateRandomTiles 1, True )

                score =
                    model.score + addScore
            in
                -- unsure whether this actually happens but regardless:
                -- keep the program from accepting a new keyboard input when a new tile hasn't been spawned yet
                if model.waitingForRandom then
                    ( model, Cmd.none )
                else
                    ( { model | tiles = newTiles, waitingForRandom = waiting, score = score, hasLost = hasLost }, cmd )




-- VIEW


containerStyle : List ( String, String )
containerStyle =
    [ ( "width", "450px" )
    , ( "height", "450px" )
    , ( "background-color", "#bbada0" )
    , ( "float", "left" )
    , ( "border-radius", "6px")
    ]


tileStyle : Int -> List ( String, String )
tileStyle value =
    let
        color =
            case value of
                0 ->
                    "#776e65"

                2 ->
                    "#eee4da"

                4 ->
                    "#ede0c8"

                8 ->
                    "#f2b179"

                16 ->
                    "#f59563"

                32 ->
                    "#f67c5f"

                64 ->
                    "#f65e3b"

                128 ->
                    "#edcf72"

                256 ->
                    "#edcc61"

                512 ->
                    "#edc850"

                1024 ->
                    "#edc53f"

                2048 ->
                    "#edc22e"

                _ ->
                    "#edc22e"
    in
        [ ( "width", "100px" )
        , ( "height", "70px" )
        , ( "background-color", color )
        , ( "float", "left" )
        , ( "margin-left", "10px" )
        , ( "margin-top", "10px" )
        , ( "padding-top", "30px" )
        , ( "text-align", "center" )
        , ( "font-size", "30px" )
        , ( "font-weight", "bold" )
        , ( "border-radius", "6px")
        ]


viewTile : Tile -> Html Msg
viewTile tile =
    div [ style <| tileStyle <| Maybe.withDefault 0 tile ]
        [ span [] [ text <| Maybe.withDefault "" <| Maybe.map toString tile ]
        ]


viewGrid : List Tile -> Html Msg
viewGrid tiles =
    div [ style containerStyle ] <| List.map viewTile tiles


viewLost : Html Msg
viewLost =
    div
        [ style containerStyle ]
        [ div
            [ style [ ( "text-align", "center" ) ] ]
            [ h2 [] [ text "You lost!" ]
            ]
        ]

viewWin : Html Msg
viewWin =
    div
        [ style containerStyle ]
        [ div
            [ style [ ( "text-align", "center" ) ] ]
            [ h2 [] [ text "Congratulations, You won!" ]
            , button
                [ style [ ( "margin-bottom", "16px" ), ( "margin-top", "16px" ) ], onClick KeepPlaying ]
                [ text "Keep playing" ]
            ]
        ]


view : Model -> Html Msg
view model =
    div [ style [ ( "width", "450px" ) ] ]
        [ p [ style [ ( "float", "left" ) ] ] [ text <| "Your Score: " ++ toString model.score ]
        , button
            [ style [ ( "margin-bottom", "16px" ), ( "margin-top", "16px" ), ( "float", "right" ) ], onClick NewGame ]
            [ text "New Game" ]
        , if model.hasLost then
            viewLost
          else if List.any ((==) (Just 2048)) model.tiles && not model.winKeepPlaying then
            viewWin
          else
            viewGrid model.tiles
        ]