{-# 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.FactionKind
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
  , gkindName    :: Text       -- ^ name of the faction's gkind
  , 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 gkind
         -> 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 gkindName 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.
          let speedup = max 0 (-c - turnsSpent)
          in if c >= -10000
             then speedup  -- every turn matters
             else 10000 * speedup / (-c)  -- prevent exploit speedruns
        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 || turnsSpent > 100, insertPos score table)
       -- even if stash looted and all gold lost, count highscore if long game

-- | 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 <+> gkindName 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 && length (unTable table) > 3
             then "among the best"  -- "greatest heroes" doesn't fit
             else "(bonus included)")
          Escape ->
            ("your dashing coup", MU.Sg3rd,
             if pos <= height && length (unTable table) > 3
             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 ]
