From 78e684a94464603f2307d6f6e78e46fc1f90a7ff Mon Sep 17 00:00:00 2001 From: Tyrone Kirk Shillingford Date: Wed, 4 Nov 2020 10:18:40 -0400 Subject: [PATCH] Refactor update (#42) * finished creation of Game module * we should commit this --- elm.json | 7 +- src/Game.elm | 281 +++++++++++++++++++++++++++++++++++++ src/Game/Board.elm | 118 +++++----------- src/Game/Core.elm | 55 ++++++++ src/Helpers.elm | 25 ++++ src/Pages/Top.elm | 341 ++++++++++----------------------------------- 6 files changed, 479 insertions(+), 348 deletions(-) create mode 100644 src/Game.elm create mode 100644 src/Game/Core.elm create mode 100644 src/Helpers.elm diff --git a/elm.json b/elm.json index 8334578..215b11e 100644 --- a/elm.json +++ b/elm.json @@ -9,10 +9,12 @@ "elm/browser": "1.0.2", "elm/core": "1.0.5", "elm/html": "1.0.0", + "elm/random": "1.0.0", "elm/svg": "1.0.1", "elm/url": "1.0.0", "elm-community/list-extra": "8.2.4", - "mdgriffith/elm-ui": "1.1.7" + "mdgriffith/elm-ui": "1.1.7", + "mgold/elm-nonempty-list": "4.1.0" }, "indirect": { "elm/json": "1.1.3", @@ -29,8 +31,7 @@ "avh4/elm-fifo": "1.0.4", "elm/bytes": "1.0.8", "elm/file": "1.0.5", - "elm/http": "2.0.0", - "elm/random": "1.0.0" + "elm/http": "2.0.0" } } } diff --git a/src/Game.elm b/src/Game.elm new file mode 100644 index 0000000..51fc281 --- /dev/null +++ b/src/Game.elm @@ -0,0 +1,281 @@ +module Game exposing + ( Cell + , GameStatus(..) + , Model(..) + , Msg(..) + , Player(..) + , Turn(..) + , currentStatus + , gameboard + , init + , nameToString + , pieceToString + , playerToString + , remainingPieces + , update + ) + +import Dict +import Game.Board as Board + exposing + ( Board + , BoardStatus(..) + ) +import Game.Core exposing (Cellname(..), Gamepiece) +import Helpers exposing (andThen, map, noCmds, withCmd) +import List.Nonempty as Listn +import Process +import Random +import Shared exposing (Model) +import Task + + + +-- DOMAIN + + +type Player + = Human + | Computer + + +type alias ActivePlayer = + Player + + +type alias Winner = + Player + + +type alias Cell = + { name : Cellname + , status : Maybe Gamepiece + } + + +type alias ChosenPiece = + Gamepiece + + +type GeneratorOptions + = GetGamepiece + | GetCell + + +type Turn + = ChoosingPiece + | ChoosingCellToPlay ChosenPiece + + +type GameStatus + = InPlay ActivePlayer Turn + | Won Winner + | Draw + + +type Model + = Model { board : Board, status : GameStatus } + + + +-- INIT + + +initStatus : GameStatus +initStatus = + InPlay Human ChoosingPiece + + +init : Model +init = + Model { board = Board.init, status = initStatus } + + + +-- Msg + + +type Msg + = HumanSelectedPiece Gamepiece + | HumanSelectedCell Cellname + | RestartWanted + | ComputerSelectedCell Cellname + | ComputerSelectedPiece Gamepiece + | NoOp + + + +-- UPDATE + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg (Model model) = + case ( msg, model.status ) of + ( HumanSelectedPiece piece, InPlay Human ChoosingPiece ) -> + Model model + |> noCmds + |> map (nextPlayerStartsPlaying Human piece) + |> withCmd (wait 2) + |> andThen (computerChooses GetCell) + + ( ComputerSelectedCell name, InPlay Computer (ChoosingCellToPlay piece) ) -> + Model model + |> noCmds + |> map (playerMakesPlay name piece) + |> andThen (checkForWin Computer) + + ( ComputerSelectedPiece piece, InPlay Computer ChoosingPiece ) -> + Model model + |> noCmds + |> map (nextPlayerStartsPlaying Computer piece) + + ( HumanSelectedCell name, InPlay Human (ChoosingCellToPlay piece) ) -> + Model model + |> noCmds + |> map (playerMakesPlay name piece) + |> andThen (checkForWin Human) + + ( RestartWanted, _ ) -> + init |> noCmds + + ( NoOp, _ ) -> + Model model |> noCmds + + _ -> + Model model |> noCmds + + +nextPlayerStartsPlaying : ActivePlayer -> Gamepiece -> Model -> Model +nextPlayerStartsPlaying player piece (Model model) = + Model { model | status = InPlay (switch player) (ChoosingCellToPlay piece) } + + +computerChooses : GeneratorOptions -> Model -> ( Model, Cmd Msg ) +computerChooses opt (Model model) = + let + helper : (a -> Msg) -> List a -> ( Model, Cmd Msg ) + helper msg lst = + lst + |> Listn.fromList + |> Maybe.map + (\items -> + ( Model model, Random.generate msg (Listn.sample items) ) + ) + |> Maybe.withDefault (Model model |> noCmds) + in + case opt of + GetCell -> + Board.openCells model.board + |> helper ComputerSelectedCell + + GetGamepiece -> + Board.unPlayedPieces model.board + |> helper ComputerSelectedPiece + + +playerMakesPlay : Cellname -> Gamepiece -> Model -> Model +playerMakesPlay name piece (Model model) = + let + newBoard = + Board.update name piece model.board + in + Model { model | board = newBoard } + + +checkForWin : ActivePlayer -> Model -> ( Model, Cmd Msg ) +checkForWin player (Model ({ board, status } as model)) = + case ( player, Board.status board ) of + ( Computer, CanContinue ) -> + Model model + |> noCmds + |> map (playerStartsChoosing Computer) + |> withCmd (wait 2) + |> andThen (computerChooses GetGamepiece) + + ( Human, CanContinue ) -> + Model model + |> noCmds + |> map (playerStartsChoosing Human) + + ( _, MatchFound ) -> + Model { model | status = Won player } + |> noCmds + + ( _, Full ) -> + Model { model | status = Draw } |> noCmds + + +playerStartsChoosing : Player -> Model -> Model +playerStartsChoosing player (Model model) = + Model { model | status = InPlay player ChoosingPiece } + + + +-- Cmd Msg + + +type Seconds + = Seconds Int + + +wait : Int -> Cmd Msg +wait i = + delay (Seconds i) NoOp + + +delay : Seconds -> Msg -> Cmd Msg +delay (Seconds time) msg = + Process.sleep (toFloat <| time * 1000) + |> Task.andThen (always <| Task.succeed msg) + |> Task.perform identity + + + +-- UTILITY + + +switch : ActivePlayer -> ActivePlayer +switch player = + if player == Human then + Computer + + else + Human + + +gameboard : Model -> (Cellname -> Cell) +gameboard (Model model) = + \name -> + Board.playedPieces model.board + |> Dict.get (Board.nameToString name) + |> Cell name + + +remainingPieces : Model -> List Gamepiece +remainingPieces (Model model) = + Board.unPlayedPieces model.board + + +currentStatus : Model -> GameStatus +currentStatus (Model model) = + model.status + + +playerToString : Player -> String +playerToString player = + case player of + Human -> + "Human" + + Computer -> + "Computer" + + +nameToString : Cellname -> String +nameToString = + Board.nameToString + + +pieceToString : Gamepiece -> String +pieceToString = + Board.pieceToString diff --git a/src/Game/Board.elm b/src/Game/Board.elm index 3a2a61b..1caf33a 100644 --- a/src/Game/Board.elm +++ b/src/Game/Board.elm @@ -1,24 +1,27 @@ module Game.Board exposing - ( BoardState - , Cellname(..) - , Colour(..) - , Gamepiece - , Pattern(..) - , PlayedPieces - , Shape(..) - , Size(..) - , availableCells - , boardStatus - , hasMatch - , initialBoard + ( Board + , BoardStatus(..) + , PlayedDict + , init , nameToString + , openCells , pieceToString , playedPieces + , status , unPlayedPieces - , updateBoard + , update ) import Dict exposing (Dict) +import Game.Core + exposing + ( Cellname(..) + , Colour(..) + , Gamepiece + , Pattern(..) + , Shape(..) + , Size(..) + ) import List.Extra as Liste import Set @@ -27,35 +30,7 @@ import Set -- Domain -type Shape - = Square - | Circle - - -type Colour - = Colour1 - | Colour2 - - -type Pattern - = Solid - | Hollow - - -type Size - = Small - | Large - - -type alias Gamepiece = - { shape : Shape - , colour : Colour - , pattern : Pattern - , size : Size - } - - -type alias PlayedPieces = +type alias PlayedDict = Dict String Gamepiece @@ -68,25 +43,6 @@ type FourOf a } -type Cellname - = A1 - | B1 - | C1 - | D1 - | A2 - | B2 - | C2 - | D2 - | A3 - | B3 - | C3 - | D3 - | A4 - | B4 - | C4 - | D4 - - type alias GameCell = ( Cellname, Gamepiece ) @@ -102,7 +58,7 @@ type alias PieceState = } -type alias BoardState = +type alias Board = List PieceState @@ -268,14 +224,14 @@ pieceToString gamepiece = -- Played pieces and Unplayed Pieces -playedPieces : BoardState -> PlayedPieces +playedPieces : Board -> PlayedDict playedPieces boardstate = boardstate |> List.filterMap tryPieceStateToCell |> List.foldl dictUpdate Dict.empty -unPlayedPieces : BoardState -> List Gamepiece +unPlayedPieces : Board -> List Gamepiece unPlayedPieces boardstate = boardstate |> List.filter (.status >> (==) Unplayed) @@ -290,8 +246,8 @@ tryPieceStateToCell pstate = tryPieceCellname : PieceStatus -> Maybe Cellname -tryPieceCellname status = - case status of +tryPieceCellname pstatus = + case pstatus of Unplayed -> Nothing @@ -299,7 +255,7 @@ tryPieceCellname status = Just name -dictUpdate : GameCell -> PlayedPieces -> PlayedPieces +dictUpdate : GameCell -> PlayedDict -> PlayedDict dictUpdate ( name, piece ) dict = Dict.insert (nameToString name) piece dict @@ -308,8 +264,8 @@ dictUpdate ( name, piece ) dict = -- INIT -initialBoard : BoardState -initialBoard = +init : Board +init = Liste.lift4 Gamepiece shapes colours patterns sizes |> List.map (PieceState Unplayed) @@ -318,8 +274,8 @@ initialBoard = -- UPDATE -updateBoard : Cellname -> Gamepiece -> BoardState -> BoardState -updateBoard name gamepiece board = +update : Cellname -> Gamepiece -> Board -> Board +update name gamepiece board = let pieceUnplayed = { status = Unplayed, gamepiece = gamepiece } @@ -328,7 +284,7 @@ updateBoard name gamepiece board = { status = Played name, gamepiece = gamepiece } nameIsUnused = - List.member name (availableCells board) + List.member name (openCells board) in Liste.setIf (\piece -> (piece == pieceUnplayed) && nameIsUnused) piecePlayed board @@ -343,8 +299,8 @@ tryPieceStateToName ps = Nothing -availableCells : BoardState -> List Cellname -availableCells board = +openCells : Board -> List Cellname +openCells board = let taken = List.filterMap tryPieceStateToName board @@ -357,8 +313,8 @@ availableCells board = -- BOARD status -boardStatus : BoardState -> BoardStatus -boardStatus board = +status : Board -> BoardStatus +status board = if hasMatch board then MatchFound @@ -369,16 +325,16 @@ boardStatus board = CanContinue -isFull : BoardState -> Bool +isFull : Board -> Bool isFull board = board |> unPlayedPieces |> List.isEmpty -hasMatch : BoardState -> Bool +hasMatch : Board -> Bool hasMatch board = board |> playedPieces - |> (\pieces -> List.map (playedPiecesToCombos pieces) allWinningNames) + |> (\pieces -> List.map (playedPiecesToCombo pieces) allWinningNames) |> List.filterMap identity |> List.filter isMatchingFourOf |> (not << List.isEmpty) @@ -411,8 +367,8 @@ isMatchingFourOf (FourOf { first, second, third, fourth }) = |> (not << Set.isEmpty) -playedPiecesToCombos : PlayedPieces -> FourOf Cellname -> Maybe (FourOf Gamepiece) -playedPiecesToCombos pieces winningNames = +playedPiecesToCombo : PlayedDict -> FourOf Cellname -> Maybe (FourOf Gamepiece) +playedPiecesToCombo pieces winningNames = let get s = Dict.get s pieces diff --git a/src/Game/Core.elm b/src/Game/Core.elm new file mode 100644 index 0000000..d0e3b0c --- /dev/null +++ b/src/Game/Core.elm @@ -0,0 +1,55 @@ +module Game.Core exposing + ( Cellname(..) + , Colour(..) + , Gamepiece + , Pattern(..) + , Shape(..) + , Size(..) + ) + + +type Shape + = Square + | Circle + + +type Colour + = Colour1 + | Colour2 + + +type Pattern + = Solid + | Hollow + + +type Size + = Small + | Large + + +type Cellname + = A1 + | B1 + | C1 + | D1 + | A2 + | B2 + | C2 + | D2 + | A3 + | B3 + | C3 + | D3 + | A4 + | B4 + | C4 + | D4 + + +type alias Gamepiece = + { shape : Shape + , colour : Colour + , pattern : Pattern + , size : Size + } diff --git a/src/Helpers.elm b/src/Helpers.elm new file mode 100644 index 0000000..3131190 --- /dev/null +++ b/src/Helpers.elm @@ -0,0 +1,25 @@ +module Helpers exposing (andThen, map, noCmds, withCmd) + + +withCmd : Cmd msg -> ( a, Cmd msg ) -> ( a, Cmd msg ) +withCmd cmds ( model, moreCmds ) = + ( model, Cmd.batch [ cmds, moreCmds ] ) + + +noCmds : a -> ( a, Cmd msg ) +noCmds model = + ( model, Cmd.none ) + + +map : (a -> a) -> ( a, Cmd msg ) -> ( a, Cmd msg ) +map f ma = + andThen (noCmds << f) ma + + +andThen : (a -> ( a, Cmd msg )) -> ( a, Cmd msg ) -> ( a, Cmd msg ) +andThen f ( model, cmds ) = + let + ( newa, moreCmds ) = + f model + in + ( newa, Cmd.batch [ cmds, moreCmds ] ) diff --git a/src/Pages/Top.elm b/src/Pages/Top.elm index e51e9fa..f9480a4 100644 --- a/src/Pages/Top.elm +++ b/src/Pages/Top.elm @@ -1,151 +1,86 @@ module Pages.Top exposing - ( Effect(..) - , Model + ( Model , Msg , Params - , initModel , page , update , view - , withNoEffects ) -import Dict -import Element exposing (Element, centerX, column, el, fill, row, spacing, text, width) +import Element + exposing + ( Element + , centerX + , column + , el + , fill + , row + , spacing + , text + , width + ) import Element.Background as Background import Element.Border as Border import Element.Font as Font import Element.Input as Input import Element.Region as Region -import Game.Board as Board +import Game + exposing + ( Cell + , GameStatus(..) + , Msg(..) + , Player(..) + , Turn(..) + ) +import Game.Core exposing - ( BoardState - , Cellname(..) + ( Cellname(..) , Colour(..) , Gamepiece , Pattern(..) - , PlayedPieces , Shape(..) , Size(..) ) import List.Extra as Liste import Pages.NotFound exposing (Msg) -import Process import Spa.Document exposing (Document) import Spa.Page as Page exposing (Page) import Spa.Url as Url import Styles import Svg exposing (Svg, svg) import Svg.Attributes as Attr -import Task page : Page Params Model Msg page = Page.element - { init = - \params -> - init params |> Tuple.mapSecond perform - , update = - \msg model -> - update msg model |> Tuple.mapSecond perform + { init = init + , update = update , view = view , subscriptions = subscriptions } -type alias ChosenPiece = - Gamepiece - - -type Cellstatus - = EmptyCell - | Occupied Gamepiece - - -type alias Cell = - { name : Cellname - , state : Cellstatus - } - - -toCell : Cellname -> PlayedPieces -> Cell -toCell name pieces = - case Dict.get (Board.nameToString name) pieces of - Just gamepiece -> - Cell name (Occupied gamepiece) - - Nothing -> - Cell name EmptyCell - - -type Turn - = HumanChoosing - | ComputerPlaying ChosenPiece - | ComputerChoosing - | HumanPlaying ChosenPiece - - -type alias Winner = - String - - -type Gamestatus - = InPlay Turn - | Won Winner - | Draw - - type alias Model = - { board : BoardState - , status : Gamestatus - } - - - --- Cell Name Helpers --- Turn helpers - - -turnToActivePlayer : Turn -> String -turnToActivePlayer turn = - case turn of - HumanChoosing -> - "Human Player" - - HumanPlaying _ -> - "Human Player" - - ComputerChoosing -> - "Computer Player" - - ComputerPlaying _ -> - "Computer Player" + { game : Game.Model } -- INIT -initialTurn : Turn -initialTurn = - HumanChoosing - - initModel : Model initModel = - { board = Board.initialBoard - , status = InPlay initialTurn - } + { game = Game.init } type alias Params = () -init : Url.Url Params -> ( Model, Effect ) +init : Url.Url Params -> ( Model, Cmd Msg ) init _ = - ( initModel, NoEffect ) + ( initModel, Cmd.none ) @@ -153,141 +88,26 @@ init _ = type Msg - = ClickedPiece Gamepiece - | ClickedGameboard Cell - | ClickedRestart - | HumanChosePiece - | ComputerPlayedPiece - - -update : Msg -> Model -> ( Model, Effect ) -update msg model = - case ( msg, model.status ) of - ( ClickedPiece gamepiece, InPlay HumanChoosing ) -> - { model | status = InPlay (ComputerPlaying gamepiece) } - |> withEffect (Delay 2 HumanChosePiece) - - ( HumanChosePiece, InPlay (ComputerPlaying gamepiece) ) -> - tryFindAvailableCells model.board - |> Maybe.map (updateGamepiecePlaced gamepiece model) - |> Maybe.map (checkForWin (ComputerPlaying gamepiece)) - |> Maybe.withDefault (withNoEffects model) - - ( ComputerPlayedPiece, InPlay ComputerChoosing ) -> - model.board - |> Board.unPlayedPieces - |> trySelectpiece - |> Maybe.map (\piece -> { model | status = InPlay (HumanPlaying piece) }) - |> Maybe.withDefault { model | status = Draw } - |> withNoEffects - - ( ClickedGameboard cell, InPlay (HumanPlaying gamepiece) ) -> - updateCellClicked cell gamepiece model - - ( ClickedRestart, Won _ ) -> - initModel |> withNoEffects - - ( ClickedRestart, Draw ) -> - initModel |> withNoEffects + = GameMessage Game.Msg - _ -> - model |> withNoEffects +gameUpdateToUpdate : Model -> ( Game.Model, Cmd Game.Msg ) -> ( Model, Cmd Msg ) +gameUpdateToUpdate model ( gmodel, gcmds ) = + ( { model | game = gmodel } + , Cmd.map GameMessage gcmds + ) --- Update Helpers - - -updateCellClicked : Cell -> Gamepiece -> Model -> ( Model, Effect ) -updateCellClicked cell piece model = - case cell.state of - Occupied _ -> - model |> withNoEffects - - EmptyCell -> - updateGamepiecePlaced piece model cell.name - |> checkForWin (HumanPlaying piece) - - -tryFindAvailableCells : BoardState -> Maybe Cellname -tryFindAvailableCells board = - board - |> Board.availableCells - |> List.head - - -trySelectpiece : List Gamepiece -> Maybe Gamepiece -trySelectpiece gamepiece = - List.head gamepiece - - -updateGamepiecePlaced : Gamepiece -> Model -> Cellname -> Model -updateGamepiecePlaced gamepiece model name = - Board.updateBoard name gamepiece model.board - |> (\newBoard -> { model | board = newBoard }) - - -checkForWin : Turn -> Model -> ( Model, Effect ) -checkForWin turn model = - case ( turn, Board.hasMatch model.board ) of - ( _, True ) -> - { model | status = Won (turnToActivePlayer turn) } - |> withNoEffects - - ( HumanPlaying _, False ) -> - { model | status = InPlay HumanChoosing } - |> withNoEffects - - ( ComputerPlaying _, False ) -> - { model | status = InPlay ComputerChoosing } - |> withEffect (Delay 2 ComputerPlayedPiece) - - _ -> - model |> withNoEffects - - - --- Cmd and Effects - - -type alias Seconds = - Int - - -type Effect - = NoEffect - | Delay Seconds Msg - - - --- Cmd and Effect Helpers - - -delay : Float -> msg -> Cmd msg -delay time msg = - Process.sleep time - |> Task.andThen (always <| Task.succeed msg) - |> Task.perform identity - - -withEffect : Effect -> Model -> ( Model, Effect ) -withEffect effect model = - ( model, effect ) - - -withNoEffects : Model -> ( Model, Effect ) -withNoEffects = - withEffect NoEffect +-- gameMsgToMsg -perform : Effect -> Cmd Msg -perform effect = - case effect of - NoEffect -> - Cmd.none - Delay seconds msg -> - delay (toFloat seconds * 1000) msg +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + GameMessage msg_ -> + Game.update msg_ model.game + |> gameUpdateToUpdate model @@ -308,9 +128,9 @@ view model = { title = "Quarto - Play" , body = [ column [ spacing 10, centerX ] - [ viewRemainingPieces (Board.unPlayedPieces model.board) - , viewGamestatus model.status - , viewBoard (Board.playedPieces model.board) + [ viewRemainingPieces (Game.remainingPieces model.game) + , viewGamestatus (Game.currentStatus model.game) + , viewBoard (Game.gameboard model.game) ] ] } @@ -327,7 +147,7 @@ viewRemainingPieces remainingPieces = ] -viewGamestatus : Gamestatus -> Element Msg +viewGamestatus : GameStatus -> Element Msg viewGamestatus gamestatus = let containerize : Element Msg -> Element Msg @@ -336,70 +156,63 @@ viewGamestatus gamestatus = in case gamestatus of Won winner -> - row [] [ viewSvgbox [ Svg.text <| "Winner: " ++ winner ], viewRestartButton ] + row [] [ viewSvgbox [ Svg.text <| "Winner: " ++ Game.playerToString winner ], viewRestartButton ] |> containerize Draw -> - containerize (row [] [ viewSvgbox [ Svg.text "It's a Draw" ], viewRestartButton ]) - - InPlay (ComputerPlaying gamepiece) -> - row [] - [ text "Piece Selected: " - , viewGamepiece gamepiece - , text <| "Active Player: " ++ turnToActivePlayer (ComputerPlaying gamepiece) - ] + row [] [ viewSvgbox [ Svg.text "It's a Draw" ], viewRestartButton ] |> containerize - InPlay (HumanPlaying gamepiece) -> + InPlay player (ChoosingCellToPlay gamepiece) -> row [] [ text "Piece Selected: " , viewGamepiece gamepiece - , text <| "Active Player: " ++ turnToActivePlayer (HumanPlaying gamepiece) + , text <| "Active Player: " ++ Game.playerToString player ] |> containerize - InPlay turn -> + InPlay player ChoosingPiece -> row [] [ viewSvgbox [ Svg.rect [ Attr.width "60", Attr.height "60", Attr.fill "none" ] [] ] - , text <| "Active Player: " ++ turnToActivePlayer turn + , text <| "Active Player: " ++ Game.playerToString player ] |> containerize viewCell : Cell -> Element Msg -viewCell { name, state } = - case state of - Occupied gamepiece -> +viewCell { name, status } = + case status of + Just gamepiece -> viewGamepiece gamepiece - EmptyCell -> - viewSvgbox [ Svg.text <| Board.nameToString name ] + Nothing -> + viewSvgbox [ Svg.text <| Game.nameToString name ] -viewCellButton : PlayedPieces -> Cellname -> Element Msg -viewCellButton pieces name = +viewCellButton : Cell -> Element Msg +viewCellButton cell = Input.button - [ Border.color Styles.blue, Border.width 5, Region.description (cellStateToDescription (toCell name pieces)) ] - { onPress = Just (ClickedGameboard (toCell name pieces)) - , label = viewCell (toCell name pieces) + [ Border.color Styles.blue, Border.width 5, Region.description (cellStateToDescription cell) ] + { onPress = Just (GameMessage (HumanSelectedCell cell.name)) + , label = viewCell cell } viewRestartButton : Element Msg viewRestartButton = Input.button [ Background.color Styles.blue, Border.width 5, Font.color Styles.white ] - { onPress = Just ClickedRestart, label = text "Restart" } + { onPress = Just (GameMessage RestartWanted), label = text "Restart" } -viewBoard : PlayedPieces -> Element Msg -viewBoard pieces = +viewBoard : (Cellname -> Cell) -> Element Msg +viewBoard cellDict = column [ centerX, Region.announce ] [ el [ Font.center, width fill ] (text "GameBoard") - , row [] <| List.map (viewCellButton pieces) [ A1, B1, C1, D1 ] - , row [] <| List.map (viewCellButton pieces) [ A2, B2, C2, D2 ] - , row [] <| List.map (viewCellButton pieces) [ A3, B3, C3, D3 ] - , row [] <| List.map (viewCellButton pieces) [ A4, B4, C4, D4 ] + , row [] <| List.map (viewCellButton << cellDict) [ A1, B1, C1, D1 ] + , row [] <| List.map (viewCellButton << cellDict) [ A2, B2, C2, D2 ] + , row [] <| List.map (viewCellButton << cellDict) [ A3, B3, C3, D3 ] + , row [] <| List.map (viewCellButton << cellDict) [ A4, B4, C4, D4 ] ] @@ -410,10 +223,10 @@ viewRemainingPiecesButton gamepiece = viewGamepiece gamepiece ariaDescription = - Board.pieceToString gamepiece + Game.pieceToString gamepiece in Input.button [ Region.description ariaDescription ] - { onPress = Just (ClickedPiece gamepiece) + { onPress = Just (GameMessage (HumanSelectedPiece gamepiece)) , label = gamePieceImage } @@ -430,13 +243,13 @@ viewGamepiece gamepiece = cellStateToDescription : Cell -> String -cellStateToDescription { name, state } = - case state of - EmptyCell -> - "Cell " ++ Board.nameToString name ++ ": Empty cell" +cellStateToDescription { name, status } = + case status of + Nothing -> + "Cell " ++ Game.nameToString name ++ ": Empty cell" - Occupied gamepiece -> - "Cell " ++ Board.nameToString name ++ ": " ++ Board.pieceToString gamepiece + Just gamepiece -> + "Cell " ++ Game.nameToString name ++ ": " ++ Game.pieceToString gamepiece