From 046f6effd5a0ee564c5a3009d6a382166c137522 Mon Sep 17 00:00:00 2001 From: tkshillinz Date: Sun, 1 Nov 2020 11:56:37 -0400 Subject: [PATCH] integrated board into top --- src/Game/Board.elm | 76 +++---- src/Pages/Top.elm | 498 ++++++--------------------------------------- 2 files changed, 94 insertions(+), 480 deletions(-) diff --git a/src/Game/Board.elm b/src/Game/Board.elm index 9ed42e3..54c1ecf 100644 --- a/src/Game/Board.elm +++ b/src/Game/Board.elm @@ -3,17 +3,17 @@ module Game.Board exposing , Cellname(..) , ChosenPiece , Colour(..) - , Gamestatus - , Model + , Gamepiece , Pattern(..) , PlayedPieces , RemainingPieces , Shape(..) , Size(..) - , Turn - , Winner - , initialModel + , availableCells + , gamepieceToList + , initialBoard , isWin + , nameToString , playedPieces , unPlayedPieces , updateBoard @@ -202,6 +202,11 @@ type Cellname | D4 +names : List Cellname +names = + [ A1, A2, A3, A4, B1, B2, B3, B4, C1, C2, C3, C4, D1, D2, D3, D4 ] + + winningNames : List (FourOf Cellname) winningNames = [ FourOf { first = A1, second = A2, third = A3, fourth = A4 } @@ -375,37 +380,6 @@ type alias ChosenPiece = Gamepiece -type Turn - = HumanChoosing - | ComputerPlaying ChosenPiece - | ComputerChoosing - | HumanPlaying ChosenPiece - - -type alias Winner = - String - - - --- GAMESTATUS - - -type Gamestatus - = InPlay Turn - | Won Winner - | Draw - - - --- MODEL - - -type alias Model = - { board : BoardState - , status : Gamestatus - } - - -- INIT @@ -416,16 +390,8 @@ initialBoard = |> List.map (PieceState Unplayed) -initialGamestatus : Gamestatus -initialGamestatus = - InPlay HumanChoosing - -initialModel : Model -initialModel = - { board = initialBoard - , status = initialGamestatus - } +-- UPDATE updateBoard : Cellname -> Gamepiece -> BoardState -> BoardState @@ -442,5 +408,25 @@ updateBoard name gamepiece board = board +tryPieceStateToName : PieceState -> Maybe Cellname +tryPieceStateToName ps = + case ps.status of + Played name -> + Just name + + Unplayed -> + Nothing + + +availableCells : BoardState -> List Cellname +availableCells board = + let + taken = + List.filterMap tryPieceStateToName board + in + names + |> List.filter (\name -> List.any ((==) name) taken) + + -- diff --git a/src/Pages/Top.elm b/src/Pages/Top.elm index 6a53743..a636490 100644 --- a/src/Pages/Top.elm +++ b/src/Pages/Top.elm @@ -1,31 +1,36 @@ module Pages.Top exposing - ( Colour(..) - , Effect(..) - , Gamepiece + ( Effect(..) , Model , Msg , Params - , Pattern(..) - , Shape(..) - , Size(..) , initModel - , matchingDimensions , page , update , view , withNoEffects ) +import Dict 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 + exposing + ( BoardState + , Cellname(..) + , Colour(..) + , Gamepiece + , Pattern(..) + , PlayedPieces + , Shape(..) + , Size(..) + ) import List.Extra as Liste import Pages.NotFound exposing (Msg) import Process -import Set import Spa.Document exposing (Document) import Spa.Page as Page exposing (Page) import Spa.Url as Url @@ -49,90 +54,29 @@ page = } - --- 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 SelectedPiece = + Gamepiece -type Cellname - = A1 - | B1 - | C1 - | D1 - | A2 - | B2 - | C2 - | D2 - | A3 - | B3 - | C3 - | D3 - | A4 - | B4 - | C4 - | D4 - - -type Cellstate +type Cellstatus = EmptyCell | Occupied Gamepiece type alias Cell = { name : Cellname - , state : Cellstate + , state : Cellstatus } -type alias CellBoard = - { a1 : Cell - , a2 : Cell - , a3 : Cell - , a4 : Cell - , b1 : Cell - , b2 : Cell - , b3 : Cell - , b4 : Cell - , c1 : Cell - , c2 : Cell - , c3 : Cell - , c4 : Cell - , d1 : Cell - , d2 : Cell - , d3 : Cell - , d4 : Cell - } - +toCell : Cellname -> PlayedPieces -> Cell +toCell name pieces = + case Dict.get (Board.nameToString name) pieces of + Just gamepiece -> + Cell name (Occupied gamepiece) -type alias SelectedPiece = - Gamepiece + Nothing -> + Cell name EmptyCell type Turn @@ -153,168 +97,21 @@ type Gamestatus type alias Model = - { board : CellBoard - , remainingPieces : List Gamepiece - , gamestatus : Gamestatus + { board : BoardState + , status : Gamestatus } - --- Gamepiece Dimension helpers - - -shapes : List Shape -shapes = - [ Square, Circle ] - - -shapeToString : Shape -> String -shapeToString shape = - case shape of - Square -> - "Square" - - Circle -> - "Circle" - - -colours : List Colour -colours = - [ Colour1, Colour2 ] - - -colourToString : Colour -> String -colourToString colour = - case colour of - Colour1 -> - "Colour1" - - Colour2 -> - "Colour2" - - -patterns : List Pattern -patterns = - [ Solid, Hollow ] - - -patternToString : Pattern -> String -patternToString pattern = - case pattern of - Solid -> - "Solid" - - Hollow -> - "Hollow" - - -sizes : List Size -sizes = - [ Small, Large ] - - -sizeToString : Size -> String -sizeToString size = - case size of - Small -> - "Small" - - Large -> - "Large" - - - --- Gamepiece helpers - - -gamepieceToList : Gamepiece -> List String -gamepieceToList { shape, colour, pattern, size } = - [ shapeToString shape - , colourToString colour - , patternToString pattern - , sizeToString size - ] - - gamepieceToString : Gamepiece -> String gamepieceToString gamepiece = gamepiece - |> gamepieceToList + |> Board.gamepieceToList |> List.intersperse " " |> String.concat -- Cell Name Helpers - - -cellnameToString : Cellname -> String -cellnameToString name = - case name of - A1 -> - "A1" - - A2 -> - "A2" - - A3 -> - "A3" - - A4 -> - "A4" - - B1 -> - "B1" - - B2 -> - "B2" - - B3 -> - "B3" - - B4 -> - "B4" - - C1 -> - "C1" - - C2 -> - "C2" - - C3 -> - "C3" - - C4 -> - "C4" - - D1 -> - "D1" - - D2 -> - "D2" - - D3 -> - "D3" - - D4 -> - "D4" - - - --- Cell helpers - - -cellstateToMaybe : Cellstate -> Maybe Gamepiece -cellstateToMaybe cellstate = - case cellstate of - Occupied gamepiece -> - Just gamepiece - - EmptyCell -> - Nothing - - - -- Turn helpers @@ -343,41 +140,10 @@ initialTurn = HumanChoosing -initialCells : CellBoard -initialCells = - let - nameToCell name = - { name = name, state = EmptyCell } - in - { a1 = nameToCell A1 - , a2 = nameToCell A2 - , a3 = nameToCell A3 - , a4 = nameToCell A4 - , b1 = nameToCell B1 - , b2 = nameToCell B2 - , b3 = nameToCell B3 - , b4 = nameToCell B4 - , c1 = nameToCell C1 - , c2 = nameToCell C2 - , c3 = nameToCell C3 - , c4 = nameToCell C4 - , d1 = nameToCell D1 - , d2 = nameToCell D2 - , d3 = nameToCell D3 - , d4 = nameToCell D4 - } - - -initialPieces : List Gamepiece -initialPieces = - Liste.lift4 Gamepiece shapes colours patterns sizes - - initModel : Model initModel = - { board = initialCells - , remainingPieces = initialPieces - , gamestatus = InPlay initialTurn + { board = Board.initialBoard + , status = InPlay initialTurn } @@ -404,9 +170,9 @@ type Msg update : Msg -> Model -> ( Model, Effect ) update msg model = - case ( msg, model.gamestatus ) of + case ( msg, model.status ) of ( ClickedPiece gamepiece, InPlay HumanChoosing ) -> - { model | gamestatus = InPlay (ComputerPlaying gamepiece) } + { model | status = InPlay (ComputerPlaying gamepiece) } |> withEffect (Delay 2 HumanChosePiece) ( HumanChosePiece, InPlay (ComputerPlaying gamepiece) ) -> @@ -416,9 +182,11 @@ update msg model = |> Maybe.withDefault (withNoEffects model) ( ComputerPlayedPiece, InPlay ComputerChoosing ) -> - trySelectpiece model.remainingPieces - |> Maybe.map (\piece -> { model | gamestatus = InPlay (HumanPlaying piece) }) - |> Maybe.withDefault { model | gamestatus = Draw } + model.board + |> Board.unPlayedPieces + |> trySelectpiece + |> Maybe.map (\piece -> { model | status = InPlay (HumanPlaying piece) }) + |> Maybe.withDefault { model | status = Draw } |> withNoEffects ( ClickedGameboard cell, InPlay (HumanPlaying gamepiece) ) -> @@ -449,27 +217,10 @@ updateCellClicked cell piece model = |> checkForWin (HumanPlaying piece) -tryFindAvailableCells : CellBoard -> Maybe Cellname -tryFindAvailableCells b = - [ b.a1 - , b.a2 - , b.a3 - , b.a4 - , b.b1 - , b.b2 - , b.b3 - , b.b4 - , b.c1 - , b.c2 - , b.c3 - , b.c4 - , b.d1 - , b.d2 - , b.d3 - , b.d4 - ] - |> List.filter (\cell -> cell.state == EmptyCell) - |> List.map (\cell -> cell.name) +tryFindAvailableCells : BoardState -> Maybe Cellname +tryFindAvailableCells board = + board + |> Board.availableCells |> List.head @@ -480,152 +231,29 @@ trySelectpiece gamepiece = updateGamepiecePlaced : Gamepiece -> Model -> Cellname -> Model updateGamepiecePlaced gamepiece model name = - let - newBoard = - updateCellBoard name gamepiece model.board - - remainingPieces = - updateRemaining gamepiece model.remainingPieces - in - { model | remainingPieces = remainingPieces, board = newBoard } + Board.updateBoard name gamepiece model.board + |> (\newBoard -> { model | board = newBoard }) checkForWin : Turn -> Model -> ( Model, Effect ) checkForWin turn model = - case ( turn, isWin model.board ) of + case ( turn, Board.isWin model.board ) of ( _, True ) -> - { model | gamestatus = Won (turnToActivePlayer turn) } + { model | status = Won (turnToActivePlayer turn) } |> withNoEffects ( HumanPlaying _, False ) -> - { model | gamestatus = InPlay HumanChoosing } + { model | status = InPlay HumanChoosing } |> withNoEffects ( ComputerPlaying _, False ) -> - { model | gamestatus = InPlay ComputerChoosing } + { model | status = InPlay ComputerChoosing } |> withEffect (Delay 2 ComputerPlayedPiece) _ -> model |> withNoEffects -updateCellBoard : Cellname -> Gamepiece -> CellBoard -> CellBoard -updateCellBoard name piece board = - let - newCell = - { name = name, state = Occupied piece } - in - case name of - A1 -> - { board | a1 = newCell } - - A2 -> - { board | a2 = newCell } - - A3 -> - { board | a3 = newCell } - - A4 -> - { board | a4 = newCell } - - B1 -> - { board | b1 = newCell } - - B2 -> - { board | b2 = newCell } - - B3 -> - { board | b3 = newCell } - - B4 -> - { board | b4 = newCell } - - C1 -> - { board | c1 = newCell } - - C2 -> - { board | c2 = newCell } - - C3 -> - { board | c3 = newCell } - - C4 -> - { board | c4 = newCell } - - D1 -> - { board | d1 = newCell } - - D2 -> - { board | d2 = newCell } - - D3 -> - { board | d3 = newCell } - - D4 -> - { board | d4 = newCell } - - -updateRemaining : Gamepiece -> List Gamepiece -> List Gamepiece -updateRemaining piece remainingPieces = - List.filter ((/=) piece) remainingPieces - - -boardToWinnableCells : CellBoard -> List (List Cell) -boardToWinnableCells board = - let - isCellFilled { state } = - state /= EmptyCell - in - [ [ board.a1, board.a2, board.a3, board.a4 ] -- column A - , [ board.b1, board.b2, board.b3, board.b4 ] -- column B - , [ board.c1, board.c2, board.c3, board.c4 ] -- column C - , [ board.d1, board.d2, board.d3, board.d4 ] -- column D - , [ board.a1, board.b1, board.c1, board.d1 ] -- row 1 - , [ board.a2, board.b2, board.c2, board.d2 ] -- row 2 - , [ board.a3, board.b3, board.c3, board.d3 ] -- row 3 - , [ board.a4, board.b4, board.c4, board.d4 ] -- row 4 - , [ board.a1, board.b2, board.c3, board.d4 ] -- back slash diagonal - , [ board.a4, board.b3, board.c2, board.d1 ] -- forward slash diagonal - ] - |> List.filter (List.all isCellFilled) - - -matchingDimensions : List Gamepiece -> Bool -matchingDimensions gamepieces = - gamepieces - -- convert from list of game pieces to sets of strings - |> List.map (gamepieceToList >> Set.fromList) - -- { "Circle", "Filled", "Colour1, ""Large"} - -- interset the sets to make one set of common values - |> Liste.foldl1 Set.intersect - -- convert from Maybe set to set - |> Maybe.withDefault Set.empty - -- return True is set isn't empty, false if it is - |> not - << Set.isEmpty - - -isWin : CellBoard -> Bool -isWin board = - board - -- turn a board to list of lists of game winning cells - |> boardToWinnableCells - -- strip cell names - |> List.map (List.map (\{ state } -> state)) - -- convert cells to gamepieces and filter out cells that dont have gamepieces in them - |> List.map (List.map cellstateToMaybe) - |> List.map (List.filterMap identity) - -- filter out those that aren't filled in - |> List.filter (\x -> List.length x >= 4) - -- turn to list of booleans on if cells have matches - |> List.map matchingDimensions - -- filter out false values - |> List.filter identity - -- if any values remain, return bool - |> not - << List.isEmpty - - -- Cmd and Effects @@ -688,9 +316,9 @@ view model = { title = "Quarto - Play" , body = [ column [ spacing 10, centerX ] - [ viewRemainingPieces model.remainingPieces - , viewGamestatus model.gamestatus - , viewBoard model.board + [ viewRemainingPieces (Board.unPlayedPieces model.board) + , viewGamestatus model.status + , viewBoard (Board.playedPieces model.board) ] ] } @@ -754,15 +382,15 @@ viewCell { name, state } = viewGamepiece gamepiece EmptyCell -> - viewSvgbox [ Svg.text <| cellnameToString name ] + viewSvgbox [ Svg.text <| Board.nameToString name ] -viewCellButton : Cell -> Element Msg -viewCellButton cell = +viewCellButton : PlayedPieces -> Cellname -> Element Msg +viewCellButton pieces name = Input.button - [ Border.color Styles.blue, Border.width 5, Region.description (cellStateToDescription cell) ] - { onPress = Just (ClickedGameboard cell) - , label = viewCell cell + [ Border.color Styles.blue, Border.width 5, Region.description (cellStateToDescription (toCell name pieces)) ] + { onPress = Just (ClickedGameboard (toCell name pieces)) + , label = viewCell (toCell name pieces) } @@ -772,14 +400,14 @@ viewRestartButton = { onPress = Just ClickedRestart, label = text "Restart" } -viewBoard : CellBoard -> Element Msg -viewBoard cellboard = +viewBoard : PlayedPieces -> Element Msg +viewBoard pieces = column [ centerX, Region.announce ] [ el [ Font.center, width fill ] (text "GameBoard") - , row [] <| List.map viewCellButton [ cellboard.a1, cellboard.b1, cellboard.c1, cellboard.d1 ] - , row [] <| List.map viewCellButton [ cellboard.a2, cellboard.b2, cellboard.c2, cellboard.d2 ] - , row [] <| List.map viewCellButton [ cellboard.a3, cellboard.b3, cellboard.c3, cellboard.d3 ] - , row [] <| List.map viewCellButton [ cellboard.a4, cellboard.b4, cellboard.c4, cellboard.d4 ] + , 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 ] ] @@ -813,10 +441,10 @@ cellStateToDescription : Cell -> String cellStateToDescription { name, state } = case state of EmptyCell -> - "Cell " ++ cellnameToString name ++ ": Empty cell" + "Cell " ++ Board.nameToString name ++ ": Empty cell" Occupied gamepiece -> - "Cell " ++ cellnameToString name ++ ": " ++ gamepieceToString gamepiece + "Cell " ++ Board.nameToString name ++ ": " ++ gamepieceToString gamepiece