defmodule Game2048 do
  @size 4
  @range [email protected]

  def play(goal \\ 2048), do: setup() |> play(goal)

  defp play(board, goal) do
    show(board)
    cond do
      goal in Map.values(board) ->
          IO.puts "You win!"
          exit(:normal)
      0 in Map.values(board) or combinable?(board) ->
          moved = move(board, keyin())
          if moved == board, do: play(board, goal), else: add_tile(moved) |> play(goal)
      true ->
          IO.puts "Game Over!"
          exit(:normal)
    end
  end

  defp setup do
    (for i <- @range, j <- @range, into: %{}, do: {{i,j},0})
    |> add_tile
    |> add_tile
  end

  defp add_tile(board) do
    position = blank_space(board) |> Enum.random
    tile = if :rand.uniform(10)==1, do: 4, else: 2
    %{board | position => tile}
  end

  defp blank_space(board) do
    for {key, 0} <- board, do: key
  end

  defp keyin do
    key = IO.gets("key in wasd or q: ")
    case String.first(key) do
      "w" -> :up
      "a" -> :left
      "s" -> :down
      "d" -> :right
      "q" -> exit(:normal)
      _   -> keyin()
    end
  end

  defp move(board, :up) do
    Enum.reduce(@range, board, fn j,acc ->
      Enum.map(@range, fn i -> acc[{i,j}] end)
      |> move_and_combine
      |> Enum.with_index
      |> Enum.reduce(acc, fn {v,i},map -> Map.put(map, {i,j}, v) end)
    end)
  end
  defp move(board, :down) do
    Enum.reduce(@range, board, fn j,acc ->
      Enum.map(@size-1..0, fn i -> acc[{i,j}] end)
      |> move_and_combine
      |> Enum.reverse
      |> Enum.with_index
      |> Enum.reduce(acc, fn {v,i},map -> Map.put(map, {i,j}, v) end)
    end)
  end
  defp move(board, :left) do
    Enum.reduce(@range, board, fn i,acc ->
      Enum.map(@range, fn j -> acc[{i,j}] end)
      |> move_and_combine
      |> Enum.with_index
      |> Enum.reduce(acc, fn {v,j},map -> Map.put(map, {i,j}, v) end)
    end)
  end
  defp move(board, :right) do
    Enum.reduce(@range, board, fn i,acc ->
      Enum.map(@size-1..0, fn j -> acc[{i,j}] end)
      |> move_and_combine
      |> Enum.reverse
      |> Enum.with_index
      |> Enum.reduce(acc, fn {v,j},map -> Map.put(map, {i,j}, v) end)
    end)
  end

  defp move_and_combine(tiles) do
    (Enum.filter(tiles, &(&1>0)) ++ [0,0,0,0])
    |> Enum.take(@size)
    |> case do
         [a,a,b,b] -> [a*2, b*2, 0, 0]
         [a,a,b,c] -> [a*2, b, c, 0]
         [a,b,b,c] -> [a, b*2, c, 0]
         [a,b,c,c] -> [a, b, c*2, 0]
         x         -> x
       end
  end

  defp combinable?(board) do
    Enum.any?(for i <- @range, j <- [email protected], do: board[{i,j}]==board[{i,j+1}]) or
    Enum.any?(for j <- @range, i <- [email protected], do: board[{i,j}]==board[{i+1,j}])
  end

  @frame   String.duplicate("+----", @size) <> "+"
  @format (String.duplicate("|~4w", @size) <> "|") |> to_charlist   # before 1.3 to_char_list

  defp show(board) do
    Enum.each(@range, fn i ->
      IO.puts @frame
      row = for j <- @range, do: board[{i,j}]
      IO.puts (:io_lib.fwrite @format, row) |> to_string |> String.replace(" 0|", "  |")
    end)
    IO.puts @frame
  end
end

Game2048.play 512


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
        ]


// the board is represented with a list of 16 integers
let empty = List.init 16 (fun _ -> 0)
let win = List.contains 2048

// a single movement (a hit) consists of stacking and then possible joining
let rec stack = function
    | 0 :: t -> stack t @ [0]
    | h :: t -> h :: stack t
    | [] -> []
let rec join = function
    | a :: b :: c when a = b -> (a + b :: join c) @ [0]
    | a :: b -> a :: join b
    | [] -> []
let hit = stack >> join
let hitBack = List.rev >> hit >> List.rev
let rows = List.chunkBySize 4
let left = rows >> List.map hit >> List.concat
let right = rows >> List.map hitBack >> List.concat
let up = rows >> List.transpose >> List.map hit >> List.transpose >> List.concat
let down = rows >> List.transpose >> List.map hitBack >> List.transpose >> List.concat

let lose g = left g = g && right g = g && up g = g && down g = g

// spawn a 2 or occasionally a 4 at a random unoccupied position
let random = System.Random()
let spawnOn g =
    let newTileValue = if random.Next 10 = 0 then 4 else 2
    let numZeroes = List.filter ((=) 0) >> List.length
    let newPosition = g |> numZeroes |> random.Next
    let rec insert what where = function
        | 0 :: tail when numZeroes tail = where -> what :: tail
        | h :: t -> h :: insert what where t
        | [] -> []
    insert newTileValue newPosition g

let show =
    let line = List.map (sprintf "%4i") >> String.concat " "
    rows >> List.map line >> String.concat "\n" >> printf "\n%s\n"

// use an empty list as a sign of user interrupt
let quit _ = []
let quitted = List.isEmpty

let dispatch = function | 'i' -> up | 'j' -> left | 'k' -> down | 'l' -> right | 'q' -> quit | _ -> id
let key() = System.Console.ReadKey().KeyChar |> char
let turn state =
    show state
    let nextState = (key() |> dispatch) state
    if nextState <> state && not (quitted nextState) then spawnOn nextState else nextState

let play() =
    let mutable state = spawnOn empty
    while not (win state || lose state || quitted state) do state <- turn state
    if quitted state then printfn "User interrupt" else
        show state
        if win state then printf "You win!"
        if lose state then printf "You lose!"

play()


USE: accessors
FROM: arrays => <array> array ;
FROM: assocs => assoc-filter keys zip ;
FROM: combinators => case cleave cond ;
FROM: combinators.short-circuit => 1|| 1&& 2&& ;
FROM: continuations => cleanup ;
FROM: formatting => printf sprintf ;
FROM: fry => '[ _ ;
FROM: grouping => all-equal? clump group ;
FROM: io => bl flush nl readln write ;
FROM: kernel => = 2bi 2dup 2drop and bi bi* [email protected] boa boolean clone equal? dip drop dup if if* keep loop nip not over swap throw tri unless when with xor ;
FROM: math => integer times * + > >= ;
FROM: math.functions => ^ ;
FROM: math.parser => hex> ;
FROM: math.order => +lt+ +gt+ +eq+ ;
FROM: random => random sample ;
FROM: sequences => <iota> <repetition> any? all? append concat each first flip head if-empty interleave length map pop push reduce reverse second set-nth tail ;
FROM: sorting => sort ;
FROM: vectors => <vector> ;
IN: 2048-game

ERROR: invalid-board ;

SYMBOL: left
SYMBOL: right
SYMBOL: up
SYMBOL: down

TUPLE: tile
{ level integer }
;

TUPLE: board
{ width integer }
{ height integer }
{ tiles array }
;

M: tile equal?
    {
        [ and ] ! test for f
        [ [ level>> ] [email protected] = ]
    }
    2&&
;

: valid-board? ( w h -- ? )
    * 0 > ! board with 0 tiles does not have a meaningful representation
;

: <board> ( w h -- board )
    [ valid-board? [ invalid-board throw ] unless ]
    [ 2dup * f <array> board boa ] 2bi
;

: <tile> ( n -- tile )
    tile boa
;

! 1 in 10 tile starts as 4
: new-tile ( -- tile )
    10 random 0 = [ 2 ] [ 1 ] if
    <tile>
;

<PRIVATE

: space-left? ( board -- ? )
    tiles>> [ f = ] any?
;

: rows>> ( board -- seq )
    dup tiles>>
    [ drop { } ] [ swap width>> group ] if-empty
;

: rows<< ( seq board -- )
    [ concat ] dip tiles<<
;

: columns>> ( board -- seq )
    rows>> flip
;

: columns<< ( seq board -- )
    [ flip concat ] dip tiles<<
;

: change-rows ( board quote -- board )
    over [ rows>> swap call( seq -- seq ) ] [ rows<< ] bi
; inline

: change-columns ( board quote -- board )
    over [ columns>> swap call( seq -- seq ) ] [ columns<< ] bi
; inline

: can-move-left? ( seq -- ? )
    {
        ! one element seq cannot move
        [ length 1 = not ]
        ! empty seq cannot move
        [ [ f = ] all? not ]
        [ 2 clump
            [
                {
                    ! test for identical adjescent tiles
                    [ [ first ] [ second ] bi [ and ] [ = ] 2bi and ]
                    ! test for empty space on the left and tile on the right
                    [ [ first ] [ second ] bi [ xor ] [ drop f = ] 2bi and ]
                } 1||
            ] any?
        ]
    } 1&&
;

: can-move-direction? ( board direction -- ? )
    {
        { left  [ rows>>    [         can-move-left? ] any? ] }
        { right [ rows>>    [ reverse can-move-left? ] any? ] }
        { up    [ columns>> [         can-move-left? ] any? ] }
        { down  [ columns>> [ reverse can-move-left? ] any? ] }
    } case
;

: can-move-any? ( board -- ? )
    { left right up down } [ can-move-direction? ] with any?
;

: empty-indices ( seq -- seq )
    [ length <iota> ] keep zip
    [ nip f = ] assoc-filter keys
;

: pick-random ( seq -- elem )
    1 sample first
;

! create a new tile on an empty space
: add-tile ( board -- )
    [ new-tile swap [ empty-indices pick-random ] keep [ set-nth ] keep ] change-tiles drop
;

! combines equal tiles justified right or does nothing
: combine-tiles ( tile1 tile2 -- tile3 tile4 )
    2dup { [ and ] [ = ] } 2&&
    [ drop [ 1 + ] change-level f swap ] when
;

: justify-left ( seq -- seq )
    [
        {
            { [ dup  f = ] [ 2drop +lt+ ] }
            { [ over f = ] [ 2drop +gt+ ] }
            [ 2drop +eq+ ]
        } cond
    ] sort
;

: collapse ( seq -- seq )
    justify-left

    ! combine adjescent
    dup length <vector>
    [ over
        [ swap [ push ] keep ]
        [
            {
                [ pop combine-tiles ]
                [ push ]
                [ push ]
            } cleave
        ] if-empty
    ] reduce

    ! fill in the gaps after combination
    justify-left
;

! draws an object
GENERIC: draw ( obj -- )

PRIVATE>

! a single tile is higher than 2048 (level 10)
: won? ( board -- ? )
    tiles>> [ dup [ level>> 11 >= ] when ] any?
;

! if there is no space left and no neightboring tiles are the same, end the board
: lost? ( board -- ? )
    {
        [ space-left? ]
        [ won? ]
        [ can-move-any? ]
    } 1|| not
;

: serialize ( board -- str )
    [ width>> ]
    [ height>> ]
    [ tiles>>
        [ dup f = [ drop 0 ] [ level>> ] if "%02x" sprintf ] map concat
    ] tri
    "%02x%02x%s" sprintf
;

: deserialize ( str -- board )
    [ 2 head hex> ] [ 2 tail ] bi
    [ 2 head hex> ] [ 2 tail ] bi
    2 group [ hex> dup 0 = [ drop f ] [ tile boa ] if ] map
    board boa
;

: move ( board direction -- )
    {
        { left  [ [ [         collapse         ] map ] change-rows    ] }
        { right [ [ [ reverse collapse reverse ] map ] change-rows    ] }
        { up    [ [ [         collapse         ] map ] change-columns ] }
        { down  [ [ [ reverse collapse reverse ] map ] change-columns ] }
    } case drop
