You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
144 lines
6.0 KiB
144 lines
6.0 KiB
module Datatypes.Game (Game(..), Command(..), isCompleted, new, notifyCommand, powerCounterToScore, powerPhrasesAsCommands, commandsToString,stringToCommands) where -- FIXME exports
|
|
|
|
import Data.Hashable (hash)
|
|
import qualified Data.List as List
|
|
import Data.Map.Strict (Map)
|
|
import qualified Data.Map.Strict as Map
|
|
import Data.Set (Set)
|
|
import qualified Data.Set as Set
|
|
|
|
import Datatypes.Board (Board)
|
|
import Datatypes.Unit (Unit)
|
|
import qualified Datatypes.Unit as Unit
|
|
|
|
data Command = MoveW
|
|
| MoveSE
|
|
| MoveE
|
|
| MoveSW
|
|
| RotateClockwise
|
|
| RotateCounterclockwise
|
|
deriving (Show,Eq,Ord)
|
|
|
|
type UnitHash = Int
|
|
|
|
type PowerCounter = Map String Int
|
|
|
|
data Game = Game {
|
|
board :: Board,
|
|
units :: [Unit],
|
|
visitedUnits :: Set UnitHash,
|
|
oldLines :: Int,
|
|
score :: Int,
|
|
history :: [Command],
|
|
powerCounter :: PowerCounter
|
|
}
|
|
deriving Show
|
|
|
|
isCompleted :: Game -> Bool
|
|
isCompleted game = null $ units game
|
|
|
|
new :: Board -> [Unit] -> Game
|
|
new b us = Game {
|
|
board = b,
|
|
units = (c:cs),
|
|
visitedUnits = Set.singleton (hash c),
|
|
oldLines = 0,
|
|
score = 0,
|
|
history = [],
|
|
powerCounter = Map.empty
|
|
} where (c:cs) = map (flip Unit.centeredIn b) us
|
|
|
|
powerPhrases :: Map String [Command]
|
|
powerPhrases = Map.fromList $ map (\x -> (x, stringToCommands x)) keys where
|
|
keys = ["ei!", "ia! ia!", "ph'nglui mglw'nafh cthulhu r'lyeh wgah'nagl fhtagn.", " r'lyeh", "yogsothoth", "necronomicon", "yuggoth", "john bigboote"]
|
|
|
|
powerPhrasesAsCommands :: [[Command]]
|
|
powerPhrasesAsCommands = map snd $ Map.toList powerPhrases
|
|
|
|
reversedPowerPhrases :: [([Command], String)]
|
|
reversedPowerPhrases = swapTuples . Map.toList $ powerPhrases where
|
|
swapTuples = map (\(s, cs) -> (reverse cs, s))
|
|
|
|
notifyCommand :: Game -> Command -> Game
|
|
notifyCommand game command =
|
|
game { history = newHistory, powerCounter = newPowerCounter } where
|
|
newHistory = command:(history game)
|
|
newPowerCounter = updatePowerCounter (powerCounter game) newHistory
|
|
|
|
updatePowerCounter :: PowerCounter -> [Command] -> PowerCounter
|
|
updatePowerCounter counter history =
|
|
innerUpdate counter reversedPowerPhrases where
|
|
innerUpdate :: PowerCounter -> [([Command], String)] -> PowerCounter
|
|
innerUpdate c [] = c
|
|
innerUpdate c (p:ps) = innerUpdate (checkPrefix c p) ps
|
|
checkPrefix m (p, s) = if p `List.isPrefixOf` history
|
|
then incrementMember m s
|
|
else m
|
|
incrementMember m s = Map.insertWith (\_ old -> old + 1) s 1 m
|
|
|
|
powerCounterToScore :: PowerCounter -> Int
|
|
powerCounterToScore items = sum $ map evalScore (Map.toAscList items) where
|
|
evalScore (phrase, count) = 2 * (length phrase) * count + (if count > 0 then 300 else 0)
|
|
|
|
stringToCommands :: String -> [Command]
|
|
stringToCommands str = reverse (convert str []) where
|
|
convert [] acc = acc
|
|
convert ('p':cs) acc = convert cs (MoveW:acc)
|
|
convert ('\'':cs) acc = convert cs (MoveW:acc)
|
|
convert ('!':cs) acc = convert cs (MoveW:acc)
|
|
convert ('.':cs) acc = convert cs (MoveW:acc)
|
|
convert ('0':cs) acc = convert cs (MoveW:acc)
|
|
convert ('3':cs) acc = convert cs (MoveW:acc)
|
|
convert ('b':cs) acc = convert cs (MoveE:acc)
|
|
convert ('c':cs) acc = convert cs (MoveE:acc)
|
|
convert ('e':cs) acc = convert cs (MoveE:acc)
|
|
convert ('f':cs) acc = convert cs (MoveE:acc)
|
|
convert ('y':cs) acc = convert cs (MoveE:acc)
|
|
convert ('2':cs) acc = convert cs (MoveE:acc)
|
|
convert ('a':cs) acc = convert cs (MoveSW:acc)
|
|
convert ('g':cs) acc = convert cs (MoveSW:acc)
|
|
convert ('h':cs) acc = convert cs (MoveSW:acc)
|
|
convert ('i':cs) acc = convert cs (MoveSW:acc)
|
|
convert ('j':cs) acc = convert cs (MoveSW:acc)
|
|
convert ('4':cs) acc = convert cs (MoveSW:acc)
|
|
convert ('l':cs) acc = convert cs (MoveSE:acc)
|
|
convert ('m':cs) acc = convert cs (MoveSE:acc)
|
|
convert ('n':cs) acc = convert cs (MoveSE:acc)
|
|
convert ('o':cs) acc = convert cs (MoveSE:acc)
|
|
convert (' ':cs) acc = convert cs (MoveSE:acc)
|
|
convert ('5':cs) acc = convert cs (MoveSE:acc)
|
|
convert ('d':cs) acc = convert cs (RotateClockwise:acc)
|
|
convert ('q':cs) acc = convert cs (RotateClockwise:acc)
|
|
convert ('r':cs) acc = convert cs (RotateClockwise:acc)
|
|
convert ('v':cs) acc = convert cs (RotateClockwise:acc)
|
|
convert ('z':cs) acc = convert cs (RotateClockwise:acc)
|
|
convert ('1':cs) acc = convert cs (RotateClockwise:acc)
|
|
convert ('k':cs) acc = convert cs (RotateCounterclockwise:acc)
|
|
convert ('s':cs) acc = convert cs (RotateCounterclockwise:acc)
|
|
convert ('t':cs) acc = convert cs (RotateCounterclockwise:acc)
|
|
convert ('u':cs) acc = convert cs (RotateCounterclockwise:acc)
|
|
convert ('w':cs) acc = convert cs (RotateCounterclockwise:acc)
|
|
convert ('x':cs) acc = convert cs (RotateCounterclockwise:acc)
|
|
convert ('\t':cs) acc = convert cs acc
|
|
convert ('\n':cs) acc = convert cs acc
|
|
convert ('\r':cs) acc = convert cs acc
|
|
|
|
commandsToString :: [Command] -> String
|
|
commandsToString [] = ""
|
|
commandsToString cmds@(c:cs) =
|
|
case smartConvert cmds (map (\(a, b) -> (b, a)) $ Map.toList powerPhrases) of
|
|
Just word -> word ++ (commandsToString (drop (length word) cmds))
|
|
Nothing -> dumbConvert c : commandsToString cs
|
|
where
|
|
dumbConvert MoveW = 'p'
|
|
dumbConvert MoveE = 'b'
|
|
dumbConvert MoveSW = 'a'
|
|
dumbConvert MoveSE = 'l'
|
|
dumbConvert RotateClockwise = 'd'
|
|
dumbConvert RotateCounterclockwise = 'k'
|
|
smartConvert _ [] = Nothing
|
|
smartConvert cmds (p:ps) =
|
|
let (encoded, word) = p
|
|
in if encoded `List.isPrefixOf` cmds
|
|
then Just word
|
|
else smartConvert cmds ps
|