mirror of
https://codeberg.org/JasterV/2048.elm.git
synced 2026-04-26 18:10:03 +00:00
finishes implementing MVP
This commit is contained in:
Victor Martinez
parent
9e211ee939
commit
ead2eb84f1
9 changed files with 12711 additions and 116 deletions
2
Makefile
Normal file
2
Makefile
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
build:
|
||||
elm make src/Main.elm --output public/app.js
|
||||
4
elm.json
4
elm.json
|
|
@ -9,10 +9,12 @@
|
|||
"elm/browser": "1.0.2",
|
||||
"elm/core": "1.0.5",
|
||||
"elm/html": "1.0.0",
|
||||
"elm/json": "1.1.3",
|
||||
"elm/random": "1.0.0",
|
||||
"elm-community/list-extra": "8.6.0",
|
||||
"mdgriffith/elm-ui": "1.1.8"
|
||||
},
|
||||
"indirect": {
|
||||
"elm/json": "1.1.3",
|
||||
"elm/time": "1.0.0",
|
||||
"elm/url": "1.0.0",
|
||||
"elm/virtual-dom": "1.0.3"
|
||||
|
|
|
|||
12315
public/app.js
Normal file
12315
public/app.js
Normal file
File diff suppressed because it is too large
Load diff
20
public/index.html
Normal file
20
public/index.html
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
|
||||
<head>
|
||||
<title></title>
|
||||
<meta charset="UTF-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
</head>
|
||||
|
||||
<body>
|
||||
<div id="app"></div>
|
||||
<script src="./app.js"></script>
|
||||
<script>
|
||||
var app = Elm.Main.init({
|
||||
node: document.getElementById("app")
|
||||
});
|
||||
</script>
|
||||
</body>
|
||||
|
||||
</html>
|
||||
32
src/Cmd.elm
Normal file
32
src/Cmd.elm
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
module Cmd exposing (generateRandomPositionedCell)
|
||||
|
||||
import Array exposing (Array)
|
||||
import Game exposing (Cell, Model, Position)
|
||||
import Msg exposing (Msg)
|
||||
import Random
|
||||
|
||||
|
||||
pickRandomPosition : Array Position -> Random.Generator (Maybe Position)
|
||||
pickRandomPosition positions =
|
||||
let
|
||||
head =
|
||||
positions |> Array.toList |> List.head
|
||||
|
||||
tail =
|
||||
positions |> Array.toList |> List.tail |> Maybe.withDefault []
|
||||
in
|
||||
Random.uniform head (tail |> List.map Just)
|
||||
|
||||
|
||||
generateRandomCell : Random.Generator Cell
|
||||
generateRandomCell =
|
||||
Random.uniform (Just 2) ([ 2, 2, 2, 2, 2, 4 ] |> List.map Just)
|
||||
|
||||
|
||||
generateRandomPositionedCell : Model -> Cmd Msg
|
||||
generateRandomPositionedCell model =
|
||||
let
|
||||
positions =
|
||||
Game.getFreePositions model
|
||||
in
|
||||
Random.generate Msg.RandomCellGenerated (Random.pair (pickRandomPosition positions) generateRandomCell)
|
||||
200
src/Game.elm
200
src/Game.elm
|
|
@ -1,15 +1,21 @@
|
|||
module Game exposing
|
||||
( Board
|
||||
, Cell
|
||||
, Direction(..)
|
||||
, Model
|
||||
, Position
|
||||
, addCell
|
||||
, getFreePositions
|
||||
, initialModel
|
||||
, isCellEmpty
|
||||
, moveDown
|
||||
, moveLeft
|
||||
, moveRight
|
||||
, moveUp
|
||||
, move
|
||||
, setBoard
|
||||
)
|
||||
|
||||
import Array exposing (Array)
|
||||
import List.Extra
|
||||
|
||||
|
||||
|
||||
-- TYPE DEFINITIONS
|
||||
|
||||
|
||||
|
|
@ -20,21 +26,24 @@ type alias Model =
|
|||
|
||||
|
||||
type alias Board =
|
||||
List (List Cell)
|
||||
Array (Array Cell)
|
||||
|
||||
|
||||
type alias Cell =
|
||||
Maybe Int
|
||||
|
||||
|
||||
isCellEmpty : Cell -> Bool
|
||||
isCellEmpty cell =
|
||||
case cell of
|
||||
Nothing ->
|
||||
True
|
||||
type alias Position =
|
||||
{ row : Int
|
||||
, col : Int
|
||||
}
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
type Direction
|
||||
= Up
|
||||
| Down
|
||||
| Left
|
||||
| Right
|
||||
|
||||
|
||||
|
||||
|
|
@ -48,8 +57,8 @@ boardSize_ =
|
|||
|
||||
initialBoard_ : Board
|
||||
initialBoard_ =
|
||||
List.repeat boardSize_
|
||||
(List.repeat boardSize_ Nothing)
|
||||
Array.repeat boardSize_
|
||||
(Array.repeat boardSize_ Nothing)
|
||||
|
||||
|
||||
initialModel : Model
|
||||
|
|
@ -61,54 +70,157 @@ initialModel =
|
|||
-- GAME RULES
|
||||
|
||||
|
||||
generateRandomCell_ : Model -> Model
|
||||
generateRandomCell_ model =
|
||||
model
|
||||
flatten_ : Array (Array a) -> Array a
|
||||
flatten_ =
|
||||
Array.foldr Array.append Array.empty
|
||||
|
||||
|
||||
foldDown_ : Model -> Model
|
||||
foldDown_ model =
|
||||
model
|
||||
pop_ : List a -> List a
|
||||
pop_ l =
|
||||
List.Extra.removeAt (List.length l - 1) l
|
||||
|
||||
|
||||
getFreePositions : Model -> Array Position
|
||||
getFreePositions =
|
||||
.board
|
||||
>> flatten_
|
||||
>> Array.indexedMap
|
||||
(\index cell ->
|
||||
( Position (index // boardSize_) (modBy boardSize_ index), cell )
|
||||
)
|
||||
>> Array.filter (Tuple.second >> (==) Maybe.Nothing)
|
||||
>> Array.map Tuple.first
|
||||
|
||||
|
||||
addCell : Model -> Cell -> Position -> Model
|
||||
addCell model cell position =
|
||||
{--
|
||||
Adds a cell on the given position.
|
||||
If the position is already full, no action is taken
|
||||
--}
|
||||
let
|
||||
board =
|
||||
model.board
|
||||
|
||||
row =
|
||||
Array.get position.row board
|
||||
|
||||
newRow =
|
||||
row
|
||||
|> Maybe.withDefault Array.empty
|
||||
|> Array.set position.col cell
|
||||
|
||||
newBoard =
|
||||
Array.set position.row newRow board
|
||||
in
|
||||
{ model | board = newBoard }
|
||||
|
||||
|
||||
setBoard : Model -> Board -> Model
|
||||
setBoard model board =
|
||||
{ model | board = board }
|
||||
|
||||
|
||||
foldUp_ : Model -> Model
|
||||
foldUp_ model =
|
||||
model
|
||||
let
|
||||
newBoard =
|
||||
model.board
|
||||
|> Array.toList
|
||||
>> List.map Array.toList
|
||||
>> List.Extra.transpose
|
||||
>> List.map foldRowLeft_
|
||||
>> List.Extra.transpose
|
||||
>> List.map Array.fromList
|
||||
>> Array.fromList
|
||||
in
|
||||
setBoard model newBoard
|
||||
|
||||
|
||||
foldDown_ : Model -> Model
|
||||
foldDown_ model =
|
||||
let
|
||||
newBoard =
|
||||
model.board
|
||||
|> Array.toList
|
||||
>> List.map Array.toList
|
||||
>> List.Extra.transpose
|
||||
>> List.map foldRowRight_
|
||||
>> List.Extra.transpose
|
||||
>> List.map Array.fromList
|
||||
>> Array.fromList
|
||||
in
|
||||
setBoard model newBoard
|
||||
|
||||
|
||||
foldLeft_ : Model -> Model
|
||||
foldLeft_ model =
|
||||
model
|
||||
let
|
||||
newBoard =
|
||||
model.board |> Array.map (Array.toList >> foldRowLeft_ >> Array.fromList)
|
||||
in
|
||||
setBoard model newBoard
|
||||
|
||||
|
||||
foldRight_ : Model -> Model
|
||||
foldRight_ model =
|
||||
model
|
||||
let
|
||||
newBoard =
|
||||
model.board |> Array.map (Array.toList >> foldRowRight_ >> Array.fromList)
|
||||
in
|
||||
setBoard model newBoard
|
||||
|
||||
|
||||
moveDown : Model -> Model
|
||||
moveDown model =
|
||||
model
|
||||
|> foldDown_
|
||||
|> generateRandomCell_
|
||||
foldRowLeft_ : List Cell -> List Cell
|
||||
foldRowLeft_ =
|
||||
List.reverse >> foldRowRight_ >> List.reverse
|
||||
|
||||
|
||||
moveUp : Model -> Model
|
||||
moveUp model =
|
||||
model
|
||||
|> foldUp_
|
||||
|> generateRandomCell_
|
||||
foldRowRight_ : List Cell -> List Cell
|
||||
foldRowRight_ row =
|
||||
row
|
||||
|> List.filter ((/=) Nothing)
|
||||
|> List.map (Maybe.withDefault 0)
|
||||
|> foldNumsListRight_
|
||||
|> List.map Just
|
||||
|> (\folded -> List.repeat (List.length row - List.length folded) Nothing ++ folded)
|
||||
|
||||
|
||||
moveLeft : Model -> Model
|
||||
moveLeft model =
|
||||
model
|
||||
|> foldLeft_
|
||||
|> generateRandomCell_
|
||||
foldNumsListRight_ : List Int -> List Int
|
||||
foldNumsListRight_ =
|
||||
doFoldNumsListRight_ [ 0 ]
|
||||
|
||||
|
||||
moveRight : Model -> Model
|
||||
moveRight model =
|
||||
model
|
||||
|> foldRight_
|
||||
|> generateRandomCell_
|
||||
doFoldNumsListRight_ : List Int -> List Int -> List Int
|
||||
doFoldNumsListRight_ result original =
|
||||
case original of
|
||||
[] ->
|
||||
List.filter ((/=) 0) result
|
||||
|
||||
_ ->
|
||||
case ( List.Extra.last original, List.head result ) of
|
||||
( Just last, Just first ) ->
|
||||
if last == first then
|
||||
doFoldNumsListRight_ ([ 0, last + last ] ++ (List.tail result |> Maybe.withDefault [])) (pop_ original)
|
||||
|
||||
else
|
||||
doFoldNumsListRight_ (last :: result) (pop_ original)
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
|
||||
move : Model -> Direction -> Model
|
||||
move model key =
|
||||
case key of
|
||||
Down ->
|
||||
model |> foldDown_
|
||||
|
||||
Up ->
|
||||
model |> foldUp_
|
||||
|
||||
Left ->
|
||||
model |> foldLeft_
|
||||
|
||||
Right ->
|
||||
model |> foldRight_
|
||||
|
|
|
|||
151
src/Main.elm
151
src/Main.elm
|
|
@ -1,10 +1,18 @@
|
|||
module Main exposing (..)
|
||||
|
||||
import Browser
|
||||
import Element as UI
|
||||
import Browser.Events
|
||||
import Cmd exposing (generateRandomPositionedCell)
|
||||
import Element exposing (..)
|
||||
import Game
|
||||
import Html exposing (Html)
|
||||
import Msg exposing (Msg)
|
||||
import Json.Decode as Decode
|
||||
import Msg exposing (KeyEvent(..), Msg(..))
|
||||
import View
|
||||
|
||||
|
||||
|
||||
-- MAIN
|
||||
|
||||
|
||||
type alias Document msg =
|
||||
|
|
@ -19,89 +27,100 @@ main =
|
|||
{ init = init
|
||||
, update = update
|
||||
, view = view
|
||||
, subscriptions = \_ -> Sub.none
|
||||
, subscriptions = subscriptions
|
||||
}
|
||||
|
||||
|
||||
|
||||
-- INIT
|
||||
|
||||
|
||||
init : () -> ( Game.Model, Cmd Msg )
|
||||
init _ =
|
||||
( Game.initialModel
|
||||
, Cmd.none
|
||||
let
|
||||
model =
|
||||
Game.initialModel
|
||||
in
|
||||
( model
|
||||
, generateRandomPositionedCell model
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- SUBSCRIPTIONS
|
||||
|
||||
|
||||
subscriptions : Game.Model -> Sub Msg
|
||||
subscriptions _ =
|
||||
Browser.Events.onKeyDown keyDecoder
|
||||
|
||||
|
||||
keyDecoder : Decode.Decoder Msg
|
||||
keyDecoder =
|
||||
Decode.map toMsg (Decode.field "key" Decode.string)
|
||||
|
||||
|
||||
toMsg : String -> Msg
|
||||
toMsg string =
|
||||
case string of
|
||||
"ArrowLeft" ->
|
||||
Msg.KeyPressed KeyEventArrowLeft
|
||||
|
||||
"ArrowRight" ->
|
||||
Msg.KeyPressed KeyEventArrowRight
|
||||
|
||||
"ArrowDown" ->
|
||||
Msg.KeyPressed KeyEventArrowDown
|
||||
|
||||
"ArrowUp" ->
|
||||
Msg.KeyPressed KeyEventArrowUp
|
||||
|
||||
_ ->
|
||||
Msg.KeyPressed KeyEventUnknown
|
||||
|
||||
|
||||
|
||||
-- UPDATE
|
||||
|
||||
|
||||
update : Msg -> Game.Model -> ( Game.Model, Cmd Msg )
|
||||
update msg model =
|
||||
case msg of
|
||||
Msg.ArrowDown ->
|
||||
( model |> Game.moveDown
|
||||
Msg.KeyPressed KeyEventUnknown ->
|
||||
( model, Cmd.none )
|
||||
|
||||
Msg.KeyPressed key ->
|
||||
let
|
||||
newModel : Game.Model
|
||||
newModel =
|
||||
key
|
||||
|> Msg.keyToDirection
|
||||
|> Maybe.map (Game.move model)
|
||||
|> Maybe.withDefault model
|
||||
|
||||
cmd =
|
||||
if newModel == model then
|
||||
Cmd.none
|
||||
|
||||
else
|
||||
generateRandomPositionedCell newModel
|
||||
in
|
||||
( newModel, cmd )
|
||||
|
||||
Msg.RandomCellGenerated ( position, cell ) ->
|
||||
( position
|
||||
|> Maybe.map (Game.addCell model cell)
|
||||
|> Maybe.withDefault model
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Msg.ArrowUp ->
|
||||
( model |> Game.moveUp
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Msg.ArrowLeft ->
|
||||
( model |> Game.moveLeft
|
||||
, Cmd.none
|
||||
)
|
||||
|
||||
Msg.ArrowRight ->
|
||||
( model |> Game.moveRight
|
||||
, Cmd.none
|
||||
)
|
||||
-- VIEW
|
||||
|
||||
|
||||
view : Game.Model -> Document Msg
|
||||
view model =
|
||||
{ title = "2048"
|
||||
, body = view_ model
|
||||
, body = View.game model
|
||||
}
|
||||
|
||||
|
||||
view_ : Game.Model -> List (Html Msg)
|
||||
view_ model =
|
||||
[ UI.layout [] <|
|
||||
UI.column []
|
||||
[ viewScore_ model.score
|
||||
, viewBoard_ model.board
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
viewScore_ : Int -> UI.Element Msg
|
||||
viewScore_ score =
|
||||
score
|
||||
|> String.fromInt
|
||||
|> UI.text
|
||||
|> List.singleton
|
||||
|> UI.row []
|
||||
|
||||
|
||||
viewBoard_ : Game.Board -> UI.Element Msg
|
||||
viewBoard_ board =
|
||||
board
|
||||
|> List.map viewBoardRow_
|
||||
|> UI.column []
|
||||
|
||||
|
||||
viewBoardRow_ : List Game.Cell -> UI.Element Msg
|
||||
viewBoardRow_ cells =
|
||||
cells
|
||||
|> List.map viewCell_
|
||||
|> UI.row []
|
||||
|
||||
|
||||
viewCell_ : Game.Cell -> UI.Element Msg
|
||||
viewCell_ cell =
|
||||
let
|
||||
value : String
|
||||
value =
|
||||
cell
|
||||
|> Maybe.map String.fromInt
|
||||
|> Maybe.withDefault "-"
|
||||
in
|
||||
UI.column []
|
||||
[ UI.text value ]
|
||||
|
|
|
|||
37
src/Msg.elm
37
src/Msg.elm
|
|
@ -1,8 +1,35 @@
|
|||
module Msg exposing (Msg(..))
|
||||
module Msg exposing (KeyEvent(..), Msg(..), keyToDirection)
|
||||
|
||||
import Game exposing (Cell, Direction(..), Position)
|
||||
|
||||
|
||||
type Msg
|
||||
= ArrowUp
|
||||
| ArrowDown
|
||||
| ArrowLeft
|
||||
| ArrowRight
|
||||
= KeyPressed KeyEvent
|
||||
| RandomCellGenerated ( Maybe Position, Cell )
|
||||
|
||||
|
||||
type KeyEvent
|
||||
= KeyEventArrowUp
|
||||
| KeyEventArrowDown
|
||||
| KeyEventArrowLeft
|
||||
| KeyEventArrowRight
|
||||
| KeyEventUnknown
|
||||
|
||||
|
||||
keyToDirection : KeyEvent -> Maybe Direction
|
||||
keyToDirection event =
|
||||
case event of
|
||||
KeyEventArrowUp ->
|
||||
Just Up
|
||||
|
||||
KeyEventArrowDown ->
|
||||
Just Down
|
||||
|
||||
KeyEventArrowLeft ->
|
||||
Just Left
|
||||
|
||||
KeyEventArrowRight ->
|
||||
Just Right
|
||||
|
||||
KeyEventUnknown ->
|
||||
Nothing
|
||||
|
|
|
|||
66
src/View.elm
Normal file
66
src/View.elm
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
module View exposing (game)
|
||||
|
||||
import Array exposing (Array)
|
||||
import Element exposing (..)
|
||||
import Element.Background
|
||||
import Element.Border
|
||||
import Element.Font
|
||||
import Game
|
||||
import Html exposing (Html)
|
||||
import Msg exposing (KeyEvent(..), Msg(..))
|
||||
|
||||
|
||||
game : Game.Model -> List (Html Msg)
|
||||
game model =
|
||||
[ layout [ Element.Font.size 60 ] <|
|
||||
column [ height fill, width fill ]
|
||||
[ score_ model.score
|
||||
, board_ model.board
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
score_ : Int -> Element Msg
|
||||
score_ score =
|
||||
score
|
||||
|> String.fromInt
|
||||
|> (++) "Score: "
|
||||
|> text
|
||||
|> Element.el [ centerY, centerX ]
|
||||
|> List.singleton
|
||||
|> row [ width fill, height <| fillPortion 1, paddingXY 5 5 ]
|
||||
|
||||
|
||||
board_ : Game.Board -> Element Msg
|
||||
board_ board =
|
||||
board
|
||||
|> Array.map boardRow_
|
||||
|> Array.toList
|
||||
|> column [ centerX, centerY ]
|
||||
|> Element.el [ width fill, height <| fillPortion 5 ]
|
||||
|
||||
|
||||
boardRow_ : Array Game.Cell -> Element Msg
|
||||
boardRow_ cells =
|
||||
cells
|
||||
|> Array.map cell_
|
||||
|> Array.toList
|
||||
|> row [ spacing 20, paddingXY 0 10 ]
|
||||
|
||||
|
||||
cell_ : Game.Cell -> Element Msg
|
||||
cell_ cell =
|
||||
let
|
||||
value : String
|
||||
value =
|
||||
cell
|
||||
|> Maybe.map String.fromInt
|
||||
|> Maybe.withDefault " "
|
||||
in
|
||||
column
|
||||
[ padding 30
|
||||
, Element.Border.rounded 10
|
||||
, Element.Font.semiBold
|
||||
, Element.Background.color (rgb 1 0.7 0.5)
|
||||
]
|
||||
[ text value ]
|
||||
Loading…
Reference in a new issue