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.0 +version: 1.1 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/Board.hs b/src/Wordify/Rules/Board.hs --- a/src/Wordify/Rules/Board.hs +++ b/src/Wordify/Rules/Board.hs @@ -1,5 +1,14 @@ -module Wordify.Rules.Board(Board, allSquares, emptyBoard, placeTile, occupiedSquareAt, - lettersAbove, lettersBelow, lettersLeft, lettersRight, unoccupiedSquareAt, prettyPrint) where +module Wordify.Rules.Board(Board, + emptyBoard, + allSquares, + placeTile, + occupiedSquareAt, + lettersAbove, + lettersBelow, + lettersLeft, + lettersRight, + unoccupiedSquareAt, + prettyPrint) where import Wordify.Rules.Square import Wordify.Rules.Pos @@ -61,7 +70,7 @@ lettersRight :: Board -> Pos -> Seq (Pos,Square) lettersRight board pos = walkFrom board pos right - {- | Pretty prints a board to a human readable string representation -} + {- | Pretty prints a board to a human readable string representation. Helpful for development. -} prettyPrint :: Board -> String prettyPrint board = rowsWithLabels ++ columnLabelSeparator ++ columnLabels where diff --git a/src/Wordify/Rules/Dictionary.hs b/src/Wordify/Rules/Dictionary.hs --- a/src/Wordify/Rules/Dictionary.hs +++ b/src/Wordify/Rules/Dictionary.hs @@ -1,4 +1,9 @@ -module Wordify.Rules.Dictionary (Dictionary, isValidWord, makeDictionary, invalidWords, dictionaryFromWords) where +module Wordify.Rules.Dictionary (Dictionary, + makeDictionary, + dictionaryFromWords, + isValidWord, + invalidWords + ) where import qualified Data.HashSet as HashSet import Wordify.Rules.ScrabbleError diff --git a/src/Wordify/Rules/FormedWord.hs b/src/Wordify/Rules/FormedWord.hs --- a/src/Wordify/Rules/FormedWord.hs +++ b/src/Wordify/Rules/FormedWord.hs @@ -1,16 +1,20 @@ -module Wordify.Rules.FormedWord - ( - FormedWords, - FormedWord, - wordsFormedMidGame, - wordFormedFirstMove, - wordStrings, - wordsWithScores, - mainWord, - adjacentWords, - playerPlaced, - bingoBonusApplied - ) where +module Wordify.Rules.FormedWord (FormedWords, + FormedWord, + PlacedSquares, + allWords, + mainWord, + adjacentWords, + playerPlaced, + playerPlacedMap, + scoreWord, + overallScore, + bingoBonusApplied, + prettyPrintIntersections, + makeString, + wordStrings, + wordsWithScores, + wordsFormedMidGame, + wordFormedFirstMove) where import Wordify.Rules.Pos import Wordify.Rules.Square @@ -23,17 +27,83 @@ import Control.Monad import Data.Foldable as Foldable import qualified Data.Maybe as M + import qualified Data.List.Split as S + import Data.Char data FormedWords = FirstWord FormedWord | FormedWords { main :: FormedWord , otherWords :: [FormedWord] - , placed :: Map Pos Square + , placed :: PlacedSquares } deriving (Show, Eq) type FormedWord = Seq (Pos, Square) + type PlacedSquares = Map Pos Square data Direction = Horizontal | Vertical deriving Eq {- | + Pretty prints the places a given formed word intersects with letters that were already on the board + using brackets. E.g. T(HI)S would denote that the player placed a 'T' and an 'S' on to the board, using + the already placed word 'HI' to form the new word 'THIS'. + -} + prettyPrintIntersections :: PlacedSquares -> FormedWord -> String + prettyPrintIntersections placed formedWord = denotePassThroughs placed $ Foldable.toList formedWord + where + denotePassThroughs :: PlacedSquares -> [(Pos, Square)] -> String + denotePassThroughs placed formed = + let breaks = brokenSquaresToChars $ S.split (splitter placed) formed + in case breaks of + (part:parts) -> part ++ (concat $ Prelude.zipWith (++) (cycle ["(",")"]) parts) + [] -> "" + + squareToChar :: Square -> Char + squareToChar sq = maybe '_' id $ tileIfOccupied sq >>= printLetter + + -- Splits whenever we encounter a series of squares that the player's word passes through + -- on the board + splitter :: PlacedSquares -> S.Splitter (Pos, Square) + splitter placed = S.condense $ S.whenElt (flip (Map.notMember . fst) placed) + + brokenSquaresToChars :: [[(Pos, Square)]] -> [[Char]] + brokenSquaresToChars brokenSquares = (Prelude.map . Prelude.map) (squareToChar . snd) brokenSquares + + {- | + Scores an individual word. + + Note: overallscore should be used to obtain the overall score as it takes into account any bingo bonuses. + + -} + scoreWord :: PlacedSquares -> FormedWord -> Int + scoreWord played formed = + let (notAlreadyPlaced, onBoardAlready) = partitionPlaced played formed + in scoreSquares onBoardAlready notAlreadyPlaced + where + partitionPlaced placed formed = (mapTuple . fmap) snd $ Seq.partition (\(pos, _) -> Map.member pos placed) formed + + mapTuple :: (a -> b) -> (a, a) -> (b, b) + mapTuple f (a1, a2) = (f a1, f a2) + + {- | + Calculates the overall score of the play. + + If a player managed to place all 7 of their letters, then they receive a bingo bonus of 50 points. + -} + overallScore :: FormedWords -> Int + overallScore formedWords = + let wordsScore = Prelude.sum $ Prelude.map (scoreWord placed) $ allWords formedWords + in case (Prelude.length $ placed) of + 7 -> wordsScore + 50 + _ -> wordsScore + where + placed = playerPlacedMap formedWords + + {-| + All the words formed by a play. + -} + allWords :: FormedWords -> [FormedWord] + allWords (FormedWords main adjacentWords _) = main : adjacentWords + allWords (FirstWord firstWord) = [firstWord] + + {- | Returns the word formed by the first move on the board. The word must cover the star tile, and be linear. Any blank tiles must be labeled. -} @@ -78,30 +148,19 @@ playerPlaced (FirstWord word) = Foldable.toList word playerPlaced formed = Map.toList $ placed formed + playerPlacedMap :: FormedWords -> Map Pos Square + playerPlacedMap (FirstWord word) = Map.fromList $ Foldable.toList word + playerPlacedMap formed = placed formed + {- | Scores the words formed by the tiles placed. The first item in the tuple is the overall score, while the second item is the list of scores for all the words formed. -} wordsWithScores :: FormedWords -> (Int, [(String, Int)]) - wordsWithScores (FirstWord firstWord) = - let score = scoreWord Seq.empty (fmap snd firstWord) - in (bingoBonus score (Seq.length firstWord), [(makeString firstWord, score)]) - wordsWithScores (FormedWords mainW others played) = - (bingoBonus (Prelude.sum scores) (Map.size played), Prelude.zip strings scores) + wordsWithScores formedWords = (overallScore formedWords, fmap wordAndScore allFormedWords) where - allWords = mainW : others - strings = Prelude.map makeString allWords - scores = Prelude.map (\formedWord -> let (notAlreadyPlaced, alreadyPlaced) = partitionPlaced formedWord - in scoreWord (fmap snd alreadyPlaced) (fmap snd notAlreadyPlaced) ) allWords - partitionPlaced = Seq.partition (\(pos, _) -> Map.member pos played) - - - {- - It is a rule in scrabble that if the player manages to place all 7 letters, they receive a bonus of '50' - to their score. - -} - bingoBonus :: Int -> Int -> Int - bingoBonus score playedLetters = if playedLetters < 7 then score else score + 50 + allFormedWords = allWords formedWords + wordAndScore formedWord = (makeString formedWord, scoreWord (playerPlacedMap formedWords) formedWord) {- | Returns true if the player placed all 7 of their letters while forming these words, incurring a + 50 score bonus. diff --git a/src/Wordify/Rules/Game.hs b/src/Wordify/Rules/Game.hs --- a/src/Wordify/Rules/Game.hs +++ b/src/Wordify/Rules/Game.hs @@ -1,6 +1,22 @@ -module Wordify.Rules.Game(Game, player1, player2, optionalPlayers, currentPlayer, - board, bag, dictionary, playerNumber, moveNumber, makeGame, getGameStatus, - GameStatus(InProgress, Finished), gameStatus, players, passes, numberOfPlayers, history, History(History),movesMade) where +module Wordify.Rules.Game(Game, + makeGame, + movesMade, + gameStatus, + board, + bag, + dictionary, + moveNumber, + player1, + player2, + optionalPlayers, + currentPlayer, + playerNumber, + GameStatus(InProgress, Finished), + players, + passes, + numberOfPlayers, + history, + History(History)) where import Wordify.Rules.Player import Wordify.Rules.Board @@ -81,9 +97,6 @@ players :: Game -> [Player] players game = [player1 game, player2 game] ++ optionalsToPlayers (optionalPlayers game) - - getGameStatus :: Game -> GameStatus - getGameStatus = gameStatus numberOfPlayers :: Game -> Int numberOfPlayers game = 2 + maybe 0 (\(_, maybePlayer4) -> if isJust maybePlayer4 then 2 else 1) (optionalPlayers game) diff --git a/src/Wordify/Rules/LetterBag.hs b/src/Wordify/Rules/LetterBag.hs --- a/src/Wordify/Rules/LetterBag.hs +++ b/src/Wordify/Rules/LetterBag.hs @@ -1,14 +1,14 @@ -module Wordify.Rules.LetterBag ( - LetterBag, - makeBag, - takeLetters, - exchangeLetters, - shuffleBag, bagSize, - tiles, - bagFromTiles, - makeBagUsingGenerator, - getGenerator, - shuffleWithNewGenerator) where +module Wordify.Rules.LetterBag (LetterBag, + makeBag, + tiles, + bagFromTiles, + makeBagUsingGenerator, + takeLetters, + exchangeLetters, + shuffleBag, + shuffleWithNewGenerator, + bagSize, + getGenerator) where import Wordify.Rules.Tile import System.Random 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 @@ -1,9 +1,10 @@ -module Wordify.Rules.Move (makeMove - ,Move(PlaceTiles, Exchange, Pass) - ,GameTransition(MoveTransition, ExchangeTransition, PassTransition, GameFinished) - ,restoreGame - ,restoreGameLazy - ,newGame) where +module Wordify.Rules.Move ( + Move(PlaceTiles, Exchange, Pass) + ,GameTransition(MoveTransition, ExchangeTransition, PassTransition, GameFinished) + ,makeMove + ,newGame + ,restoreGame + ,restoreGameLazy) where import Wordify.Rules.ScrabbleError import Wordify.Rules.FormedWord 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 @@ -1,5 +1,19 @@ -module Wordify.Rules.Player (Player, LetterRack, name, rack, score, makePlayer, increaseScore, giveTiles, tilesOnRack, - removePlayedTiles, removeTiles, hasEmptyRack, tileValues, reduceScore, exchange) where +module Wordify.Rules.Player ( + Player, + LetterRack, + makePlayer, + name, + rack, + tilesOnRack, + score, + increaseScore, + giveTiles, + removePlayedTiles, + removeTiles, + hasEmptyRack, + tileValues, + reduceScore, + exchange) where import Wordify.Rules.Tile import Data.List diff --git a/src/Wordify/Rules/Pos.hs b/src/Wordify/Rules/Pos.hs --- a/src/Wordify/Rules/Pos.hs +++ b/src/Wordify/Rules/Pos.hs @@ -1,5 +1,16 @@ -module Wordify.Rules.Pos (Pos, posAt, above, below, left, right, xPos, yPos, gridValue, starPos, posMin, posMax) where +module Wordify.Rules.Pos (Pos, + posAt, + above, + below, + left, + right, + xPos, + yPos, + gridValue, + starPos, + posMin, + posMax) where import qualified Data.Map as Map import Wordify.Rules.Pos.Internal diff --git a/src/Wordify/Rules/Square.hs b/src/Wordify/Rules/Square.hs --- a/src/Wordify/Rules/Square.hs +++ b/src/Wordify/Rules/Square.hs @@ -1,5 +1,5 @@ module Wordify.Rules.Square (Square(Normal, DoubleLetter, TripleLetter, DoubleWord, TripleWord), - isOccupied, scoreWord, squareIfOccupied, putTileOn, tileIfOccupied) where + isOccupied, scoreSquares, squareIfOccupied, putTileOn, tileIfOccupied) where import Wordify.Rules.Tile import Data.Sequence as Seq @@ -27,10 +27,10 @@ The second list contains squares that are newly occupied. -} - scoreWord :: Seq Square -> Seq Square -> Int + scoreSquares :: Seq Square -> Seq Square -> Int -- Calculate the base score then add the letter bonuses (doubleLetter, doubleWord), -- then multiply by word bonuses (DoubleWord, TripleWord) - scoreWord xs ys = addBonuses (addBonuses baseScore letterBonuses) wordBonuses + scoreSquares xs ys = addBonuses (addBonuses baseScore letterBonuses) wordBonuses where calcBaseScore = F.foldr (\square acc -> baseValue square + acc) 0 addBonuses = F.foldr applyWordBonus diff --git a/src/Wordify/Rules/Tile.hs b/src/Wordify/Rules/Tile.hs --- a/src/Wordify/Rules/Tile.hs +++ b/src/Wordify/Rules/Tile.hs @@ -1,5 +1,7 @@ -module Wordify.Rules.Tile (Tile(Letter, Blank), tileValue, isPlayable, tileLetter) where +module Wordify.Rules.Tile (Tile(Letter, Blank), tileValue, isPlayable, tileLetter, printLetter) where +import Data.Char + {- | A tile is a letter with a value, or a Blank tile which may have been given a letter. Blank tiles @@ -15,6 +17,14 @@ tileLetter (Letter char _) = Just char tileLetter (Blank (Just char)) = Just char tileLetter (Blank Nothing) = Nothing + +{- | + Prints a letter in the style found on a scoresheet. E.g. blank letters are printed in lowercase. +-} +printLetter :: Tile -> Maybe Char +printLetter (Letter char _) = Just char +printLetter (Blank (Just char)) = Just $ toLower char +printLetter _ = Nothing {- | isPlayble, applied to a played tile and compared against a tile