{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Common.HighScore
( ScoreDict, ScoreTable
, empty, register, showScore, getTable, getRecord, highSlideshow
#ifdef EXPOSE_INTERNAL
, ScoreRecord
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.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 qualified Game.LambdaHack.Common.Kind as Kind
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 (..))
data ScoreRecord = ScoreRecord
{ points :: Int
, negTime :: Time
, date :: POSIXTime
, status :: Status
, challenge :: Challenge
, gplayerName :: Text
, ourVictims :: EM.EnumMap (Kind.Id ItemKind) Int
, theirVictims :: EM.EnumMap (Kind.Id ItemKind) Int
}
deriving (Eq, Ord, Show, Generic)
instance Binary ScoreRecord
newtype ScoreTable = ScoreTable [ScoreRecord]
deriving (Eq, Binary)
instance Show ScoreTable where
show _ = "a score table"
type ScoreDict = EM.EnumMap (Kind.Id ModeKind) ScoreTable
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 = 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 :: Kind.Id 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
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
-> Time
-> Status
-> POSIXTime
-> Challenge
-> Text
-> EM.EnumMap (Kind.Id ItemKind) Int
-> EM.EnumMap (Kind.Id ItemKind) Int
-> HiCondPoly
-> (Bool, (ScoreTable, Int))
register table total time status@Status{stOutcome} date challenge gplayerName
ourVictims theirVictims hiCondPoly =
let turnsSpent = fromIntegral $ timeFitUp time timeTurn
hiInValue (hi, c) = case hi of
HiConst -> c
HiLoot -> c * fromIntegral total
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)
showTable :: TimeZone -> ScoreTable -> Int -> Int -> [Text]
showTable tz (ScoreTable table) start height =
let zipped = zip [1..] table
screenful = take height . drop (start - 1) $ zipped
in "" : intercalate [""] (map (showScore tz) screenful)
showNearbyScores :: TimeZone -> Int -> ScoreTable -> Int -> [[Text]]
showNearbyScores tz pos h height =
if pos <= height
then [showTable tz h 1 height]
else [showTable tz h 1 height,
showTable tz h (max (height + 1) (pos - height `div` 2)) height]
highSlideshow :: ScoreTable
-> Int
-> Text
-> TimeZone
-> (Text, [[Text]])
highSlideshow table pos gameModeName tz =
let (_, nlines) = normalLevelBound
height = nlines `div` 3
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]
msg = makeSentence
[ MU.SubjectVerb person MU.Yes (MU.Text subject) "award you"
, MU.Ordinal pos, "place", msgUnless ]
in (msg, showNearbyScores tz pos table height)