From e0d3196a619a54c13a6229b5694456b9b0056418 Mon Sep 17 00:00:00 2001 From: tkshillinz Date: Mon, 2 Nov 2020 22:03:00 -0400 Subject: [PATCH] more refactors --- src/Game/Board.elm | 442 ++++++++++++++++++++++----------------------- src/Pages/Top.elm | 20 +- 2 files changed, 224 insertions(+), 238 deletions(-) diff --git a/src/Game/Board.elm b/src/Game/Board.elm index b6fde91..3a2a61b 100644 --- a/src/Game/Board.elm +++ b/src/Game/Board.elm @@ -1,19 +1,18 @@ module Game.Board exposing ( BoardState , Cellname(..) - , ChosenPiece , Colour(..) , Gamepiece , Pattern(..) , PlayedPieces - , RemainingPieces , Shape(..) , Size(..) , availableCells - , gamepieceToList + , boardStatus + , hasMatch , initialBoard - , isWin , nameToString + , pieceToString , playedPieces , unPlayedPieces , updateBoard @@ -25,7 +24,7 @@ import Set --- SHAPE +-- Domain type Shape @@ -33,107 +32,112 @@ type Shape | Circle -shapes : List Shape -shapes = - [ Square, Circle ] - - -shapeToString : Shape -> String -shapeToString shape = - case shape of - Square -> - "Square" - - Circle -> - "Circle" - - - --- COLOUR - - type Colour = Colour1 | Colour2 -colours : List Colour -colours = - [ Colour1, Colour2 ] +type Pattern + = Solid + | Hollow -colourToString : Colour -> String -colourToString colour = - case colour of - Colour1 -> - "Colour1" +type Size + = Small + | Large - Colour2 -> - "Colour2" +type alias Gamepiece = + { shape : Shape + , colour : Colour + , pattern : Pattern + , size : Size + } --- PATTERN +type alias PlayedPieces = + Dict String Gamepiece -type Pattern - = Solid - | Hollow +type FourOf a + = FourOf + { first : a + , second : a + , third : a + , fourth : a + } -patterns : List Pattern -patterns = - [ Solid, Hollow ] +type Cellname + = A1 + | B1 + | C1 + | D1 + | A2 + | B2 + | C2 + | D2 + | A3 + | B3 + | C3 + | D3 + | A4 + | B4 + | C4 + | D4 -patternToString : Pattern -> String -patternToString pattern = - case pattern of - Solid -> - "Solid" +type alias GameCell = + ( Cellname, Gamepiece ) - Hollow -> - "Hollow" +type PieceStatus + = Unplayed + | Played Cellname --- SIZE +type alias PieceState = + { status : PieceStatus + , gamepiece : Gamepiece + } -type Size - = Small - | Large +type alias BoardState = + List PieceState -sizes : List Size -sizes = - [ Small, Large ] +type BoardStatus + = MatchFound + | Full + | CanContinue -sizeToString : Size -> String -sizeToString size = - case size of - Small -> - "Small" - Large -> - "Large" +-- HELPERS + +shapes : List Shape +shapes = + [ Square, Circle ] --- GAMEPIECE +colours : List Colour +colours = + [ Colour1, Colour2 ] -type alias Gamepiece = - { shape : Shape - , colour : Colour - , pattern : Pattern - , size : Size - } +patterns : List Pattern +patterns = + [ Solid, Hollow ] -gamepieceToList : Gamepiece -> List String -gamepieceToList { shape, colour, pattern, size } = +sizes : List Size +sizes = + [ Small, Large ] + + +pieceToList : Gamepiece -> List String +pieceToList { shape, colour, pattern, size } = [ shapeToString shape , colourToString colour , patternToString pattern @@ -141,95 +145,63 @@ gamepieceToList { shape, colour, pattern, size } = ] -type alias RemainingPieces = - List Gamepiece - - -type alias PlayedPieces = - Dict String Gamepiece - +fourOf : a -> a -> a -> a -> FourOf a +fourOf a b c d = + FourOf { first = a, second = b, third = c, fourth = d } --- WINNING COMBINATION +mapFourOf : (a -> b) -> FourOf a -> FourOf b +mapFourOf f (FourOf { first, second, third, fourth }) = + fourOf (f first) (f second) (f third) (f fourth) -type FourOf a - = FourOf - { first : a - , second : a - , third : a - , fourth : a - } +allNames : List Cellname +allNames = + [ A1, A2, A3, A4, B1, B2, B3, B4, C1, C2, C3, C4, D1, D2, D3, D4 ] -fourOf : a -> a -> a -> a -> FourOf a -fourOf a b c d = - FourOf { first = a, second = b, third = c, fourth = d } +-- STRINGS -isMatchingFourOf : FourOf Gamepiece -> Bool -isMatchingFourOf (FourOf { first, second, third, fourth }) = - let - firstSet = - (gamepieceToList >> Set.fromList) first - in - [ second, third, fourth ] - |> List.map (gamepieceToList >> Set.fromList) - |> List.foldl Set.intersect firstSet - |> (not << Set.isEmpty) +shapeToString : Shape -> String +shapeToString shape = + case shape of + Square -> + "Square" + Circle -> + "Circle" --- CELLNAME +colourToString : Colour -> String +colourToString colour = + case colour of + Colour1 -> + "Colour1" -type Cellname - = A1 - | B1 - | C1 - | D1 - | A2 - | B2 - | C2 - | D2 - | A3 - | B3 - | C3 - | D3 - | A4 - | B4 - | C4 - | D4 + Colour2 -> + "Colour2" -names : List Cellname -names = - [ A1, A2, A3, A4, B1, B2, B3, B4, C1, C2, C3, C4, D1, D2, D3, D4 ] +patternToString : Pattern -> String +patternToString pattern = + case pattern of + Solid -> + "Solid" + Hollow -> + "Hollow" -winningNames : List (FourOf Cellname) -winningNames = - [ FourOf { first = A1, second = A2, third = A3, fourth = A4 } - , FourOf { first = B1, second = B2, third = B3, fourth = B4 } - , FourOf { first = C1, second = C2, third = C3, fourth = C4 } - , FourOf { first = D1, second = D2, third = D3, fourth = D4 } - , FourOf { first = A1, second = B1, third = C1, fourth = D1 } - , FourOf { first = A2, second = B2, third = C2, fourth = D2 } - , FourOf { first = A3, second = B3, third = C3, fourth = D3 } - , FourOf { first = A4, second = B4, third = C4, fourth = D4 } - , FourOf { first = A1, second = B2, third = C3, fourth = D4 } - , FourOf { first = A4, second = B3, third = C2, fourth = D1 } - ] +sizeToString : Size -> String +sizeToString size = + case size of + Small -> + "Small" -fourOfNameToString : FourOf Cellname -> FourOf String -fourOfNameToString (FourOf { first, second, third, fourth }) = - FourOf - { first = nameToString first - , second = nameToString second - , third = nameToString third - , fourth = nameToString fourth - } + Large -> + "Large" nameToString : Cellname -> String @@ -284,61 +256,16 @@ nameToString name = "D4" +pieceToString : Gamepiece -> String +pieceToString gamepiece = + gamepiece + |> pieceToList + |> List.intersperse " " + |> String.concat --- GAMECELL - - -type alias GameCell = - ( Cellname, Gamepiece ) - - -dictUpdate : GameCell -> PlayedPieces -> PlayedPieces -dictUpdate ( name, piece ) dict = - Dict.insert (nameToString name) piece dict - - - --- PIECE STATUS - - -type PieceStatus - = Unplayed - | Played Cellname - - -tryPieceCellname : PieceStatus -> Maybe Cellname -tryPieceCellname status = - case status of - Unplayed -> - Nothing - - Played name -> - Just name - - - --- PIECE STATE - - -type alias PieceState = - { status : PieceStatus - , gamepiece : Gamepiece - } - - -tryPieceStateToCell : PieceState -> Maybe GameCell -tryPieceStateToCell pstate = - pstate.status - |> tryPieceCellname - |> Maybe.map (\name -> ( name, pstate.gamepiece )) - - - --- BOARDSTATE -type alias BoardState = - List PieceState +-- Played pieces and Unplayed Pieces playedPieces : BoardState -> PlayedPieces @@ -348,36 +275,33 @@ playedPieces boardstate = |> List.foldl dictUpdate Dict.empty -unPlayedPieces : BoardState -> RemainingPieces +unPlayedPieces : BoardState -> List Gamepiece unPlayedPieces boardstate = boardstate |> List.filter (.status >> (==) Unplayed) |> List.map .gamepiece -playedPiecesToCombos : PlayedPieces -> FourOf Cellname -> Maybe (FourOf Gamepiece) -playedPiecesToCombos pieces winningCells = - let - get s = - Dict.get s pieces - in - winningCells - |> fourOfNameToString - |> (\(FourOf s) -> Maybe.map4 fourOf (get s.first) (get s.second) (get s.third) (get s.fourth)) +tryPieceStateToCell : PieceState -> Maybe GameCell +tryPieceStateToCell pstate = + pstate.status + |> tryPieceCellname + |> Maybe.map (\name -> ( name, pstate.gamepiece )) -isWin : BoardState -> Bool -isWin board = - board - |> playedPieces - |> (\pieces -> List.map (playedPiecesToCombos pieces) winningNames) - |> List.filterMap identity - |> List.filter isMatchingFourOf - |> (not << List.isEmpty) +tryPieceCellname : PieceStatus -> Maybe Cellname +tryPieceCellname status = + case status of + Unplayed -> + Nothing + Played name -> + Just name -type alias ChosenPiece = - Gamepiece + +dictUpdate : GameCell -> PlayedPieces -> PlayedPieces +dictUpdate ( name, piece ) dict = + Dict.insert (nameToString name) piece dict @@ -396,16 +320,17 @@ initialBoard = updateBoard : Cellname -> Gamepiece -> BoardState -> BoardState updateBoard name gamepiece board = - if - List.any ((==) { status = Unplayed, gamepiece = gamepiece }) board - && not (List.any (\ps -> ps.status == Played name) board) - then - board - |> List.filter ((/=) { status = Unplayed, gamepiece = gamepiece }) - |> (::) { status = Played name, gamepiece = gamepiece } + let + pieceUnplayed = + { status = Unplayed, gamepiece = gamepiece } - else - board + piecePlayed = + { status = Played name, gamepiece = gamepiece } + + nameIsUnused = + List.member name (availableCells board) + in + Liste.setIf (\piece -> (piece == pieceUnplayed) && nameIsUnused) piecePlayed board tryPieceStateToName : PieceState -> Maybe Cellname @@ -424,5 +349,74 @@ availableCells board = taken = List.filterMap tryPieceStateToName board in - names - |> List.filter (\name -> List.any ((==) name) taken) + allNames + |> Liste.filterNot (\name -> List.member name taken) + + + +-- BOARD status + + +boardStatus : BoardState -> BoardStatus +boardStatus board = + if hasMatch board then + MatchFound + + else if isFull board then + Full + + else + CanContinue + + +isFull : BoardState -> Bool +isFull board = + board |> unPlayedPieces |> List.isEmpty + + +hasMatch : BoardState -> Bool +hasMatch board = + board + |> playedPieces + |> (\pieces -> List.map (playedPiecesToCombos pieces) allWinningNames) + |> List.filterMap identity + |> List.filter isMatchingFourOf + |> (not << List.isEmpty) + + +allWinningNames : List (FourOf Cellname) +allWinningNames = + [ fourOf A1 A2 A3 A4 + , fourOf B1 B2 B3 B4 + , fourOf C1 C2 C3 C4 + , fourOf D1 D2 D3 D4 + , fourOf A1 B1 C1 D1 + , fourOf A2 B2 C2 D2 + , fourOf A3 B3 C3 D3 + , fourOf A4 B4 C4 D4 + , fourOf A1 B2 C3 D4 + , fourOf A4 B3 C2 D1 + ] + + +isMatchingFourOf : FourOf Gamepiece -> Bool +isMatchingFourOf (FourOf { first, second, third, fourth }) = + let + firstSet = + (pieceToList >> Set.fromList) first + in + [ second, third, fourth ] + |> List.map (pieceToList >> Set.fromList) + |> List.foldl Set.intersect firstSet + |> (not << Set.isEmpty) + + +playedPiecesToCombos : PlayedPieces -> FourOf Cellname -> Maybe (FourOf Gamepiece) +playedPiecesToCombos pieces winningNames = + let + get s = + Dict.get s pieces + in + winningNames + |> mapFourOf nameToString + |> (\(FourOf s) -> Maybe.map4 fourOf (get s.first) (get s.second) (get s.third) (get s.fourth)) diff --git a/src/Pages/Top.elm b/src/Pages/Top.elm index a636490..e51e9fa 100644 --- a/src/Pages/Top.elm +++ b/src/Pages/Top.elm @@ -54,7 +54,7 @@ page = } -type alias SelectedPiece = +type alias ChosenPiece = Gamepiece @@ -81,9 +81,9 @@ toCell name pieces = type Turn = HumanChoosing - | ComputerPlaying SelectedPiece + | ComputerPlaying ChosenPiece | ComputerChoosing - | HumanPlaying SelectedPiece + | HumanPlaying ChosenPiece type alias Winner = @@ -102,14 +102,6 @@ type alias Model = } -gamepieceToString : Gamepiece -> String -gamepieceToString gamepiece = - gamepiece - |> Board.gamepieceToList - |> List.intersperse " " - |> String.concat - - -- Cell Name Helpers -- Turn helpers @@ -237,7 +229,7 @@ updateGamepiecePlaced gamepiece model name = checkForWin : Turn -> Model -> ( Model, Effect ) checkForWin turn model = - case ( turn, Board.isWin model.board ) of + case ( turn, Board.hasMatch model.board ) of ( _, True ) -> { model | status = Won (turnToActivePlayer turn) } |> withNoEffects @@ -418,7 +410,7 @@ viewRemainingPiecesButton gamepiece = viewGamepiece gamepiece ariaDescription = - gamepieceToString gamepiece + Board.pieceToString gamepiece in Input.button [ Region.description ariaDescription ] { onPress = Just (ClickedPiece gamepiece) @@ -444,7 +436,7 @@ cellStateToDescription { name, state } = "Cell " ++ Board.nameToString name ++ ": Empty cell" Occupied gamepiece -> - "Cell " ++ Board.nameToString name ++ ": " ++ gamepieceToString gamepiece + "Cell " ++ Board.nameToString name ++ ": " ++ Board.pieceToString gamepiece