{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} -- | High score table operations. module Game.LambdaHack.Common.HighScore ( ScoreTable, ScoreDict , empty, register, showScore, showAward , getTable, unTable, getRecord, getStatus, getDate #ifdef EXPOSE_INTERNAL -- * Internal operations , ScoreRecord, insertPos #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import qualified Data.EnumMap.Strict as EM import qualified Data.Text as T import Data.Time.Clock.POSIX import Data.Time.LocalTime import GHC.Generics (Generic) import qualified NLP.Miniutter.English as MU import Game.LambdaHack.Common.Faction import Game.LambdaHack.Common.Misc import Game.LambdaHack.Common.Time import Game.LambdaHack.Content.ItemKind (ItemKind) import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Definition.Defs -- | A single score record. Records are ordered in the highscore table, -- from the best to the worst, in lexicographic ordering wrt the fields below. data ScoreRecord = ScoreRecord { points :: Int -- ^ the score , negTime :: Time -- ^ game time spent (negated, so less better) , date :: POSIXTime -- ^ date of the last game interruption , status :: Status -- ^ reason of the game interruption , challenge :: Challenge -- ^ challenge setup of the game , gplayerName :: Text -- ^ name of the faction's gplayer , ourVictims :: EM.EnumMap (ContentId ItemKind) Int -- ^ allies lost , theirVictims :: EM.EnumMap (ContentId ItemKind) Int -- ^ foes killed } deriving (Eq, Ord, Generic) instance Binary ScoreRecord -- | The list of scores, in decreasing order. newtype ScoreTable = ScoreTable {unTable :: [ScoreRecord]} deriving (Eq, Binary) instance Show ScoreTable where show _ = "a score table" -- | A dictionary from game mode IDs to scores tables. type ScoreDict = EM.EnumMap (ContentId ModeKind) ScoreTable -- | Empty score table empty :: ScoreDict empty = EM.empty -- | Insert a new score into the table, Return new table and the ranking. -- Make sure the table doesn't grow too large. insertPos :: ScoreRecord -> ScoreTable -> (ScoreTable, Int) insertPos s (ScoreTable table) = let (prefix, suffix) = span (> s) table pos = length prefix + 1 in (ScoreTable $ prefix ++ [s] ++ take (100 - pos) suffix, pos) -- | Register a new score in a score table. register :: ScoreTable -- ^ old table -> Int -- ^ the total value of faction items -> Int -- ^ the total value of dungeon items -> Time -- ^ game time spent -> Status -- ^ reason of the game interruption -> POSIXTime -- ^ current date -> Challenge -- ^ challenge setup -> Text -- ^ name of the faction's gplayer -> EM.EnumMap (ContentId ItemKind) Int -- ^ allies lost -> EM.EnumMap (ContentId ItemKind) Int -- ^ foes killed -> HiCondPoly -> (Bool, (ScoreTable, Int)) register table total dungeonTotal time status@Status{stOutcome} date challenge gplayerName ourVictims theirVictims hiCondPoly = let turnsSpent = intToDouble $ timeFitUp time timeTurn hiInValue (hi, c) = assert (total <= dungeonTotal) $ case hi of HiConst -> c HiLoot | dungeonTotal == 0 -> c -- a fluke; no gold generated HiLoot -> c * intToDouble total / intToDouble dungeonTotal HiSprint -> -- Up to -c turns matter. max 0 (-c - turnsSpent) HiBlitz -> -- Up to 1000000/-c turns matter. sqrt $ max 0 (1000000 + c * turnsSpent) HiSurvival -> -- Up to 1000000/c turns matter. sqrt $ max 0 (min 1000000 $ c * turnsSpent) HiKill -> c * intToDouble (sum (EM.elems theirVictims)) HiLoss -> c * intToDouble (sum (EM.elems ourVictims)) hiPolynomialValue = sum . map hiInValue hiSummandValue (hiPoly, outcomes) = if stOutcome `elem` outcomes then max 0 (hiPolynomialValue hiPoly) else 0 hiCondValue = sum . map hiSummandValue -- Other challenges than HP difficulty are not reflected in score. points = ceiling $ hiCondValue hiCondPoly * 1.5 ^^ (- (difficultyCoeff (cdiff challenge))) negTime = absoluteTimeNegate time score = ScoreRecord{..} in (points > 0, insertPos score table) -- | Show a single high score, from the given ranking in the high score table. showScore :: TimeZone -> Int -> ScoreRecord -> [Text] showScore tz pos score = let Status{stOutcome, stDepth} = status score died = nameOutcomePast stOutcome <+> case stOutcome of Killed -> "on level" <+> tshow (abs stDepth) _ -> "" curDate = T.take 19 . tshow . utcToLocalTime tz . posixSecondsToUTCTime . date $ score turns = absoluteTimeNegate (negTime score) `timeFitUp` timeTurn tpos = T.justifyRight 3 ' ' $ tshow pos tscore = T.justifyRight 6 ' ' $ tshow $ points score victims = let nkilled = sum $ EM.elems $ theirVictims score nlost = sum $ EM.elems $ ourVictims score in "killed" <+> tshow nkilled <> ", lost" <+> tshow nlost -- This may overfill the screen line, but with default fonts -- it's very unlikely and not a big problem in any case. chalText | challenge score == defaultChallenge = "" | otherwise = tshowChallenge (challenge score) tturns = makePhrase [MU.CarWs turns "turn"] in [ tpos <> "." <+> tscore <+> gplayerName score <+> died <> "," <+> victims <> "," , " " <> "after" <+> tturns <+> chalText <+> "on" <+> curDate <> "." ] getTable :: ContentId ModeKind -> ScoreDict -> ScoreTable getTable = EM.findWithDefault (ScoreTable []) getRecord :: Int -> ScoreTable -> ScoreRecord getRecord pos (ScoreTable table) = fromMaybe (error $ "" `showFailure` pos) $ listToMaybe $ drop (pred pos) table getStatus :: ScoreRecord -> Status getStatus = status getDate :: ScoreRecord -> POSIXTime getDate = date showAward :: Int -- ^ number of (3-line) scores to be shown -> ScoreTable -- ^ current score table -> Int -- ^ position of the current score in the table -> Text -- ^ the name of the game mode -> Text showAward height table pos gameModeName = let posStatus = status $ getRecord pos table (efforts, person, msgUnless) = case stOutcome posStatus of Killed | stDepth posStatus <= 1 -> ("your short-lived struggle", MU.Sg3rd, "(no bonus)") Killed -> ("your heroic deeds", MU.PlEtc, "(no bonus)") Defeated -> ("your futile efforts", MU.PlEtc, "(no bonus)") Camping -> -- This is only according to the limited player knowledge; -- the final score can be different, which is fine: ("your valiant exploits", MU.PlEtc, "") Conquer -> ("your ruthless victory", MU.Sg3rd, if pos <= height then "among the best" -- "greatest heroes" doesn't fit else "(bonus included)") Escape -> ("your dashing coup", MU.Sg3rd, if pos <= height then "among the best" else "(bonus included)") Restart -> ("your abortive attempt", MU.Sg3rd, "(no bonus)") subject = makePhrase [efforts, "in", MU.Text gameModeName] in makeSentence [ MU.SubjectVerb person MU.Yes (MU.Text subject) "award you" , MU.Ordinal pos, "place", msgUnless ]