diff --git a/haskellscrabble.cabal b/haskellscrabble.cabal --- a/haskellscrabble.cabal +++ b/haskellscrabble.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: haskellscrabble -version: 1.4.3 +version: 2.0.0 synopsis: A scrabble library capturing the core game logic of scrabble. description: A scrabble library which enforces legal transitions between moves. Intended to facilitate the development of a playable game. homepage: http://www.github.com/happy0/haskellscrabble diff --git a/src/Wordify/Rules/Move.hs b/src/Wordify/Rules/Move.hs --- a/src/Wordify/Rules/Move.hs +++ b/src/Wordify/Rules/Move.hs @@ -30,13 +30,13 @@ -- | The new game state, and the player with their rack before and after the exchange respectively. | ExchangeTransition Game Player Player -- | The new game state with the opportunity to play passed on to the next player. - | PassTransition Game - {- | + | PassTransition Game + {- | The game has finished. The final game state, and the final words formed (if the game was ended by a player placing their final tiles.) The players before their scores were increased or decreased is also given. -} - | GameFinished Game (Maybe FormedWords) [Player] + | GameFinished Game (Maybe FormedWords) {-| Transitiions the game to the next state. If the move places tiles, the player must have the tiles to place and @@ -58,7 +58,7 @@ do formed <- formedWords (overallScore, _) <- scoresIfWordsLegal dict formed - nextBoard <- newBoard currentBoard placed + nextBoard <- newBoard currentBoard placed intermediatePlayer <- removeLettersandGiveScore player playedTiles overallScore if hasEmptyRack intermediatePlayer && (bagSize letterBag == 0) @@ -66,7 +66,7 @@ do let beforeFinalisingGame = updateGame game intermediatePlayer nextBoard letterBag let finalisedGame = finaliseGame beforeFinalisingGame - return $ GameFinished finalisedGame (Just formed) (players beforeFinalisingGame) + return $ GameFinished finalisedGame (Just formed) else do let (newPlayer, newBag) = updatePlayerRackAndBag intermediatePlayer letterBag (Map.size placed) @@ -81,18 +81,18 @@ formedWords = if any isPlaceMove (movesMade game) then wordsFormedMidGame currentBoard placed - else wordFormedFirstMove currentBoard placed + else wordFormedFirstMove currentBoard placed - isPlaceMove mv = case mv of + isPlaceMove mv = case mv of PlaceTiles _ -> True _ -> False - + exchangeMove :: Game -> [Tile] -> Either ScrabbleError GameTransition exchangeMove game exchangedTiles = let exchangeOutcome = exchangeLetters (bag game) exchangedTiles in case exchangeOutcome of Nothing -> Left CannotExchangeWhenNoLettersInBag - Just (givenTiles, newBag) -> + Just (givenTiles, newBag) -> let newPlayer = exchange player exchangedTiles givenTiles in maybe (Left $ PlayerCannotExchange (rack player) exchangedTiles) (\exchangedPlayer -> let gameState = updateGame game exchangedPlayer (board game) newBag @@ -101,11 +101,11 @@ player = currentPlayer game passMove :: Game -> GameTransition - passMove game = - let gameState = pass game + passMove game = + let gameState = pass game in if gameFinished - then GameFinished (finaliseGame gameState) Nothing (players gameState) + then GameFinished (finaliseGame gameState) Nothing else PassTransition gameState where numPasses = passes game + 1 @@ -115,21 +115,21 @@ Restores a game from a list of moves. The game must be set up in the way the original game was set up (including the letter bag constructed with the same tiles and random generator, dictionary and the list of players in the original order.) - + If the game is not set up as it was originally, this function will return a scrabble error with the move which was invalid with the given state. For example, if the original players are not ordered in the correct way then the player will not have the required tiles to make the move. -} restoreGame :: Game -> NE.NonEmpty Move -> Either ScrabbleError (NE.NonEmpty GameTransition) restoreGame game = T.sequence . restoreGameLazy game - + {- | Maps each move to a resulting game transition, if the move is legal. Has the same semantics as 'restoreGame' but returns a list of 'Either' so that laziness can be maintained, meaning all the game transitions - dont have to be buffered before they can be consumed. + dont have to be buffered before they can be consumed. -} restoreGameLazy :: Game -> NE.NonEmpty Move -> NE.NonEmpty (Either ScrabbleError GameTransition) - restoreGameLazy game (mv NE.:| moves) = NE.scanl nextMove (makeMove game mv) moves + restoreGameLazy game (mv NE.:| moves) = NE.scanl nextMove (makeMove game mv) moves where nextMove transition move = transition >>= \success -> makeMove (newGame success) move @@ -137,13 +137,13 @@ newGame (MoveTransition _ game _) = game newGame (ExchangeTransition game _ _) = game newGame (PassTransition game) = game - newGame (GameFinished game _ _) = game + newGame (GameFinished game _) = game addMoveToHistory :: GameTransition -> Move -> GameTransition addMoveToHistory (MoveTransition player game formedWords) move = MoveTransition player (updateHistory game move) formedWords addMoveToHistory (ExchangeTransition game oldPlayer newPlayer ) move = ExchangeTransition (updateHistory game move) oldPlayer newPlayer addMoveToHistory (PassTransition game) move = PassTransition (updateHistory game move) - addMoveToHistory (GameFinished game wordsFormed allPlayers) move = GameFinished (updateHistory game move) wordsFormed allPlayers + addMoveToHistory (GameFinished game wordsFormed) move = GameFinished (updateHistory game move) wordsFormed finaliseGame :: Game -> Game finaliseGame game @@ -159,8 +159,8 @@ optionals = optionalPlayers game >>= (\(player3, maybePlayer4) -> Just (finalisePlayer player3, finalisePlayer <$> maybePlayer4 ) ) - finalisePlayer player = if hasEmptyRack player then increaseScore player unplayedValues - else reduceScore player (tileValues player) + finalisePlayer player = if hasEmptyRack player then giveEndWinBonus player unplayedValues + else giveEndLosePenalty player (tileValues player) updatePlayerRackAndBag :: Player -> LetterBag -> Int -> (Player, LetterBag) updatePlayerRackAndBag player letterBag numPlayed @@ -176,14 +176,14 @@ where newBoardIfUnoccupied brd pos tile = note (PlacedTileOnOccupiedSquare pos tile) $ placeTile brd tile pos - + removeLettersandGiveScore :: Player -> [Tile] -> Int -> Either ScrabbleError Player - removeLettersandGiveScore player playedTiles justScored = - let newPlayer = flip increaseScore justScored <$> removePlayedTiles player playedTiles + removeLettersandGiveScore player playedTiles justScored = + let newPlayer = flip increaseScore justScored <$> removePlayedTiles player playedTiles in note (PlayerCannotPlace (rack player) playedTiles) newPlayer scoresIfWordsLegal :: Dictionary -> FormedWords -> Either ScrabbleError (Int, [(String, Int)]) - scoresIfWordsLegal dict formedWords = + scoresIfWordsLegal dict formedWords = let strings = wordStrings formedWords in case invalidWords dict strings of []-> Right $ wordsWithScores formedWords diff --git a/src/Wordify/Rules/Player.hs b/src/Wordify/Rules/Player.hs --- a/src/Wordify/Rules/Player.hs +++ b/src/Wordify/Rules/Player.hs @@ -7,12 +7,14 @@ tilesOnRack, score, increaseScore, + reduceScore, + giveEndLosePenalty, + giveEndWinBonus, giveTiles, removePlayedTiles, removeTiles, hasEmptyRack, tileValues, - reduceScore, exchange) where import Wordify.Rules.Tile @@ -27,13 +29,14 @@ data Player = Player {name :: Name , rack :: LetterRack - , score :: Score } deriving (Show, Eq) + , score :: Score + , endBonus :: Int} deriving (Show, Eq) makePlayer :: String -> Player - makePlayer playerName = Player playerName (LetterRack []) 0 + makePlayer playerName = Player playerName (LetterRack []) 0 0 tilesOnRack :: Player -> [Tile] - tilesOnRack (Player _ (LetterRack letters) _) = letters + tilesOnRack (Player _ (LetterRack letters) _ _) = letters increaseScore :: Player -> Int -> Player increaseScore player justScored = player {score = currentScore + justScored} @@ -45,6 +48,12 @@ where currentScore = score player + giveEndLosePenalty :: Player -> Int -> Player + giveEndLosePenalty player penalty = (reduceScore player penalty) {endBonus = -penalty} + + giveEndWinBonus :: Player -> Int -> Player + giveEndWinBonus player bonus = (increaseScore player bonus) {endBonus = bonus} + hasEmptyRack :: Player -> Bool hasEmptyRack player = null $ tilesOnRack player @@ -63,7 +72,7 @@ {- | Removes played tiles from the player's tile rack, if it was possible for the player to play those tiles in the first place. A player may play a tile on his rack, unless - it is a blank, which must first be assigned a letter. + it is a blank, which must first be assigned a letter. -} removePlayedTiles :: Player -> [Tile] -> Maybe Player removePlayedTiles player tiles = @@ -86,20 +95,20 @@ isInvalid (tile, freq) = case tile of -- Tried to play a blank without a letter - Blank Nothing -> False + Blank Nothing -> False -- Player doesn't have tiles Blank _ -> freq > Map.findWithDefault 0 (Blank Nothing) rackFrequencies Letter chr val -> freq > Map.findWithDefault 0 (Letter chr val) rackFrequencies exchange :: Player -> [Tile] -> [Tile] -> Maybe Player - exchange player exchanged received = + exchange player exchanged received = if not (playerCanExchange player exchanged) then Nothing - else + else Just $ giveTiles (removeTiles player exchanged) received playerCanExchange :: Player -> [Tile] -> Bool - playerCanExchange (Player _ ( LetterRack letterRack) _ ) exchanged = isNothing $ find cannotExchange exchangedList - + playerCanExchange (Player _ ( LetterRack letterRack) _ _) exchanged = + isNothing $ find cannotExchange exchangedList where (exchangedFrequencies, rackFrequencies) = tileFrequencies exchanged letterRack exchangedList = Map.toList exchangedFrequencies @@ -107,7 +116,7 @@ cannotExchange (tile, freq) = case tile of -- Tried to exchange a blank letter which has been labeled. Client error. - Blank (Just _) -> False + Blank (Just _) -> False -- Player doesn't have tiles Blank _ -> freq > Map.findWithDefault 0 (Blank Nothing) rackFrequencies Letter chr val -> freq > Map.findWithDefault 0 (Letter chr val) rackFrequencies