jasterv/2048.elm
1
0
Fork 0
mirror of https://codeberg.org/JasterV/2048.elm.git synced 2026-04-26 18:10:03 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

finishes implementing MVP

Browse source
This commit is contained in:
Victor Martinez 2022-07-21 00:53:17 +02:00
parent 9e211ee939
commit ead2eb84f1
9 changed files with 12711 additions and 116 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile Normal file
View file

@ -0,0 +1,2 @@
build:
elm make src/Main.elm --output public/app.js

4
elm.json
View file

@ -9,10 +9,12 @@
"elm/browser": "1.0.2", "elm/browser": "1.0.2",
"elm/core": "1.0.5", "elm/core": "1.0.5",
"elm/html": "1.0.0", "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" "mdgriffith/elm-ui": "1.1.8"
}, },
"indirect": { "indirect": {
"elm/json": "1.1.3",
"elm/time": "1.0.0", "elm/time": "1.0.0",
"elm/url": "1.0.0", "elm/url": "1.0.0",
"elm/virtual-dom": "1.0.3" "elm/virtual-dom": "1.0.3"

12315
public/app.js Normal file
View file

File diff suppressed because it is too large Load diff

20
public/index.html Normal file
View 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
View 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
View file

@ -1,15 +1,21 @@
module Game exposing module Game exposing
( Board ( Board
, Cell , Cell
, Direction(..)
, Model , Model
, Position
, addCell
, getFreePositions
, initialModel , initialModel
, isCellEmpty , move
, moveDown , setBoard
, moveLeft
, moveRight
, moveUp
) )
import Array exposing (Array)
import List.Extra
-- TYPE DEFINITIONS -- TYPE DEFINITIONS
@ -20,21 +26,24 @@ type alias Model =
type alias Board = type alias Board =
List (List Cell) Array (Array Cell)
type alias Cell = type alias Cell =
Maybe Int Maybe Int
isCellEmpty : Cell -> Bool type alias Position =
isCellEmpty cell = { row : Int
case cell of , col : Int
Nothing -> }
True
_ ->
False type Direction
= Up
| Down
| Left
| Right
@ -48,8 +57,8 @@ boardSize_ =
initialBoard_ : Board initialBoard_ : Board
initialBoard_ = initialBoard_ =
List.repeat boardSize_ Array.repeat boardSize_
(List.repeat boardSize_ Nothing) (Array.repeat boardSize_ Nothing)
initialModel : Model initialModel : Model
@ -61,54 +70,157 @@ initialModel =
-- GAME RULES -- GAME RULES
generateRandomCell_ : Model -> Model flatten_ : Array (Array a) -> Array a
generateRandomCell_ model = flatten_ =
model Array.foldr Array.append Array.empty
foldDown_ : Model -> Model pop_ : List a -> List a
foldDown_ model = pop_ l =
model 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
foldUp_ 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
foldLeft_ 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
foldRight_ model = foldRight_ model =
model let
newBoard =
model.board |> Array.map (Array.toList >> foldRowRight_ >> Array.fromList)
in
setBoard model newBoard
moveDown : Model -> Model foldRowLeft_ : List Cell -> List Cell
moveDown model = foldRowLeft_ =
model List.reverse >> foldRowRight_ >> List.reverse
|> foldDown_
|> generateRandomCell_
moveUp : Model -> Model foldRowRight_ : List Cell -> List Cell
moveUp model = foldRowRight_ row =
model row
|> foldUp_ |> List.filter ((/=) Nothing)
|> generateRandomCell_ |> List.map (Maybe.withDefault 0)
|> foldNumsListRight_
|> List.map Just
|> (\folded -> List.repeat (List.length row - List.length folded) Nothing ++ folded)
moveLeft : Model -> Model foldNumsListRight_ : List Int -> List Int
moveLeft model = foldNumsListRight_ =
model doFoldNumsListRight_ [ 0 ]
|> foldLeft_
|> generateRandomCell_
moveRight : Model -> Model doFoldNumsListRight_ : List Int -> List Int -> List Int
moveRight model = doFoldNumsListRight_ result original =
model case original of
|> foldRight_ [] ->
|> generateRandomCell_ 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
View file

@ -1,10 +1,18 @@
module Main exposing (..) module Main exposing (..)
import Browser import Browser
import Element as UI import Browser.Events
import Cmd exposing (generateRandomPositionedCell)
import Element exposing (..)
import Game import Game
import Html exposing (Html) 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 = type alias Document msg =
@ -19,89 +27,100 @@ main =
{ init = init { init = init
, update = update , update = update
, view = view , view = view
, subscriptions = \_ -> Sub.none , subscriptions = subscriptions
} }
-- INIT
init : () -> ( Game.Model, Cmd Msg ) init : () -> ( Game.Model, Cmd Msg )
init _ = init _ =
( Game.initialModel let
, Cmd.none 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 -> Game.Model -> ( Game.Model, Cmd Msg )
update msg model = update msg model =
case msg of case msg of
Msg.ArrowDown -> Msg.KeyPressed KeyEventUnknown ->
( model |> Game.moveDown ( 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 , Cmd.none
) )
Msg.ArrowUp ->
( model |> Game.moveUp
, Cmd.none
)
Msg.ArrowLeft ->
( model |> Game.moveLeft
, Cmd.none
)
Msg.ArrowRight -> -- VIEW
( model |> Game.moveRight
, Cmd.none
)
view : Game.Model -> Document Msg view : Game.Model -> Document Msg
view model = view model =
{ title = "2048" { 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
View file

@ -1,8 +1,35 @@
module Msg exposing (Msg(..)) module Msg exposing (KeyEvent(..), Msg(..), keyToDirection)
import Game exposing (Cell, Direction(..), Position)
type Msg type Msg
= ArrowUp = KeyPressed KeyEvent
| ArrowDown | RandomCellGenerated ( Maybe Position, Cell )
| ArrowLeft
| ArrowRight
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
View 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 ]