Task

Implement a 2D sliding block puzzle game where blocks with numbers are combined to add their values.



Rules of the game

   The rules are that on each turn the player must choose a direction   (up, down, left or right).
   All tiles move as far as possible in that direction, some move more than others. 
   Two adjacent tiles (in that direction only) with matching numbers combine into one bearing the sum of those numbers. 
   A move is valid when at least one tile can be moved,   if only by combination. 
   A new tile with the value of   2   is spawned at the end of each turn at a randomly chosen empty square   (if there is one). 
   Adding a new tile on a blank space.   Most of the time,   a new   2   is to be added,   and occasionally   (10% of the time),   a   4.
   To win,   the player must create a tile with the number   2048. 
   The player loses if no valid moves are possible.


The name comes from the popular open-source implementation of this game mechanic, 2048.



Requirements

   "Non-greedy" movement.   
  The tiles that were created by combining other tiles should not be combined again during the same turn (move).   
  That is to say,   that moving the tile row of:
               [2][2][2][2] 

 to the right should result in: 
               ......[4][4] 

 and not:
               .........[8] 

   "Move direction priority".   
  If more than one variant of combining is possible,   move direction shall indicate which combination will take effect. 
  For example, moving the tile row of:
               ...[2][2][2] 

 to the right should result in:
               ......[2][4] 

 and not:
               ......[4][2] 



   Check for valid moves.   The player shouldn't be able to skip their turn by trying a move that doesn't change the board.
   Check for a  win condition.
   Check for a lose condition.


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
        ]
 