;

: get-input ( -- line )
    readln
;

: parse-input ( line -- direction/f )
    {
        { "a" [ left  ] }
        { "d" [ right ] }
        { "w" [ up    ] }
        { "s" [ down  ] }
        { "q" [ f ] }
        [ "Wrong input: %s\n" printf flush
          get-input parse-input ]
    } case
;

<PRIVATE

: init ( board -- )
    '[ _ add-tile ] 2 swap times
;

M: tile draw ( tile -- )
    level>> 2 swap ^ "% 4d" printf
;

M: boolean draw ( _ -- )
    drop 4 [ bl ] times
;

: horizontal-line ( board -- )
    width>>
    " " write
    "+------" <repetition> concat
    write "+ " write nl
;

: separator ( -- )
    " | " write
;

M: board draw ( board -- )
    [ horizontal-line ] keep
    [ rows>> ]
    [
       '[ _ horizontal-line ]
        [   separator
            [ separator ] [ draw ] interleave
            separator nl
        ] interleave
    ]
    [ horizontal-line ]
    tri
    flush
;

: update ( board -- f )
    {
        [
            get-input parse-input [
                {
                    [ can-move-direction? ]
                    [ over [ move ] [ add-tile ] bi* t ]
                } 2&& drop t
            ] [ drop f ] if*
        ]
        [ can-move-any? ]
    } 1&&
;

: exit ( board -- )
    {
        { [ dup lost? ] [ "You lost! Better luck next time." write nl ] }
        { [ dup won?  ] [ "You won! Congratulations!" write nl ] }
        [ "Bye!" write nl ]
    } cond drop
;

PRIVATE>

: start-2048 ( -- )
    4 4 <board>
    [
        ! Initialization
        [ init ]
        [ draw ]
        ! Event loop
        [ [ dup [ update ] [ draw ] bi ] loop ] tri
    ]
    ! Cleanup
    [ exit ]
    [ ]
    cleanup
;

MAIN: start-2048


\ in Forth, you do many things on your own. This word is used to define 2D arrays
: 2D-ARRAY ( height width )
	CREATE DUP ,
	* CELLS ALLOT
	DOES> ( y x baseaddress )
		ROT    ( x baseaddress y )
		OVER @ ( x baseaddress y width )
		*      ( x baseaddress y*width )
		ROT    ( baseaddress y*width x )
		+ 1+ CELLS +
;

require random.fs
HERE SEED !

0 CONSTANT D-INVALID
1 CONSTANT D-UP
2 CONSTANT D-DOWN
3 CONSTANT D-LEFT
4 CONSTANT D-RIGHT

4 CONSTANT NROWS
4 CONSTANT NCOLS

NROWS NCOLS * CONSTANT GRIDSIZE
NROWS NCOLS 2D-ARRAY GRID
CREATE HAVE-MOVED CELL ALLOT
CREATE TOTAL-SCORE CELL ALLOT
CREATE MOVE-SCORE CELL ALLOT

: DIE-DIRECTIONCONST ." Unknown direction constant:" . BYE ;
: ESC #ESC EMIT ;
: CLS
	ESC ." [2J"
	ESC ." [H"
;

: GRID-VALUE 1 SWAP LSHIFT ;
: DASHES 0 ?DO [CHAR] - EMIT LOOP ;

: DRAW ( -- )
	CLS ." Score: "
	TOTAL-SCORE @ 0 U.R
	MOVE-SCORE  @ ?DUP IF
		."  (+" 0 U.R ." )"
	THEN
	CR 25 DASHES CR

	NROWS 0 ?DO
		." |"
		NCOLS 0 ?DO
			J I GRID @ ?DUP IF
				GRID-VALUE 4 U.R
			ELSE
				4 SPACES
			THEN
			."  |"
		LOOP
		CR
	LOOP

	25 DASHES CR
;

: COUNT-FREE-SPACES ( -- free-spaces )
	0 ( count )
	NROWS 0 ?DO
		NCOLS 0 ?DO
			J I GRID @ 0= IF 1+ THEN
		LOOP
	LOOP
;

: GET-FREE-SPACE ( index -- addr )
	0 0 GRID SWAP ( curr-addr index )
	0 0 GRID @ 0<> IF 1+ THEN
	0 ?DO ( find the next free space index times )
		BEGIN
			CELL+ DUP @ 0=
		UNTIL
	LOOP
;

: NEW-BLOCK ( -- )
	COUNT-FREE-SPACES
	DUP 0<= IF DROP EXIT THEN
	RANDOM GET-FREE-SPACE
	10 RANDOM 0= IF 2 ELSE 1 THEN SWAP !
;

: 2GRID ( a-y a-x b-y b-x -- a-addr b-addr ) GRID -ROT GRID SWAP ;
: CAN-MERGE ( dest-addr other-addr -- can-merge? )
	@ SWAP @ ( other-val dest-val )
	DUP 0<> -ROT = AND
;

: CAN-GRAVITY ( dest-addr other-addr -- can-gravity? )
	@ SWAP @ ( other-val dest-val )
	0= SWAP 0<> AND
;

: TRY-MERGE ( dest-y dest-x other-y other-x -- )
	2GRID ( dest-addr other-addr )
	2DUP CAN-MERGE IF
		TRUE HAVE-MOVED !
		0 SWAP ! ( dest-addr )
		DUP @ 1+ DUP ( dest-addr dest-val dest-val )
		ROT ! ( dest-val )
		GRID-VALUE DUP ( score-diff score-diff )
		MOVE-SCORE +!
		TOTAL-SCORE +!
	ELSE
		2DROP
	THEN
;

: TRY-GRAVITY ( did-something-before operator dest-y dest-x other-y other-x -- did-something-after operator )
	2GRID ( ... dest-addr other-addr )
	2DUP CAN-GRAVITY IF
		TRUE HAVE-MOVED !
		DUP @ ( ... dest-addr other-addr other-val )
		ROT ( ... other-addr other-val dest-addr ) ! ( ... other-addr )
		0 SWAP !
		NIP TRUE SWAP
	ELSE
		2DROP
	THEN
;

: TRY-LOST? ( lost-before operator dy dx oy ox -- lost-after operator )
	2GRID CAN-MERGE INVERT ( lost-before operator lost-now )
	ROT AND SWAP ( lost-after operator )
;

: MOVEMENT-LOOP ( direction operator -- ) CASE
	SWAP
	D-UP OF NROWS 1- 0 ?DO
		NCOLS 0 ?DO
			J I J 1+ I 4 PICK EXECUTE
		LOOP
	LOOP ENDOF
	D-DOWN OF 1 NROWS 1- ?DO
		NCOLS 0 ?DO
			J I J 1- I 4 PICK EXECUTE
		LOOP
	-1 +LOOP ENDOF
	D-LEFT OF NCOLS 1- 0 ?DO
		NROWS 0 ?DO
			I J I J 1+ 4 PICK EXECUTE
		LOOP
	LOOP ENDOF
	D-RIGHT OF 1 NCOLS 1- ?DO
		NROWS 0 ?DO
			I J I J 1- 4 PICK EXECUTE
		LOOP
	-1 +LOOP ENDOF
	DIE-DIRECTIONCONST
ENDCASE DROP ;

