{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Common.HighScore
( ScoreTable, ScoreDict
, empty, register, showScore, showAward, getTable, unTable, getRecord
#ifdef EXPOSE_INTERNAL
, 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 (HiCondPoly, HiIndeterminant (..),
ModeKind, Outcome (..))
import Game.LambdaHack.Definition.Defs
data ScoreRecord = ScoreRecord
{ points :: Int
, negTime :: Time
, date :: POSIXTime
, status :: Status
, challenge :: Challenge
, gplayerName :: Text
, ourVictims :: EM.EnumMap (ContentId ItemKind) Int
, theirVictims :: EM.EnumMap (ContentId ItemKind) Int
}
deriving (Show, Eq, Ord, Generic)
instance Binary ScoreRecord
newtype ScoreTable = ScoreTable {unTable :: [ScoreRecord]}
deriving (Eq, Binary)
instance Show ScoreTable where
show _ = "a score table"
type ScoreDict = EM.EnumMap (ContentId ModeKind) ScoreTable
empty :: ScoreDict
empty = EM.empty
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 :: ScoreTable
-> Int
-> Int
-> Time
-> Status
-> POSIXTime
-> Challenge
-> Text
-> EM.EnumMap (ContentId ItemKind) Int
-> EM.EnumMap (ContentId ItemKind) Int
-> HiCondPoly
-> (Bool, (ScoreTable, Int))
register table total dungeonTotal time status@Status{stOutcome}
date challenge gplayerName ourVictims theirVictims hiCondPoly =
let turnsSpent = fromIntegral $ timeFitUp time timeTurn
hiInValue (hi, c) = assert (total <= dungeonTotal) $ case hi of
HiConst -> c
HiLoot | dungeonTotal == 0 -> c
HiLoot -> c * fromIntegral total / fromIntegral dungeonTotal
HiSprint ->
max 0 (-c - turnsSpent)
HiBlitz ->
sqrt $ max 0 (1000000 + c * turnsSpent)
HiSurvival ->
sqrt $ max 0 (min 1000000 $ c * turnsSpent)
HiKill -> c * fromIntegral (sum (EM.elems theirVictims))
HiLoss -> c * fromIntegral (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
points = (ceiling :: Double -> Int)
$ hiCondValue hiCondPoly
* 1.5 ^^ (- (difficultyCoeff (cdiff challenge)))
negTime = absoluteTimeNegate time
score = ScoreRecord{..}
in (points > 0, insertPos score table)
showScore :: TimeZone -> Int -> ScoreRecord -> [Text]
showScore tz pos score =
let Status{stOutcome, stDepth} = status score
died = case stOutcome of
Killed -> "perished on level" <+> tshow (abs stDepth)
Defeated -> "got defeated"
Camping -> "set camp"
Conquer -> "slew all opposition"
Escape -> "emerged victorious"
Restart -> "resigned prematurely"
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
diff = cdiff $ challenge score
diffText | diff == difficultyDefault = ""
| otherwise = "difficulty" <+> tshow diff <> ", "
tturns = makePhrase [MU.CarWs turns "turn"]
in [ tpos <> "." <+> tscore <+> gplayerName score
<+> died <> "," <+> victims <> ","
, " "
<> diffText <> "after" <+> tturns <+> "on" <+> curDate <> "."
]
getTable :: ContentId ModeKind -> ScoreDict -> ScoreTable
getTable = EM.findWithDefault (ScoreTable [])
getRecord :: Int -> ScoreTable -> ScoreRecord
getRecord pos (ScoreTable table) =
fromMaybe (error $ "" `showFailure` (pos, table))
$ listToMaybe $ drop (pred pos) table
showAward :: Int
-> ScoreTable
-> Int
-> Text
-> 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 ->
("your valiant exploits", MU.PlEtc, "")
Conquer ->
("your ruthless victory", MU.Sg3rd,
if pos <= height
then "among the best"
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 ]