: MERGE ( move -- ) ['] TRY-MERGE MOVEMENT-LOOP ;
: GRAVITY-ONCE ( move -- success? ) FALSE SWAP ['] TRY-GRAVITY MOVEMENT-LOOP ;
: GRAVITY ( move -- )
	BEGIN
		DUP GRAVITY-ONCE INVERT
	UNTIL DROP
;

: MOVE-LOST? ( move -- lost? ) TRUE SWAP ['] TRY-LOST? MOVEMENT-LOOP ;
: END-IF-LOST ( -- lost? )
	COUNT-FREE-SPACES 0= IF
		TRUE
		5 1 DO I MOVE-LOST? AND LOOP
		IF ." You lose!" CR BYE THEN
	THEN
;

: END-IF-WON ( -- )
	NROWS 0 ?DO
		NCOLS 0 ?DO
			J I GRID @ GRID-VALUE 2048 = IF ." You win!" CR BYE THEN
		LOOP
	LOOP
;

: TICK ( move -- )
	FALSE HAVE-MOVED !
	0 MOVE-SCORE !
	DUP GRAVITY DUP MERGE GRAVITY
	HAVE-MOVED @ IF NEW-BLOCK DRAW THEN
	END-IF-WON
	END-IF-LOST
;

: GET-MOVE ( -- move )
	BEGIN
		KEY CASE
			#EOF OF BYE ENDOF
			#ESC OF BYE ENDOF
			[CHAR] q OF BYE ENDOF
			[CHAR] Q OF BYE ENDOF
			[CHAR] k OF D-UP TRUE ENDOF
			[CHAR] K OF D-UP TRUE ENDOF
			[CHAR] j OF D-DOWN TRUE ENDOF
			[CHAR] J OF D-DOWN TRUE ENDOF
			[CHAR] h OF D-LEFT TRUE ENDOF
			[CHAR] H OF D-LEFT TRUE ENDOF
			[CHAR] l OF D-RIGHT TRUE ENDOF
			[CHAR] L OF D-RIGHT TRUE ENDOF
			FALSE SWAP
		ENDCASE
	UNTIL
;

: INIT ( -- )
	NROWS 0 ?DO
		NCOLS 0 ?DO
			0 J I GRID !
		LOOP
	LOOP

	0 TOTAL-SCORE !
	0 MOVE-SCORE !
	NEW-BLOCK
	NEW-BLOCK
	DRAW
;

: MAIN-LOOP ( -- )
	BEGIN
		GET-MOVE TICK
	AGAIN
;

INIT
MAIN-LOOP


        WRITE (MSG,1)		!Roll forth a top/bottom boundary. No corner characters (etc.), damnit.
    1   FORMAT ("|",<NC>(<W>("-"),"|"))	!Heavy reliance on runtime values in NC and W. But see FORMAT 22.
    2     FORMAT ("|",<NC>(<W>(" "),"|"))	!No horizontal markings within a tile. See FORMAT 1.
          WRITE (MSG,22) ((" ",L1  = 1,W),"|",C = 1,NC)	!Compare to FORMAT 2.
   22     FORMAT ("|",666A1)				!A constant FORMAT, a tricky WRITE.
    4     FORMAT ("|",<NC - 1>(<W>("-"),"+"),<W>("-"),"|")	!With internal + rather than |.


#define EXTCHAR Chr(255)

'--- Declaration of global variables ---
Dim Shared As Integer gGridSize = 4  'grid size (4 -> 4x4)
Dim Shared As Integer gGrid(gGridSize, gGridSize)
Dim Shared As Integer gScore
Dim Shared As Integer curX, curY
Dim Shared As Integer hasMoved, wasMerge
' Don't touch these numbers, seriously
Dim Shared As Integer gOriginX, gOriginY
gOriginX = 75 'pixel X of top left of grid
gOriginY = 12 'pixel Y of top right of grida
Dim Shared As Integer gTextOriginX, gTextOriginY, gSquareSide
gTextOriginX = 11
gTextOriginY = 3
gSquareSide = 38 'width/height of block in pixels

'set up all the things!
Dim Shared As Integer gDebug = 0

'--- SUBroutines and FUNCtions ---
Sub addblock
    Dim As Integer emptyCells(gGridSize * gGridSize, 2)
    Dim As Integer emptyCellCount = 0
    Dim As Integer x, y, index, num

    For x = 0 To gGridSize - 1
        For y = 0 To gGridSize - 1
            If gGrid(x, y) = 0 Then
                emptyCells(emptyCellCount, 0) = x
                emptyCells(emptyCellCount, 1) = y
                emptyCellCount += 1
            End If
        Next y
    Next x

    If emptyCellCount > 0 Then
        index = Int(Rnd * emptyCellCount)
        num = Cint(Rnd + 1) * 2
        gGrid(emptyCells(index, 0), emptyCells(index, 1)) = num
    End If
End Sub

Function pad(num As Integer) As String
    Dim As String strNum = Ltrim(Str(num))

    Select Case Len(strNum)
    Case 1: Return "  " + strNum + " "
    Case 2: Return " " + strNum + " "
    Case 3: Return " " + strNum
    Case 4: Return strNum
    End Select
End Function

Sub drawNumber(num As Integer, xPos As Integer, yPos As Integer)
    Dim As Integer c, x, y
    Select Case num
    Case 0:    c = 16
    Case 2:    c = 2
    Case 4:    c = 3
    Case 8:    c = 4
    Case 16:   c = 5
    Case 32:   c = 6
    Case 64:   c = 7
    Case 128:  c = 8
    Case 256:  c = 9
    Case 512:  c = 10
    Case 1024: c = 11
    Case 2048: c = 12
    Case 4096: c = 13
    Case 8192: c = 13
    Case Else: c = 13
    End Select

    x = xPos *(gSquareSide + 2) + gOriginX + 1
    y = yPos *(gSquareSide + 2) + gOriginY + 1
    Line(x + 1, y + 1)-(x + gSquareSide - 1, y + gSquareSide - 1), c, BF

    If num > 0 Then
        Locate gTextOriginY + 1 +(yPos * 5), gTextOriginX +(xPos * 5) : Print "    "
        Locate gTextOriginY + 2 +(yPos * 5), gTextOriginX +(xPos * 5) : Print pad(num)
        Locate gTextOriginY + 3 +(yPos * 5), gTextOriginX +(xPos * 5)
    End If
End Sub

Function getAdjacentCell(x As Integer, y As Integer, d As String) As Integer
    If (d = "l" And x = 0) Or (d = "r" And x = gGridSize - 1) Or (d = "u" And y = 0) Or (d = "d" And y = gGridSize - 1) Then
        getAdjacentCell = -1
    Else
        Select Case d
        Case "l": getAdjacentCell = gGrid(x - 1, y)
        Case "r": getAdjacentCell = gGrid(x + 1, y)
        Case "u": getAdjacentCell = gGrid(x, y - 1)
        Case "d": getAdjacentCell = gGrid(x, y + 1)
        End Select
    End If
End Function

'Draws the outside grid(doesn't render tiles)
Sub initGraphicGrid
    Dim As Integer x, y, gridSide =(gSquareSide + 2) * gGridSize

    Line(gOriginX, gOriginY)-(gOriginX + gridSide, gOriginY + gridSide), 14, BF 'outer square, 3 thick
    Line(gOriginX, gOriginY)-(gOriginX + gridSide, gOriginY + gridSide), 1, B 'outer square, 3 thick
    Line(gOriginX - 1, gOriginY - 1)-(gOriginX + gridSide + 1, gOriginY + gridSide + 1), 1, B
    Line(gOriginX - 2, gOriginY - 2)-(gOriginX + gridSide + 2, gOriginY + gridSide + 2), 1, B

    For x = gOriginX + gSquareSide + 2 To gOriginX +(gSquareSide + 2) * gGridSize Step gSquareSide + 2  ' horizontal lines
        Line(x, gOriginY)-(x, gOriginY + gridSide), 1
    Next x

    For y = gOriginY + gSquareSide + 2 To gOriginY +(gSquareSide + 2) * gGridSize Step gSquareSide + 2 ' vertical lines
        Line(gOriginX, y)-(gOriginX + gridSide, y), 1
    Next y
End Sub

'Init the(data) grid with 0s
Sub initGrid
    Dim As Integer x, y
    For x = 0 To 3
        For y = 0 To 3
            gGrid(x, y) = 0
        Next y
    Next x

    addblock
    addblock
End Sub

Sub moveBlock(sourceX As Integer, sourceY As Integer, targetX As Integer, targetY As Integer, merge As Integer)
    If sourceX < 0 Or sourceX >= gGridSize Or sourceY < 0 Or sourceY >= gGridSize And gDebug = 1 Then
        Locate 0, 0 : Print "moveBlock: source coords out of bounds"
    End If

    If targetX < 0 Or targetX >= gGridSize Or targetY < 0 Or targetY >= gGridSize And gDebug = 1 Then
        Locate 0, 0 : Print "moveBlock: source coords out of bounds"
    End If

    Dim As Integer sourceSquareValue = gGrid(sourceX, sourceY)
    Dim As Integer targetSquareValue = gGrid(targetX, targetY)

    If merge = 1 Then
        If sourceSquareValue = targetSquareValue Then
            gGrid(sourceX, sourceY) = 0
            gGrid(targetX, targetY) = targetSquareValue * 2
            gScore += targetSquareValue * 2 ' Points!
        Elseif gDebug = 1 Then
            Locate 0, 0 : Print "moveBlock: Attempted to merge unequal sqs"
        End If
    Else
        If targetSquareValue = 0 Then
            gGrid(sourceX, sourceY) = 0
            gGrid(targetX, targetY) = sourceSquareValue
        Elseif gDebug = 1 Then
            Locate 0, 0 : Print "moveBlock: Attempted to move to non-empty block"
        End If
    End If
End Sub

Function pColor(r As Integer, g As Integer, b As Integer) As Integer
    Return (r + g * 256 + b * 65536)
End Function

Sub moveToObstacle(x As Integer, y As Integer, direcc As String)
    curX = x : curY = y

    Do While getAdjacentCell(curX, curY, direcc) = 0
        Select Case direcc
        Case "l": curX -= 1
        Case "r": curX += 1
        Case "u": curY -= 1
        Case "d": curY += 1
        End Select
    Loop
End Sub

Sub processBlock(x As Integer, y As Integer, direcc As String)
    Dim As Integer merge = 0, mergeDirX, mergeDirY
    If gGrid(x, y) <> 0 Then ' have block
        moveToObstacle(x, y, direcc) ' figure out where it can be moved to
        If getAdjacentCell(curX, curY, direcc) = gGrid(x, y) And wasMerge = 0 Then  ' obstacle can be merged with
            merge = 1
            wasMerge = 1
        Else
            wasMerge = 0
        End If

        If curX <> x Or curY <> y Or merge = 1 Then
            mergeDirX = 0
            mergeDirY = 0
            If merge = 1 Then
                Select Case direcc
                Case "l": mergeDirX = -1
                Case "r": mergeDirX = 1
                Case "u": mergeDirY = -1
                Case "d": mergeDirY = 1
                End Select
            End If

            moveBlock(x, y, curX + mergeDirX, curY + mergeDirY, merge) ' move to before obstacle or merge
            hasMoved = 1
        End If
    End If
End Sub

Sub renderGrid
    Dim As Integer x, y
    For x = 0 To gGridSize - 1
        For y = 0 To gGridSize - 1
            drawNumber(gGrid(x, y), x, y)
        Next y
    Next x
End Sub

Sub updateScore
    Locate 1, 10 : Print Using "Score: #####"; gScore
End Sub

Sub processMove(direcc As String) '' direcc can be 'l', 'r', 'u', or 'd'
    Dim As Integer x, y
    hasMoved = 0

    If direcc = "l" Then
        For y = 0 To gGridSize - 1
            wasMerge = 0
            For x = 0 To gGridSize - 1
                processBlock(x,y,direcc)
            Next x
        Next y
    Elseif direcc = "r" Then
        For y = 0 To gGridSize - 1
            wasMerge = 0
            For x = gGridSize - 1 To 0 Step -1
                processBlock(x,y,direcc)
            Next x
        Next y
    Elseif direcc = "u" Then
        For x = 0 To gGridSize - 1
            wasMerge = 0
            For y = 0 To gGridSize - 1
                processBlock(x,y,direcc)
            Next y
        Next x
    Elseif direcc = "d" Then
        For x = 0 To gGridSize - 1
            wasMerge = 0
            For y = gGridSize - 1 To 0 Step -1
                processBlock(x,y,direcc)
            Next y
        Next x
    End If

    If hasMoved = 1 Then addblock
    renderGrid
    updateScore
End Sub

'--- Main Program ---
Screen 8
Windowtitle "2048"
Palette 1, pColor(35, 33, 31)
Palette 2, pColor(46, 46, 51)
Palette 3, pColor(59, 56, 50)
Palette 4, pColor(61, 44, 30)
Palette 5, pColor(61, 37, 25)
Palette 6, pColor(62, 31, 24)
Palette 7, pColor(62, 24, 15)
Palette 8, pColor(59, 52, 29)
Palette 9, pColor(59, 51, 24)
Palette 10, pColor(59, 50, 20)
Palette 11, pColor(59, 49, 16)
Palette 12, pColor(59, 49, 12)
Palette 13, pColor(15, 15, 13)
Palette 14, pColor(23, 22, 20)

Randomize Timer
Cls
Do
    initGrid
    initGraphicGrid
    renderGrid
    updateScore

    gScore = 0

    Locate 23, 10 : Print "Move with arrow keys."
    Locate 24, 12 : Print "(R)estart, (Q)uit"

    Dim As String k
    Do
        Do
            k = Inkey
        Loop Until k <> ""

        Select Case k
        Case EXTCHAR + Chr(72) 'up
            processMove("u")
        Case EXTCHAR + Chr(80) 'down
            processMove("d")
        Case EXTCHAR + Chr(77) 'right
            processMove("r")
        Case EXTCHAR + Chr(75) 'left
            processMove("l")
        Case "q", "Q", Chr(27) 'escape
            End
        Case "r", "R"
            Exit Do
        End Select
    Loop
Loop


package main

import (
	"bufio"
	"fmt"
	"log"
	"math/rand"
	"os"
	"os/exec"
	"strconv"
	"strings"
	"text/template"
	"time"
	"unicode"

	"golang.org/x/crypto/ssh/terminal"
)

const maxPoints = 2048
const (
	fieldSizeX = 4
	fieldSizeY = 4
)
const tilesAtStart = 2
const probFor2 = 0.9

type button int

const (
	_ button = iota
	up
	down
	right
	left
	quit
)

var labels = func() map[button]rune {
	m := make(map[button]rune, 4)
	m[up] = 'W'
	m[down] = 'S'
	m[right] = 'D'
	m[left] = 'A'
	return m
}()
var keybinding = func() map[rune]button {
	m := make(map[rune]button, 8)
	for b, r := range labels {
		m[r] = b
		if unicode.IsUpper(r) {
			r = unicode.ToLower(r)
		} else {
			r = unicode.ToUpper(r)
		}
		m[r] = b
	}
	m[0x03] = quit
	return m
}()

var model = struct {
	Score int
	Field [fieldSizeY][fieldSizeX]int
}{}

var view = func() *template.Template {
	maxWidth := 1
	for i := maxPoints; i >= 10; i /= 10 {
		maxWidth++
	}

	w := maxWidth + 3
	r := make([]byte, fieldSizeX*w+1)
	for i := range r {
		if i%w == 0 {
			r[i] = '+'
		} else {
			r[i] = '-'
		}
	}
	rawBorder := string(r)

	v, err := template.New("").Parse(`SCORE: {{.Score}}
{{range .Field}}
` + rawBorder + `
|{{range .}} {{if .}}{{printf "%` + strconv.Itoa(maxWidth) + `d" .}}{{else}}` +
		strings.Repeat(" ", maxWidth) + `{{end}} |{{end}}{{end}}
` + rawBorder + `

(` + string(labels[up]) + `)Up (` +
		string(labels[down]) + `)Down (` +
		string(labels[left]) + `)Left (` +
		string(labels[right]) + `)Right
`)
	check(err)
	return v
}()

func check(err error) {
	if err != nil {
		log.Panicln(err)
	}
}

func clear() {
	c := exec.Command("clear")
	c.Stdout = os.Stdout
	check(c.Run())
}

func draw() {
	clear()
	check(view.Execute(os.Stdout, model))
}

func addRandTile() (full bool) {
	free := make([]*int, 0, fieldSizeX*fieldSizeY)

	for x := 0; x < fieldSizeX; x++ {
		for y := 0; y < fieldSizeY; y++ {
			if model.Field[y][x] == 0 {
				free = append(free, &model.Field[y][x])
			}
		}
	}

	val := 4
	if rand.Float64() < probFor2 {
		val = 2
	}
	*free[rand.Intn(len(free))] = val

	return len(free) == 1
}

type point struct{ x, y int }

func (p point) get() int      { return model.Field[p.y][p.x] }
func (p point) set(n int)     { model.Field[p.y][p.x] = n }
func (p point) inField() bool { return p.x >= 0 && p.y >= 0 && p.x < fieldSizeX && p.y < fieldSizeY }
func (p *point) next(n point) { p.x += n.x; p.y += n.y }

func controller(key rune) (gameOver bool) {
	b := keybinding[key]

	if b == 0 {
		return false
	}
	if b == quit {
		return true
	}

	var starts []point
	var next point

	switch b {
	case up:
		next = point{0, 1}
		starts = make([]point, fieldSizeX)
		for x := 0; x < fieldSizeX; x++ {
			starts[x] = point{x, 0}
		}
	case down:
		next = point{0, -1}
		starts = make([]point, fieldSizeX)
		for x := 0; x < fieldSizeX; x++ {
			starts[x] = point{x, fieldSizeY - 1}
		}
	case right:
		next = point{-1, 0}
		starts = make([]point, fieldSizeY)
		for y := 0; y < fieldSizeY; y++ {
			starts[y] = point{fieldSizeX - 1, y}
		}
	case left:
		next = point{1, 0}
		starts = make([]point, fieldSizeY)
		for y := 0; y < fieldSizeY; y++ {
			starts[y] = point{0, y}
		}
	}

	moved := false
	winning := false

	for _, s := range starts {
		n := s
		move := func(set int) {
			moved = true
			s.set(set)
			n.set(0)
		}
		for n.next(next); n.inField(); n.next(next) {
			if s.get() != 0 {
				if n.get() == s.get() {
					score := s.get() * 2
					model.Score += score
					winning = score >= maxPoints

					move(score)
					s.next(next)
				} else if n.get() != 0 {
					s.next(next)
					if s.get() == 0 {
						move(n.get())
					}
				}
			} else if n.get() != 0 {
				move(n.get())
			}
		}
	}

	if !moved {
		return false
	}

	lost := false
	if addRandTile() {
		lost = true
	Out:
		for x := 0; x < fieldSizeX; x++ {
			for y := 0; y < fieldSizeY; y++ {
				if (y > 0 && model.Field[y][x] == model.Field[y-1][x]) ||
					(x > 0 && model.Field[y][x] == model.Field[y][x-1]) {
					lost = false
					break Out
				}
			}
		}
	}

	draw()

	if winning {
		fmt.Println("You win!")
		return true
	}
	if lost {
		fmt.Println("Game Over")
		return true
	}

	return false
}

func main() {
	oldState, err := terminal.MakeRaw(0)
	check(err)
	defer terminal.Restore(0, oldState)

	rand.Seed(time.Now().Unix())

	for i := tilesAtStart; i > 0; i-- {
		addRandTile()
	}
	draw()

	stdin := bufio.NewReader(os.Stdin)

	readKey := func() rune {
		r, _, err := stdin.ReadRune()
		check(err)
		return r
	}

	for !controller(readKey()) {
	}
}


import System.IO
import Data.List
import Data.Maybe
import Control.Monad
import Data.Random
import Data.Random.Distribution.Categorical
import System.Console.ANSI
import Control.Lens

-- Logic

-- probability to get a 4
prob4 :: Double
prob4 = 0.1

type Position = [[Int]]

combine, shift :: [Int]->[Int]
combine (x:y:l) | x==y = (2*x) : combine l
combine (x:l) = x : combine l
combine [] = []

shift l = take (length l) $ combine (filter (>0) l) ++ [0,0..]

reflect :: [[a]] ->[[a]]
reflect = map reverse

type Move = Position -> Position

left, right, up, down :: Move
left = map shift
right = reflect . left . reflect
up = transpose . left . transpose
down = transpose . right . transpose

progress :: Eq a => (a -> a) -> a -> Maybe a
progress f pos = if pos==next_pos then Nothing else Just next_pos where next_pos= f pos

lost, win:: Position -> Bool
lost pos = all isNothing [progress move pos| move<-[left,right,up,down] ]

win = any $ any (>=2048)

go :: Position -> Maybe Move -> Maybe Position
go pos move = move >>= flip progress pos

{-
-- Adding 2 or 4 without lens:
update l i a = l1 ++ a : l2 where (l1,_:l2)=splitAt i l
indicesOf l = [0..length l-1]

add a x y pos = update pos y $ update (pos !! y) x a

add2or4 ::  Position -> RVar Position
add2or4 pos = do
  (x,y) <-  randomElement [(x,y) | y<-indicesOf pos, x<-indicesOf (pos!!y), pos!!y!!x ==0  ]
  a <- categorical [(0.9::Double,2), (0.1,4) ]
  return $ add a x y pos
-}

-- or with lens:
indicesOf :: [a] -> [ReifiedTraversal' [a] a]
indicesOf l = [ Traversal $ ix i | i <- [0..length l - 1] ]

indices2Of :: [[a]] -> [ReifiedTraversal' [[a]] a]
indices2Of ls = [ Traversal $ i.j | Traversal i <- indicesOf ls, let Just l = ls ^? i, Traversal j <- indicesOf l]

add2or4 ::  Position -> RVar Position
add2or4 pos = do
  xy <-  randomElement [ xy | Traversal xy <- indices2Of pos, pos ^? xy == Just 0 ]
  a <- categorical [(1-prob4, 2), (prob4, 4) ]
  return $  pos & xy .~ a
-- Easy, is'n it'?

-- Main loop
play :: Position -> IO ()
play pos = do
   c <- getChar
   case go pos $ lookup c [('D',left),('C',right),('A',up),('B',down)] of
      Nothing -> play pos
      Just pos1 -> do
         pos2 <- sample $ add2or4 pos1
         draw pos2
         when (win pos2 && not (win pos)) $ putStrLn $ "You win! You may keep going."
         if lost pos2 then putStrLn "You lost!"
            else play pos2

main :: IO ()
main = do
  pos <- sample $ add2or4 $ replicate 4 (replicate 4 0)
  draw pos
  play pos

-- Rendering
-- See https://en.wikipedia.org/wiki/ANSI_escape_code#Colors
colors =
 [(0,"\ESC[38;5;234;48;5;250m     ")
 ,(2,"\ESC[38;5;234;48;5;255m  2  ")
 ,(4,"\ESC[38;5;234;48;5;230m  4  ")
 ,(8,"\ESC[38;5;15;48;5;208m  8  ")
 ,(16,"\ESC[38;5;15;48;5;209m  16 ")
 ,(32,"\ESC[38;5;15;48;5;203m  32 ")
 ,(64,"\ESC[38;5;15;48;5;9m  64 ")
 ,(128,"\ESC[38;5;15;48;5;228m 128 ")
 ,(256,"\ESC[38;5;15;48;5;227m 256 ")
 ,(512,"\ESC[38;5;15;48;5;226m 512 ")
 ,(1024,"\ESC[38;5;15;48;5;221m 1024")
 ,(2048,"\ESC[38;5;15;48;5;220m 2048")
 ,(4096,"\ESC[38;5;15;48;5;0m 4096")
 ,(8192,"\ESC[38;5;15;48;5;0m 8192")
 ,(16384,"\ESC[38;5;15;48;5;0m16384")
 ,(32768,"\ESC[38;5;15;48;5;0m32768")
 ,(65536,"\ESC[38;5;15;48;5;0m65536")
 ,(131072,"\ESC[38;5;15;48;5;90m131072")
 ]

showTile x = fromJust (lookup x colors) ++ "\ESC[B\^H\^H\^H\^H\^H     \ESC[A\ESC[C"

draw :: Position -> IO ()
draw pos = do
  setSGR [Reset]
  clearScreen
  hideCursor
  hSetEcho stdin False
  hSetBuffering stdin NoBuffering
  setSGR [SetConsoleIntensity BoldIntensity]
  putStr "\ESC[38;5;234;48;5;248m" -- set board color
  setCursorPosition 0 0
  replicateM_ 13 $ putStrLn $ replicate 26 ' '
  setCursorPosition 1 1
  putStrLn $ intercalate "\n\n\n\ESC[C" $ concatMap showTile `map` pos


NB. 2048.ijs script
NB. =========================================================
NB. 2048 game engine

require 'guid'
([ 9!:1) _2 (3!:4) , guids 1            NB. randomly set initial random seed

coclass 'g2048'
Target=: 2048

new2048=: verb define
  Gridsz=: 4 4
  Points=: Score=: 0
  Grid=: newnum^:2 ] Gridsz $ 0
)

newnum=: verb define
  num=. 2 4 {~ 0.1 > ?0   NB. 10% chance of 4
  idx=. 4 $. $. 0 = y        NB. indicies of 0s
  if. #idx do.               NB. handle full grid
    idx=. ,/ ({~ 1 ? #) idx  NB. choose an index
    num (<idx)} y
  else. return. y
  end.
)

mskmerge=: [: >/\.&.|. 2 =/\ ,&_1
mergerow=: ((* >:) #~ _1 |. [email protected]]) mskmerge
scorerow=: +/@(+: #~ mskmerge)

compress=: -.&0
toLeft=: 1 :'4&{[email protected]([email protected])"1'
toRight=: 1 : '_4&{[email protected]([email protected]&.|.)"1'
toUp=: 1 : '(4&{[email protected]([email protected])"1)&.|:'
toDown=: 1 : '(_4&{[email protected]([email protected]&.|.)"1)&.|:'

move=: conjunction define
  Points=: +/@, v Grid
  update newnum^:(Grid [email protected]: ]) u Grid
)

noMoves=: (0 [email protected] ,)@(mergerow toRight , mergerow toLeft , mergerow toUp ,: mergerow toDown)
hasWon=: Target e. ,

eval=: verb define
  Score=: Score + Points
  isend=. (noMoves , hasWon) y
  msg=. isend # 'You lost!!';'You Won!!'
  if. -. isend=. +./ isend do.
    Points=: 0
    msg=. 'Score is ',(": Score)
  end.
  isend;msg
)

showGrid=: echo

NB. =========================================================
NB. Console user interface

g2048Con_z_=: conew&'g2048con'

coclass 'g2048con'
coinsert 'g2048'

create=: verb define
  echo Instructions
  startnew y
)

destroy=: codestroy
quit=: destroy

startnew=: [email protected]

left=: 3 :'mergerow toLeft move (scorerow toLeft)'
right=: 3 :'mergerow toRight move (scorerow toRight)'
up=: 3 :'mergerow toUp move (scorerow toUp)'
down=: 3 :'mergerow toDown move (scorerow toDown)'

update=: verb define
  Grid=: y       NB. update global Grid
  'isend msg'=. eval y
  echo msg
  showGrid y
  if. isend do. destroy '' end.
  empty''
)

Instructions=: noun define
=== 2048 ===
Object:
   Create the number 2048 by merging numbers.

How to play:
  When 2 numbers the same touch, they merge.
  - move numbers using the commands below:
       right__grd ''
       left__grd ''
       up__grd ''
       down__grd ''
  - quit a game:
       quit__grd ''
  - start a new game:
       grd=: g2048Con ''
)


import java.awt.*;
import java.awt.event.*;
import java.util.Random;
import javax.swing.*;

public class Game2048 extends JPanel {

    enum State {
        start, won, running, over
    }

    final Color[] colorTable = {
        new Color(0x701710), new Color(0xFFE4C3), new Color(0xfff4d3),
        new Color(0xffdac3), new Color(0xe7b08e), new Color(0xe7bf8e),
        new Color(0xffc4c3), new Color(0xE7948e), new Color(0xbe7e56),
        new Color(0xbe5e56), new Color(0x9c3931), new Color(0x701710)};

    final static int target = 2048;

    static int highest;
    static int score;

    private Color gridColor = new Color(0xBBADA0);
    private Color emptyColor = new Color(0xCDC1B4);
    private Color startColor = new Color(0xFFEBCD);

    private Random rand = new Random();

    private Tile[][] tiles;
    private int side = 4;
    private State gamestate = State.start;
    private boolean checkingAvailableMoves;

    public Game2048() {
        setPreferredSize(new Dimension(900, 700));
        setBackground(new Color(0xFAF8EF));
        setFont(new Font("SansSerif", Font.BOLD, 48));
        setFocusable(true);

        addMouseListener(new MouseAdapter() {
            @Override
            public void mousePressed(MouseEvent e) {
                startGame();
                repaint();
            }
        });

        addKeyListener(new KeyAdapter() {
            @Override
            public void keyPressed(KeyEvent e) {
                switch (e.getKeyCode()) {
                    case KeyEvent.VK_UP:
                        moveUp();
                        break;
                    case KeyEvent.VK_DOWN:
                        moveDown();
                        break;
                    case KeyEvent.VK_LEFT:
                        moveLeft();
                        break;
                    case KeyEvent.VK_RIGHT:
                        moveRight();
                        break;
                }
                repaint();
            }
        });
    }

    @Override
    public void paintComponent(Graphics gg) {
        super.paintComponent(gg);
        Graphics2D g = (Graphics2D) gg;
        g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
                RenderingHints.VALUE_ANTIALIAS_ON);

        drawGrid(g);
    }

    void startGame() {
        if (gamestate != State.running) {
            score = 0;
            highest = 0;
            gamestate = State.running;
            tiles = new Tile[side][side];
            addRandomTile();
            addRandomTile();
        }
    }

    void drawGrid(Graphics2D g) {
        g.setColor(gridColor);
        g.fillRoundRect(200, 100, 499, 499, 15, 15);

        if (gamestate == State.running) {

            for (int r = 0; r < side; r++) {
                for (int c = 0; c < side; c++) {
                    if (tiles[r][c] == null) {
                        g.setColor(emptyColor);
                        g.fillRoundRect(215 + c * 121, 115 + r * 121, 106, 106, 7, 7);
                    } else {
                        drawTile(g, r, c);
                    }
                }
            }
        } else {
            g.setColor(startColor);
            g.fillRoundRect(215, 115, 469, 469, 7, 7);

            g.setColor(gridColor.darker());
            g.setFont(new Font("SansSerif", Font.BOLD, 128));
            g.drawString("2048", 310, 270);

            g.setFont(new Font("SansSerif", Font.BOLD, 20));

            if (gamestate == State.won) {
                g.drawString("you made it!", 390, 350);

            } else if (gamestate == State.over)
                g.drawString("game over", 400, 350);

            g.setColor(gridColor);
            g.drawString("click to start a new game", 330, 470);
            g.drawString("(use arrow keys to move tiles)", 310, 530);
        }
    }

    void drawTile(Graphics2D g, int r, int c) {
        int value = tiles[r][c].getValue();

        g.setColor(colorTable[(int) (Math.log(value) / Math.log(2)) + 1]);
        g.fillRoundRect(215 + c * 121, 115 + r * 121, 106, 106, 7, 7);
        String s = String.valueOf(value);

        g.setColor(value < 128 ? colorTable[0] : colorTable[1]);

        FontMetrics fm = g.getFontMetrics();
        int asc = fm.getAscent();
        int dec = fm.getDescent();

        int x = 215 + c * 121 + (106 - fm.stringWidth(s)) / 2;
        int y = 115 + r * 121 + (asc + (106 - (asc + dec)) / 2);

        g.drawString(s, x, y);
    }

    private void addRandomTile() {
        int pos = rand.nextInt(side * side);
        int row, col;
        do {
            pos = (pos + 1) % (side * side);
            row = pos / side;
            col = pos % side;
        } while (tiles[row][col] != null);

        int val = rand.nextInt(10) == 0 ? 4 : 2;
        tiles[row][col] = new Tile(val);
    }

    private boolean move(int countDownFrom, int yIncr, int xIncr) {
        boolean moved = false;

        for (int i = 0; i < side * side; i++) {
            int j = Math.abs(countDownFrom - i);

            int r = j / side;
            int c = j % side;

            if (tiles[r][c] == null)
                continue;

            int nextR = r + yIncr;
            int nextC = c + xIncr;

            while (nextR >= 0 && nextR < side && nextC >= 0 && nextC < side) {

                Tile next = tiles[nextR][nextC];
                Tile curr = tiles[r][c];

                if (next == null) {

                    if (checkingAvailableMoves)
                        return true;

                    tiles[nextR][nextC] = curr;
                    tiles[r][c] = null;
                    r = nextR;
                    c = nextC;
                    nextR += yIncr;
                    nextC += xIncr;
                    moved = true;

                } else if (next.canMergeWith(curr)) {

                    if (checkingAvailableMoves)
                        return true;

                    int value = next.mergeWith(curr);
                    if (value > highest)
                        highest = value;
                    score += value;
                    tiles[r][c] = null;
                    moved = true;
                    break;
                } else
                    break;
            }
        }

        if (moved) {
            if (highest < target) {
                clearMerged();
                addRandomTile();
                if (!movesAvailable()) {
                    gamestate = State.over;
                }
            } else if (highest == target)
                gamestate = State.won;
        }

        return moved;
    }

    boolean moveUp() {
        return move(0, -1, 0);
    }

    boolean moveDown() {
        return move(side * side - 1, 1, 0);
    }

    boolean moveLeft() {
        return move(0, 0, -1);
    }

    boolean moveRight() {
        return move(side * side - 1, 0, 1);
    }

    void clearMerged() {
        for (Tile[] row : tiles)
            for (Tile tile : row)
                if (tile != null)
                    tile.setMerged(false);
    }

    boolean movesAvailable() {
        checkingAvailableMoves = true;
        boolean hasMoves = moveUp() || moveDown() || moveLeft() || moveRight();
        checkingAvailableMoves = false;
        return hasMoves;
    }

    public static void main(String[] args) {
        SwingUtilities.invokeLater(() -> {
            JFrame f = new JFrame();
            f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
            f.setTitle("2048");
            f.setResizable(true);
            f.add(new Game2048(), BorderLayout.CENTER);
            f.pack();
            f.setLocationRelativeTo(null);
            f.setVisible(true);
        });
    }
}

class Tile {
    private boolean merged;
    private int value;

    Tile(int val) {
        value = val;
    }

    int getValue() {
        return value;
    }

    void setMerged(boolean m) {
        merged = m;
    }

    boolean canMergeWith(Tile other) {
        return !merged && other != null && !other.merged && value == other.getValue();
    }

    int mergeWith(Tile other) {
        if (canMergeWith(other)) {
            value *= 2;
            merged = true;
            return value;
        }
        return -1;
    }
}


/* Tile object: */

function Tile(pos, val, puzzle){
	this.pos     = pos;
	this.val     = val;
	this.puzzle  = puzzle;
	this.merging = false;

	this.getCol = () => Math.round(this.pos % 4);
	this.getRow = () => Math.floor(this.pos / 4);

	/* draw tile on a P5.js canvas: */

	this.show = function(){
		let padding = this.merging ? 0 : 5;
		let size = 0.25*width;
		noStroke();
		colorMode(HSB, 255);
		fill(10*(11 - Math.log2(this.val)), 50 + 15*Math.log2(this.val), 200);
		rect(this.getCol()*size + padding, this.getRow()*size + padding, size - 2*padding, size - 2*padding);
		fill(255);
		textSize(0.1*width);
		textAlign(CENTER, CENTER);
		text(this.val, (this.getCol() + 0.5)*size, (this.getRow() + 0.5)*size);
	}

	/* move tile in a given direction: */

	this.move = function(dir){
		let col = this.getCol() + (1 - 2*(dir < 0))*Math.abs(dir)%4;
		let row = this.getRow() + (1 - 2*(dir < 0))*Math.floor(Math.abs(dir)/4);
		let target = this.puzzle.getTile(this.pos + dir);

		if (col < 0 || col > 3 || row < 0 || row > 3) {
			/* target position out of bounds */
			return false;
		} else if (target){
			/* tile blocked by other tile */
			if(this.merging || target.merging || target.val !== this.val)
				return false;

			/* merge with target tile (equal values):*/
			target.val += this.val;
			target.merging = true;
			this.puzzle.score += target.val;
			this.puzzle.removeTile(this);
			return true;
		}

		/* move tile: */
		this.pos += dir;
		return true;
	}
}

/* Puzzle object: */

function Puzzle(){
	this.tiles    = [];
	this.dir      = 0;
	this.score    = 0;
	this.hasMoved = false;
	this.validPositions = [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15];

	this.getOpenPositions = () => this.validPositions.filter(i => this.tiles.map(x => x.pos).indexOf(i) === -1);
	this.getTile          = pos => this.tiles.filter(x => x.pos === pos)[0];
	this.removeTile       = tile => this.tiles.splice(this.tiles.indexOf(tile), 1);
	this.winCondition     = () => this.tiles.some(x => x.val === 2048);

	/* check for valid moves: */

	this.validMoves = function(){
		/* return true if there are empty spaces */
		if(this.tiles.length < 16)
			return true;

		/* otherwise check for neighboring tiles with the same value */
		let res = false;
		this.tiles.sort((x,y) => x.pos - y.pos);
		for(let i = 0; i < 16; i++)
			res = res || ( (i%4 < 3) ? this.tiles[i].val === this.tiles[i+1].val : false )
					  || ( (i  < 12) ? this.tiles[i].val === this.tiles[i+4].val : false );
		return res;
	}

	/* check win and lose condition: */

	this.checkGameState = function(){
		if(this.winCondition()){
			alert('You win!');
		} else if (!this.validMoves()){
			alert('You Lose!');
			this.restart();
		}
	}

	this.restart = function(){
		this.tiles    = [];
		this.dir      = 0;
		this.score    = 0;
		this.hasMoved = false;
		this.generateTile();
		this.generateTile();
	}

	/* draw the board on the p5.js canvas: */

	this.show = function(){
		background(200);
		fill(255);
		textSize(0.05*width);
		textAlign(CENTER, TOP);
		text("SCORE: " + this.score, 0.5*width, width);

		for(let tile of this.tiles)
			tile.show();
	}

	/* update the board: */

	this.animate = function(){
		if(this.dir === 0)
			return;

		/* move all tiles in a given direction */
		let moving = false;
		this.tiles.sort((x,y) => this.dir*(y.pos - x.pos));
		for(let tile of this.tiles)
			moving = moving || tile.move(this.dir);

		/* check if the move is finished and generate a new tile */
		if(this.hasMoved && !moving){
			this.dir = 0;
			this.generateTile();

			for(let tile of this.tiles)
				tile.merging = false;
		}
		this.hasMoved = moving;
	}

	this.generateTile = function(){
		let positions = this.getOpenPositions();
		let pos       = positions[Math.floor(Math.random()*positions.length)];
		let val       = 2 + 2*Math.floor(Math.random()*1.11);
		this.tiles.push(new Tile(pos, val, this));
	}
	this.generateTile();
	this.generateTile();

	/* process key inputs: */

	this.keyHandler = function(key){
		if      (key === UP_ARROW)    this.dir = -4
		else if (key === DOWN_ARROW)  this.dir = 4
		else if (key === RIGHT_ARROW) this.dir = 1
		else if (key === LEFT_ARROW)  this.dir = -1;
	}
}

let game;

function setup() {
	createCanvas(400, 420);
	game = new Puzzle();
}

/* game loop: */

function draw() {
	game.checkGameState();
	game.animate();
	game.show();
}

function keyPressed(){
	game.keyHandler(keyCode);
}


using Gtk.ShortNames

@enum Direction2048 Right Left Up Down

"""
    shifttiles!
The adding and condensing code is for a leftward shift, so if the move is not
leftward, this will rotate matrix to make move leftward, move, then undo rotation.
"""
function shifttiles!(b, siz, direction)
    if direction == Right
        tmpb = rot180(b); points, winner = leftshift!(tmpb, siz); tmpb = rot180(tmpb)
    elseif direction == Up
        tmpb = rotl90(b); points, winner = leftshift!(tmpb, siz); tmpb = rotr90(tmpb)
    elseif direction == Down
        tmpb = rotr90(b); points, winner = leftshift!(tmpb, siz); tmpb = rotl90(tmpb)
    else # left movement function as coded
        return leftshift!(b, siz)
    end
    for i in 1:siz, j in 1:siz
        b[i,j] = tmpb[i,j]   # copy tmpb contents back to b (modifies b)
    end
    points, winner
end

function compactleft!(b, siz, row)
    tmprow = zeros(Int, siz)
    tmppos = 1
    for j in 1:siz
        if b[row,j] != 0
            tmprow[tmppos] = b[row,j]
            tmppos += 1
        end
    end
    b[row,:] = tmprow
end

"""
    leftshift!
Work row by row. First, compact tiles to the left if possible. Second, find and
replace paired tiles in the row, then re-compact. Keep score of merges and return
as pointsgained. If a 2048 value tile is created, return a winner true value.
"""
function leftshift!(b, siz)
    pointsgained = 0
    winner = false
    for i in 1:siz
        compactleft!(b, siz, i)
        tmprow = zeros(Int, siz)
        tmppos = 1
        for j in 1:siz-1
            if b[i,j] == b[i,j+1]
                b[i,j] = 2 * b[i,j]
                b[i,j+1] = 0
                pointsgained += b[i,j]
                if b[i,j] == 2048     # made a 2048 tile, which wins game
                    winner = true
                end
            end
            if b[i,j] != 0
                tmprow[tmppos] = b[i,j]
                tmppos += 1
            end
        end
        tmprow[siz] = b[i,siz]
        b[i,:] = tmprow
        compactleft!(b, siz, i)
    end
    pointsgained, winner
end

"""
    app2048
Run game app, with boardsize (choose 4 for original game) as an argument.
"""
function app2048(bsize)
    win = Window("2048 Game", 400, 400) |> (Frame() |> (box = Box(:v)))
    toolbar = Toolbar()
    newgame = ToolButton("New Game")
    set_gtk_property!(newgame, :label, "New Game")
    set_gtk_property!(newgame, :is_important, true)
    undomove = ToolButton("Undo Move")
    set_gtk_property!(undomove, :label, "Undo Move")
    set_gtk_property!(undomove, :is_important, true)
    map(w->push!(toolbar,w),[newgame,undomove])
    grid = Grid()
    map(w -> push!(box, w),[toolbar, grid])
    buttons = Array{Gtk.GtkButtonLeaf,2}(undef, bsize, bsize)
    for i in 1:bsize, j in 1:bsize
        grid[i,j] = buttons[i,j] = Button()
        set_gtk_property!(buttons[i,j], :expand, true)
    end
    board = zeros(Int, (bsize,bsize))
    pastboardstates = []
    score = 0
    gameover = false
    condition = Condition()
    won = ""

    function update!()
        for i in 1:bsize, j in 1:bsize
            label = (board[i,j] > 0) ? board[i,j] : " "
            set_gtk_property!(buttons[i,j], :label, label)
        end
        set_gtk_property!(win, :title, "$won 2048 Game  (Score: $score)")
    end
    function newrandomtile!()
        blanks = Array{Tuple{Int,Int},1}()
        for i in 1:bsize, j in 1:bsize
            if board[i,j] == 0
                push!(blanks, (i,j))
            end
        end
        if length(blanks) == 0
            gameover = true
        else
            i,j = rand(blanks)
            board[i,j] = (rand() > 0.8) ? 4 : 2
        end
    end
    function initialize!(w)
        won = ""
        gameover = false
        for i in 1:bsize, j in 1:bsize
            board[i,j] = 0
            set_gtk_property!(buttons[i,j], :label, " ")
        end
        newrandomtile!()
        update!()
    end
    function undo!(w)
        if gameover == false
            board = pop!(pastboardstates)
            update!()
        end
    end
    function keypress(w, event)
        presses = Dict(37 => Up,    # code rotated 90 degrees
                       38 => Left,  # because of Gtk coordinates
                       39 => Down,  # y is downward positive
                       40 => Right)
        keycode = event.hardware_keycode
        if haskey(presses, keycode) && gameover == false
            push!(pastboardstates, copy(board))
            newpoints, havewon = shifttiles!(board, bsize, presses[keycode])
            score += newpoints
            if havewon && won != "Winning"
                won = "Winning"
                info_dialog("You have won the game.")
            end
            newrandomtile!()
            update!()
            if gameover
                info_dialog("Game over.\nScore: $score")
            end
        end
    end
    endit(w) = notify(condition)
    initialize!(win)
    signal_connect(initialize!, newgame, :clicked)
    signal_connect(undo!,undomove, :clicked)
    signal_connect(endit, win, :destroy)
    signal_connect(keypress, win, "key-press-event")
    Gtk.showall(win)
    wait(condition)
end

const boardsize = 4
app2048(boardsize)


import java.io.BufferedReader
import java.io.InputStreamReader

const val positiveGameOverMessage = "So sorry, but you won the game."
const val negativeGameOverMessage = "So sorry, but you lost the game."

fun main(args: Array<String>) {
    val grid = arrayOf(
            arrayOf(0, 0, 0, 0),
            arrayOf(0, 0, 0, 0),
            arrayOf(0, 0, 0, 0),
            arrayOf(0, 0, 0, 0)
    )

    val gameOverMessage = run2048(grid)
    println(gameOverMessage)
}

fun run2048(grid: Array<Array<Int>>): String {
    if (isGridSolved(grid)) return positiveGameOverMessage
    else if (isGridFull(grid)) return negativeGameOverMessage

    val populatedGrid = spawnNumber(grid)
    display(populatedGrid)

    return run2048(manipulateGrid(populatedGrid, waitForValidInput()))
}

fun isGridSolved(grid: Array<Array<Int>>): Boolean = grid.any { row -> row.contains(2048) }
fun isGridFull(grid: Array<Array<Int>>): Boolean = grid.all { row -> !row.contains(0) }

fun spawnNumber(grid: Array<Array<Int>>): Array<Array<Int>> {
    val coordinates = locateSpawnCoordinates(grid)
    val number = generateNumber()

    return updateGrid(grid, coordinates, number)
}

fun locateSpawnCoordinates(grid: Array<Array<Int>>): Pair<Int, Int> {
    val emptyCells = arrayListOf<Pair<Int, Int>>()
    grid.forEachIndexed { x, row ->
        row.forEachIndexed { y, cell ->
            if (cell == 0) emptyCells.add(Pair(x, y))
        }
    }

    return emptyCells[(Math.random() * (emptyCells.size - 1)).toInt()]
}

fun generateNumber(): Int = if (Math.random() > 0.10) 2 else 4

fun updateGrid(grid: Array<Array<Int>>, at: Pair<Int, Int>, value: Int): Array<Array<Int>> {
    val updatedGrid = grid.copyOf()
    updatedGrid[at.first][at.second] = value
    return updatedGrid
}

fun waitForValidInput(): String {
    val input = waitForInput()
    return if (isValidInput(input)) input else waitForValidInput()
}

fun isValidInput(input: String): Boolean = arrayOf("a", "s", "d", "w").contains(input)

fun waitForInput(): String {
    val reader = BufferedReader(InputStreamReader(System.`in`))
    println("Direction?  ")
    return reader.readLine()
}

fun manipulateGrid(grid: Array<Array<Int>>, input: String): Array<Array<Int>> = when (input) {
    "a" -> shiftCellsLeft(grid)
    "s" -> shiftCellsDown(grid)
    "d" -> shiftCellsRight(grid)
    "w" -> shiftCellsUp(grid)
    else -> throw IllegalArgumentException("Expected one of [a, s, d, w]")
}

fun shiftCellsLeft(grid: Array<Array<Int>>): Array<Array<Int>> =
        grid.map(::mergeAndOrganizeCells).toTypedArray()

fun shiftCellsRight(grid: Array<Array<Int>>): Array<Array<Int>> =
        grid.map { row -> mergeAndOrganizeCells(row.reversed().toTypedArray()).reversed().toTypedArray() }.toTypedArray()

fun shiftCellsUp(grid: Array<Array<Int>>): Array<Array<Int>> {
    val rows: Array<Array<Int>> = arrayOf(
            arrayOf(grid[0][0], grid[1][0], grid[2][0], grid[3][0]),
            arrayOf(grid[0][1], grid[1][1], grid[2][1], grid[3][1]),
            arrayOf(grid[0][2], grid[1][2], grid[2][2], grid[3][2]),
            arrayOf(grid[0][3], grid[1][3], grid[2][3], grid[3][3])
    )

    val updatedGrid = grid.copyOf()

    rows.map(::mergeAndOrganizeCells).forEachIndexed { rowIdx, row ->
        updatedGrid[0][rowIdx] = row[0]
        updatedGrid[1][rowIdx] = row[1]
        updatedGrid[2][rowIdx] = row[2]
        updatedGrid[3][rowIdx] = row[3]
    }

    return updatedGrid
}

fun shiftCellsDown(grid: Array<Array<Int>>): Array<Array<Int>> {
    val rows: Array<Array<Int>> = arrayOf(
            arrayOf(grid[3][0], grid[2][0], grid[1][0], grid[0][0]),
            arrayOf(grid[3][1], grid[2][1], grid[1][1], grid[0][1]),
            arrayOf(grid[3][2], grid[2][2], grid[1][2], grid[0][2]),
            arrayOf(grid[3][3], grid[2][3], grid[1][3], grid[0][3])
    )

    val updatedGrid = grid.copyOf()

    rows.map(::mergeAndOrganizeCells).forEachIndexed { rowIdx, row ->
        updatedGrid[3][rowIdx] = row[0]
        updatedGrid[2][rowIdx] = row[1]
        updatedGrid[1][rowIdx] = row[2]
        updatedGrid[0][rowIdx] = row[3]
    }

    return updatedGrid
}

fun mergeAndOrganizeCells(row: Array<Int>): Array<Int> = organize(merge(row.copyOf()))

fun merge(row: Array<Int>, idxToMatch: Int = 0, idxToCompare: Int = 1): Array<Int> {
    if (idxToMatch >= row.size) return row
    if (idxToCompare >= row.size) return merge(row, idxToMatch + 1, idxToMatch + 2)
    if (row[idxToMatch] == 0) return merge(row, idxToMatch + 1, idxToMatch + 2)

    return if (row[idxToMatch] == row[idxToCompare]) {
        row[idxToMatch] *= 2
        row[idxToCompare] = 0
        merge(row, idxToMatch + 1, idxToMatch + 2)
    } else {
        if (row[idxToCompare] != 0) merge(row, idxToMatch + 1, idxToMatch + 2)
        else merge(row, idxToMatch, idxToCompare + 1)
    }
}

fun organize(row: Array<Int>, idxToMatch: Int = 0, idxToCompare: Int = 1): Array<Int> {
    if (idxToMatch >= row.size) return row
    if (idxToCompare >= row.size) return organize(row, idxToMatch + 1, idxToMatch + 2)
    if (row[idxToMatch] != 0) return organize(row, idxToMatch + 1, idxToMatch + 2)

    return if (row[idxToCompare] != 0) {
        row[idxToMatch] = row[idxToCompare]
        row[idxToCompare] = 0
        organize(row, idxToMatch + 1, idxToMatch + 2)
    } else {
        organize(row, idxToMatch, idxToCompare + 1)
    }
}

fun display(grid: Array<Array<Int>>) {
    val prettyPrintableGrid = grid.map { row ->
        row.map { cell ->
            if (cell == 0) "    " else java.lang.String.format("%4d", cell)
        }
    }

    println("New Grid:")
    prettyPrintableGrid.forEach { row ->
        println("+----+----+----+----+")
        row.forEach { print("|$it") }
        println("|")
    }
    println("+----+----+----+----+")
}


use 'format import '[format].
use 'random.

Pos := Object clone tap {

  self x := 0.
  self y := 0.

  self move := {
    localize.
    case ($1) do {
      when 'left  do { pos (this x - 1, this y). }.
      when 'right do { pos (this x + 1, this y). }.
      when 'down  do { pos (this x, this y + 1). }.
      when 'up    do { pos (this x, this y - 1). }.
    }.
  }.

  self == := {
    (self x == $1 x) and (self y == $1 y).
  }.

  self inBounds? := {
    (self x >= 0) and (self x < 4) and (self y >= 0) and (self y < 4).
  }.

  self toString := {
    format "pos (~S, ~S)" call (self x, self y).
  }.

}.

pos := {
  takes '[x, y].
  Pos clone tap {
    self x := x.
    self y := y.
  }.
}.

allSquares := [] tap {
  localize.
  0 upto 4 visit {
    takes '[y].
    0 upto 4 visit {
      takes '[x].
      this pushBack (pos (x, y)).
    }.
  }.
}.

sample := {
  $1 nth (random nextInt mod ($1 length)).
}.

Grid ::= Object clone tap {

  self grid := 16 times to (Array) map { 0. }.

  self clone := {
    Parents above (parent self, 'clone) call tap {
      self grid := self grid clone.
    }.
  }.

  toIndex := {
    $1 x + 4 * $1 y.
  }.

  self at := {
    self grid nth (toIndex).
  }.

  self at= := {
    self grid nth= (toIndex).
  }.

  self isBlank? := {
    self at == 0.
  }.

  self spawnNew := {
    localize.
    candidates := allSquares filter { this isBlank?. } to (Array).
    if (candidates empty?) then {
      'gameover.
    } else {
      p := sample (candidates).
      this at (p) = if (random nextInt mod 10 == 0) then 4 else 2.
      'okay.
    }.
  }.

  canMoveCell := {
    takes '[grid, src, dir].
    dest := src move (dir).
    if (dest inBounds?) then {
      vs := grid at (src).
      vd := grid at (dest).
      (vs /= 0) and ((vd == 0) or (vs == vd)).
    } else {
      False.
    }.
  }.

  self canMove := {
    localize.
    takes '[dir].
    allSquares any { canMoveCell (this, $1, dir). }.
  }.

  self validMoves := {
    '[left, right, up, down] filter { parent self canMove. } to (Array).
  }.

  ;; Calculates the order of iteration for performing the moves
  axisCalc := {
    takes '[dir, major, minor].
    case (dir) do {
      when 'left do { pos (major, minor). }.
      when 'right do { pos (3 - major, minor). }.
      when 'up do { pos (minor, major). }.
      when 'down do { pos (minor, 3 - major). }.
    }.
  }.

  moveFrom := {
    takes '[grid, src, dir, locked].
    dest := src move (dir).
    local 'result = Nil.
    dest inBounds? ifTrue {
      locked contains (dest) ifFalse {
        vs := grid at (src).
        vd := grid at (dest).
        cond {
          when (vd == 0) do {
            grid at (dest) = vs.
            grid at (src) = 0.
            result = moveFrom (grid, dest, dir, locked).
          }.
          when (vd == vs) do {
            grid at (dest) = vs + vd.
            grid at (src) = 0.
            result = moveFrom (grid, dest, dir, locked).
            ;; We merged, so lock the final result cell.
            locked pushBack (result).
          }.
        }.
      }.
    }.
    (result) or (src).
  }.

  self doMove := {
    localize.
    takes '[dir].
    locked := [].
    0 upto 4 do {
      takes '[major].
      0 upto 4 do {
        takes '[minor].
        src := axisCalc (dir, major, minor).
        moveFrom: this, src, dir, locked.
      }.
    }.
  }.

  self pretty := {
    localize.
    lines := [].
    row := "+----+----+----+----+".
    lines pushBack (row).
    0 upto 4 visit {
      takes '[y].
      local 'line = "|".
      0 upto 4 visit {
        takes '[x].
        n := this at (pos (x, y)).
        if (n == 0) then {
          line = line ++ "    |".
        } else {
          line = line ++ n toString padRight (" ", 4) ++ "|".
        }.
      }.
      lines pushBack (line).
      lines pushBack (row).
    }.
    lines joinText "\n".
  }.

  self toArray := {
    allSquares map { parent self at. }.
  }.

}.

grid := Grid clone.
endgame := loop* {
  ;; Check for victory
  (grid toArray any { $1 >= 2048. }) ifTrue {
    last 'victory.
  }.
  ;; Check for game over
  result := grid spawnNew.
  (result == 'gameover) ifTrue {
    last 'gameover.
  }.
  valid := grid validMoves.
  valid empty? ifTrue {
    last 'gameover.
  }.
  $stdout putln: grid pretty.
  move := loop* {
    $stdout puts: "Your move (left, right, up, down)> ".
    move := $stdin readln intern.
    valid contains (move) ifTrue { last (move). }.
  }.
  grid doMove (move).
}.
$stdout putln: grid pretty.

if (endgame == 'victory) then {
  $stdout putln: "You win!".
} else {
  $stdout putln: "Better luck next time!".
}.


-- 2048 for Lua 5.1-5.4, 12/3/2020 db
local unpack = unpack or table.unpack -- for 5.3 +/- compatibility
game = {
  cell = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
  best = 0,
  draw = function(self)
    local t = self.cell
    print("+----+----+----+----+")
    for r=0,12,4 do
      print(string.format("|%4d|%4d|%4d|%4d|\n+----+----+----+----+",t[r+1],t[r+2],t[r+3],t[r+4]))
    end
  end,
  incr = function(self)
    local t,open = self.cell,{}
    for i=1,16 do if t[i]==0 then open[#open+1]=i end end
    t[open[math.random(#open)]] = math.random()<0.1 and 4 or 2
  end,
  pack = function(self,ofr,oto,ost,ifr,ito,ist)
    local t = self.cell
    for outer=ofr,oto,ost do
      local skip = 0
      for inner=ifr,ito,ist do
        local i = outer+inner
        if t[i]==0 then skip=skip+1 else if skip>0 then t[i-skip*ist],t[i],self.diff = t[i],0,true end end
      end
    end
  end,
  comb = function(self,ofr,oto,ost,ifr,ito,ist)
    local t = self.cell
    for outer=ofr,oto,ost do
      for inner=ifr,ito-ist,ist do
        local i,j = outer+inner,outer+inner+ist
        if t[i]>0 and t[i]==t[j] then t[i],t[j],self.diff,self.best = t[i]*2,0,true,math.max(self.best,t[i]*2) end
      end
    end
  end,
  move = function(self,dir)
    local loopdata = {{0,12,4,1,4,1},{0,12,4,4,1,-1},{1,4,1,0,12,4},{1,4,1,12,0,-4}}
    local ofr,oto,ost,ifr,ito,ist = unpack(loopdata[dir])
    self:pack(ofr,oto,ost,ifr,ito,ist)
    self:comb(ofr,oto,ost,ifr,ito,ist)
    self:pack(ofr,oto,ost,ifr,ito,ist)
  end,
  full = function(self)
    local t = self.cell
    for r=0,12,4 do
      for c=1,4 do
        local i,v = r+c,t[r+c]
        if (v==0) or (c>1 and t[i-1]==v) or (c<4 and t[i+1]==v) or (r>0 and t[i-4]==v) or (r<12 and t[i+4]==v) then
          return false
        end
      end
    end
    return true
  end,
  play = function(self)
    math.randomseed(os.time())
    self:incr()
    self:incr()
    while true do
      self:draw()
      if self.best==2048 then print("WIN!") break end
      if self:full() then print("LOSE!") break end
      io.write("Your move (wasd + enter, or q + enter to quit):  ")
      local char = io.read()
      self.diff = false
      if (char=="a") then self:move(1)
      elseif (char=="d") then self:move(2)
      elseif (char=="w") then self:move(3)
      elseif (char=="s") then self:move(4)
      elseif (char=="q") then break end
      if self.diff then self:incr() end
    end
  end
}
game:play()


Module Game2048 {
      \\ 10% 4 and 90% 2
      Def GetTlleNumber()=If(Random(10)<2->4, 2)
      \\ tile
      Def Tile$(x)=If$(x=0->"[    ]", format$("[{0::-4}]", x))
      \\ empty board
      BoardTileRight=lambda (x, y)->x+y*4
      BoardTileLeft=lambda (x, y)->3-x+y*4
      BoardTileUp=lambda (x, y)->x*4+y
      BoardTileDown=lambda (x, y)->(3-x)*4+y
      Dim Board(0 to 15)
      Inventory EmptyTiles
      \\ Score is a statement but we can use it as a variable too.
      Score=0
      \\ Win is also a statement but we can use it as a variable too.
      Win=False
      ExitNow=False
      BoardDirection=BoardtileRight
      Process(BoardDirection)
      \\ Split Rem lines to insert start condition to check valid moves
      Rem : board(0)=2
      Rem : board(1)=2, 2, 2   ' place to (1), (2), (3)
            While len(EmptyTiles) {
            NewTile()
            DrawBoard()
            Action=False
            do {
                  a$=key$
                  if len(a$)=2 then {
                        Action=true
                        Select case Asc(mid$(a$,2))
                        Case 72
                        BoardDirection=BoardTileUp
                        Case 75
                        BoardDirection=BoardTileRight
                        Case 77
                        BoardDirection=BoardTileLeft
                        Case 80
                        BoardDirection=BoardTileDown
                        Case 79 ' End key
                              ExitNow=True
                        Else
                        Action=false
                        end select
                  }
            } until Action
            If ExitNow then exit
            Process(BoardDirection)
      }
      If Win then {
            Print "You Win"
      } Else {
            Print "You Loose"
      }
      End
      Sub Process(Boardtile)
      Inventory EmptyTiles   ' clear inventory
      local where, i, j, k
      For i=0 to 3
            Gravity()
            k=boardtile(0,i)
            For j=1 to 3
                  where=boardtile(j,i)
                  if Board(where)<>0 then {
                        if board(k)=board(where) then {
                               board(k)*=2 : score+=board(where): board(where)=0
                               if board(k)=2048 Then Win=True : ExitNow=true
                        }
                  }
                  k=where
            Next j
            Gravity()
            For j=0 to 3
                  where=boardtile(j,i)
                  if board(where)=0 then Append EmptyTiles, where
            Next j
      Next i
      End Sub
      Sub NewTile()
            local m=EmptyTiles(Random(0, len(EmptyTiles)-1)!)
            Board(m)=GetTlleNumber()
            Delete EmptyTiles, m
      End Sub
      Sub DrawBoard()
            Refresh 2000
            Cls
            Cursor 0, 10
            Local Doc$, line$
            Document Doc$
            Doc$=Format$("Game 2048 Score {0}", score)
            \\ Using Report 2 we use rendering as text, with center justify
            Report 2, Doc$
            Doc$={
            }
            Local i, j
            For i=0 to 3
                  line$=""
                  For j=0 to 3
                        line$+=Tile$(Board(BoardTileRight(j, i)))
                  Next j
                  Print Over $(2), Line$
                  Print
                  Doc$=Line$+{
                  }
            Next i
            Report 2, "Next:Use Arrows | Exit: Press End"
            Refresh
            ClipBoard Doc$
      End Sub
      Sub Gravity()
            k=-1
            for j=0 to 3 {
                  where=boardtile(j,i)
                  if k=-1 then if board(where)=0 then k=j : continue
                  if board(where)=0  then continue
                  if k=-1 then continue
                  board(boardtile(k,i))=board(where)
                  board(where)=0
                  k++
            }
      End Sub
}
Game2048


function field = puzzle2048(field)

if nargin < 1 || isempty(field)
    field = zeros(4);
    field = addTile(field);
end

clc
rng('shuffle')

while true
    oldField = field;
    clc
    score = displayField(field);

    % check losing condition
    if isGameLost(field)
        sprintf('You lose with a score of %g.',score)
        return
    end

    direction = input('Which direction? (w,a,s,d) (x for exit)\n','s');
    switch direction
        case 'w'
            field = moveUp(field);
        case 'a'
            field = rot90( moveUp( rot90(field,-1) ) );
        case 's'
            field = flipud( moveUp( flipud(field) ) );
        case 'd'
            field = rot90( moveUp( rot90(field) ), -1);
        case 'x'
            return
    end

    if any(field>=2048,'all')
        disp('You win!')
        return
    end

    if ~all(field==oldField,'all')
        field = addTile(field);
    end

end

end

function gameIsLost = isGameLost(field)

if all(field,'all') && ...
        all(conv2(field,[1, -1],'same'),'all') && ...
        all(conv2(field,[1; -1],'same'),'all')
    gameIsLost = true;
else
    gameIsLost = false;
end

end

function field = addTile(field)

freeIndices = find(~field);
newIndex = freeIndices( randi(length(freeIndices)) );
newNumber = 2 + 2 * (rand < 0.1);
field(newIndex) = newNumber;

end

function score = displayField(field)

% Unicode characters for box drawings
% 9484: U+250C Box Drawings Light Down and Right
% 9472: U+2500 Box Drawings Light Horizontal
% 9474: U+2502 Box Drawings Light Vertical
% 9488: U+2510 Box Drawings Light Down and Left
% 9492: U+2515 Box Drawings Light Up and Right
% 9496: U+2518 Box Drawings Light Up and Left
% 9500: U+251C Box Drawings Light Vertical and Right
% 9508: U+2524 Box Drawings Light Vertical and Left
% 9516: U+252C Box Drawings Light Down and Horizontal
% 9524: U+2534 Box Drawings Light Up and Horizontal
% 9532: U+253C Box Drawings Light Vertical and Horizontal
score = sum(field(:));
cellField = arrayfun(@num2str, field, 'UniformOutput', false);
cellField = cellfun(@(x) [ char(9474) blanks(5-length(x)) x ' ' ], ...
    cellField, 'UniformOutput', false);
topRow = repmat('-',1,7*size(field,2)+1);
topRow(1:7:end) = char(9516);
topRow([1 end]) = [ char(9484) char(9488) ];
midRow = topRow;
midRow(1:7:end) = char(9532);
midRow([1 end]) = [ char(9500) char(9508) ];
botRow = topRow;
botRow(1:7:end) = char(9524);
botRow([1 end]) = [ char(9492) char(9496) ];
charField = topRow;
for iRow = cellField'
    charField = [ charField; iRow{:} char(9474); midRow ];
end
charField(end,:) = botRow;
charField(charField == '0') = ' ';

disp(charField)
fprintf('\nYour score: %g\n', score)

end

function field = moveUp(field)

for iCol = 1:size(field,2)
    col = field(:,iCol);
    col = removeZeros(col);
    for iRow = 1:length(col)-1
        if col(iRow)==col(iRow+1)
            col(iRow:iRow+1) = [ 2*col(iRow); 0 ];
        end
    end
    col = removeZeros(col);
    if length(col) < length(field)
        col(end+1:length(field)) = 0;
    end
    field(:,iCol) = col;
end

end

function vector = removeZeros(vector)

vector(vector==0) = [];

end


import random, strutils, terminal

const
  BoardLength = 4
  BoardSize = BoardLength * BoardLength
  Target = 2048

type
  Operation = enum
    opInvalid
    opUp
    opDown
    opLeft
    opRight
    opQuit
    opRestart

  Board = object
    len: Natural
    largestNumber: Natural
    score: Natural
    rows: array[BoardLength, array[BoardLength, Natural]]

func handleKey(c: char): Operation =
  case c
  of 'w', 'W': opUp
  of 'a', 'A': opLeft
  of 's', 'S': opDown
  of 'd', 'D': opRight
  of 'q', 'Q': opQuit
  of 'r', 'R': opRestart
  else: opInvalid

proc getKey(): Operation =
  var c = getch()
  if c == '\e':
    c = getch()
    if c == '[':
      case getch()
      of 'A': opUp
      of 'D': opLeft
      of 'B': opDown
      of 'C': opRight
      else: opInvalid
    else: handleKey c
  else: handleKey c

proc spawnRandom(b: var Board) =
  if b.len < BoardSize:
    var
      x = rand 0..<BoardLength
      y = rand 0..<BoardLength
    while b.rows[y][x] != 0:
      x = rand 0..<BoardLength
      y = rand 0..<BoardLength
    b.rows[y][x] = if rand(1.0) < 0.9: 2 else: 4
    inc b.len
    b.largestNumber = max(b.rows[y][x], b.largestNumber)

proc initBoard(): Board =
  spawnRandom result

func `$`(b: Board): string =
  result = "┌────┬────┬────┬────┐\n"
  for idx, val in b.rows:
    for v in val:
      result.add "│"
      result.add center(if v != 0: $v else: "", 4)
    result.add "│\n"
    if idx < high(b.rows):
      result.add "├────┼────┼────┼────┤\n"
    else:
      result.add "└────┴────┴────┴────┘"

func shift(b: var Board; o: Operation; merge = true): bool =
  const BoardRange = 0..<BoardLength
  var
    x = 0
    y = 0
    vecX: range[-1..1] = 0
    vecY: range[-1..1] = 0
  case o
  of opUp:
    vecY = 1
  of opDown:
    vecY = -1
    y = BoardLength - 1
  of opLeft: vecX = 1
  of opRight:
    vecX = -1
    x = BoardLength - 1
  else: return

  let
    startX = x
    startY = y
  while x in BoardRange and y in BoardRange:
    while b.len < BoardSize and x in BoardRange and y in BoardRange:
      let
        nextX = x + vecX
        nextY = y + vecY
        prevX = x - vecX
        prevY = y - vecY
      if b.rows[y][x] == 0:
        if nextX in BoardRange and nextY in BoardRange and
           b.rows[nextY][nextX] != 0:
          result = true
          swap b.rows[y][x], b.rows[nextY][nextX]
          if prevX in BoardRange and prevY in BoardRange:
            x = prevX
            y = prevY
            continue
      x = nextX
      y = nextY

    if merge:
      x = if vecX != 0: startX else: x
      y = if vecY != 0: startY else: y
      while x in BoardRange and y in BoardRange:
        let
          nextX = x + vecX
          nextY = y + vecY
        if b.rows[y][x] != 0:
          if nextX in BoardRange and nextY in BoardRange and
             b.rows[nextY][nextX] == b.rows[y][x]:
            result = true
            b.rows[y][x] *= 2
            b.largestNumber = max(b.rows[y][x], b.largestNumber)
            b.score += b.rows[y][x]
            b.rows[nextY][nextX] = 0
            dec b.len
        x = nextX
        y = nextY

    if vecX == 0:
      inc x
      y = startY
    elif vecY == 0:
      inc y
      x = startX
  if merge and result: discard b.shift(o, false)

func shiftable(b: Board): bool =
  for row in 0..<BoardLength:
    for col in 0..<BoardLength:
      result = result or b.rows[row][col] == 0
      if result: break
      if row < BoardLength - 1:
        result = result or b.rows[row][col] == b.rows[row + 1][col]
      if col < BoardLength - 1:
        result = result or b.rows[row][col] == b.rows[row][col + 1]

when isMainModule:
  randomize()
  var
    board = initBoard()
    highscore = 0
  block gameLoop:
    while true:
      let gameover = not board.shiftable or board.largestNumber >= Target
      echo board
      highscore = max(highscore, board.score)
      echo "Score = ", board.score, "  Highscore = ", highscore
      if not gameover:
        echo "Press arrow keys or WASD to move, R to Restart, Q to Quit"
      elif board.largestNumber >= Target:
        echo "You win! Press R to Restart, Q to Quit"
      else:
        echo "Game over! Press R to Restart, Q to Quit"
      while true:
        let op = getKey()
        case op
        of opRestart:
          board = initBoard()
          break
        of opQuit: break gameLoop
        of opInvalid: continue
        elif gameover: continue
        else:
          if board.shift op:
            board.spawnRandom
            break
      for i in 1..BoardLength + 7:
        eraseLine()
        cursorUp()


let list_make x v =
  let rec aux acc i =
    if i <= 0 then acc else aux (v::acc) (i-1)
  in
  aux [] x

let pad_right n line =
  let len = List.length line in
  let x = n - len in
  line @ (list_make x 0)

let _move_left line =
  let n = List.length line in
  let line = List.filter ((<>) 0) line in
  let rec aux acc = function
  | x::y::tl ->
      if x = y
      then aux (x+y::acc) tl
      else aux (x::acc) (y::tl)
  | x::[] ->
      aux (x::acc) []
  | [] ->
      List.rev acc
  in
  pad_right n (aux [] line)

let move_left grid =
  List.map _move_left grid

let move_right grid =
  grid
    |> List.map List.rev
    |> List.map _move_left
    |> List.map List.rev

let rec replace g n v =
  match g with
  | x::xs -> if n = 0 then v::xs else x::(replace xs (n-1) v)
  | [] -> raise (Invalid_argument "replace")

(* add a new value in a random cell containing zero *)
let rec new_value grid =
  let zeros = ref [] in
  List.iteri (fun y line ->
    List.iteri (fun x v ->
      if v = 0 then zeros := (x, y) :: !zeros
    ) line;
  ) grid;
  let n = List.length !zeros in
  if n = 0 then raise Exit;
  let x, y = List.nth !zeros (Random.int n) in
  let v = if Random.int 10 = 0 then 4 else 2 in
  let line = List.nth grid y in
  let new_line = replace line x v in
  replace grid y new_line

(* turn counterclockwise *)
let turn_ccw grid =
  let y = List.length grid in
  let x = List.length (List.nth grid 0) in
  List.init x (fun i ->
    List.init y (fun j ->
      List.nth (List.nth grid j) (x-i-1)
    )
  )

(* turn clockwise *)
let turn_cw grid =
  let y = List.length grid in
  let x = List.length (List.nth grid 0) in
  List.init x (fun i ->
    List.init y (fun j ->
      List.nth (List.nth grid (y-j-1)) (i)
    )
  )

let move_up grid =
  grid
    |> turn_ccw
    |> move_left
    |> turn_cw

let move_down grid =
  grid
    |> turn_cw
    |> move_left
    |> turn_ccw

let display grid =
  List.iter (fun line ->
    print_string " [";
    line
      |> List.map (Printf.sprintf "%4d")
      |> String.concat "; "
      |> print_string;
    print_endline "]"
  ) grid

let () =
  Random.self_init ();
  let width =
    try int_of_string Sys.argv.(1)
    with _ -> 4
  in
  let line = list_make width 0 in
  let grid = list_make width line in

  let grid = new_value grid in
  let grid = new_value grid in

  print_endline {|
    s -> left
    f -> right
    e -> up
    d -> down
    q -> quit
  |};
  let rec loop grid =
    display grid;
    let grid =
      match read_line () with
      | "s" -> move_left grid
      | "f" -> move_right grid
      | "e" -> move_up grid
      | "d" -> move_down grid
      | "q" -> exit 0
      | _ -> grid
    in
    let grid =
      try new_value grid
      with Exit ->
        print_endline "Game Over";
        exit 0
    in
    loop grid
  in
  loop grid