module Game.LambdaHack.Action.HighScore
( register
) where
import System.Directory
import Control.Monad
import Text.Printf
import System.Time
import Data.Binary
import qualified Data.List as L
import Data.Text (Text)
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Utils.File
import Game.LambdaHack.Config
import Game.LambdaHack.Dungeon
import Game.LambdaHack.Misc
import Game.LambdaHack.Time
import Game.LambdaHack.Msg
import Game.LambdaHack.State
data ScoreRecord = ScoreRecord
{ points :: !Int
, negTime :: !Time
, date :: !ClockTime
, status :: !Status
}
deriving (Eq, Ord)
instance Binary ScoreRecord where
put (ScoreRecord p n (TOD cs cp) s) = do
put p
put n
put cs
put cp
put s
get = do
p <- get
n <- get
cs <- get
cp <- get
s <- get
return (ScoreRecord p n (TOD cs cp) s)
showScore :: (Int, ScoreRecord) -> [Text]
showScore (pos, score) =
let died = case status score of
Killed lvl -> "perished on level " ++ show (levelNumber lvl) ++ ","
Camping -> "is camping somewhere,"
Victor -> "emerged victorious"
Restart -> "resigned prematurely"
curDate = calendarTimeToString . toUTCTime . date $ score
big, lil :: String
big = " "
lil = " "
turns = (negTime score `timeFit` timeTurn)
in map T.pack
[ big
, printf "%4d. %6d This adventuring party %s after %d turns "
pos (points score) died turns
, lil ++ printf "on %s. " curDate
]
type ScoreTable = [ScoreRecord]
empty :: ScoreTable
empty = []
save :: ConfigUI -> ScoreTable -> IO ()
save ConfigUI{configScoresFile} scores = encodeEOF configScoresFile scores
restore :: ConfigUI -> IO ScoreTable
restore ConfigUI{configScoresFile} = do
b <- doesFileExist configScoresFile
if not b
then return empty
else strictDecodeEOF configScoresFile
insertPos :: ScoreRecord -> ScoreTable -> (ScoreTable, Int)
insertPos s h =
let (prefix, suffix) = L.span (> s) h
in (prefix ++ [s] ++ suffix, L.length prefix + 1)
showTable :: ScoreTable -> Int -> Int -> Overlay
showTable h start height =
let zipped = zip [1..] h
screenful = take height . drop (start 1) $ zipped
in concatMap showScore screenful
slideshow :: Int -> ScoreTable -> Int -> [Overlay]
slideshow pos h height =
if pos <= height
then [showTable h 1 height]
else [showTable h 1 height,
showTable h (max (height + 1) (pos height `div` 2)) height]
register :: ConfigUI
-> Bool
-> Int
-> Time
-> ClockTime
-> Status
-> IO (Msg, [Overlay])
register configUI write total time date status = do
h <- restore configUI
let points = case status of
Killed _ -> (total + 1) `div` 2
_ -> total
negTime = timeNegate time
score = ScoreRecord{..}
(h', pos) = insertPos score h
(_, nlines) = normalLevelBound
height = nlines `div` 3
(subject, person, msgUnless) =
case status of
Killed lvl | levelNumber lvl <= 1 ->
("your short-lived struggle", MU.Sg3rd, "(score halved)")
Killed _ ->
("your heroic deeds", MU.PlEtc, "(score halved)")
Camping ->
("your valiant exploits", MU.PlEtc, "(unless you are slain)")
Victor ->
("your glorious victory", MU.Sg3rd,
if pos <= height
then "among the greatest heroes"
else "")
Restart ->
("your abortive attempt", MU.Sg3rd, "(score halved)")
msg = makeSentence
[ MU.SubjectVerb person MU.Yes subject "award you"
, MU.Ordinal pos, "place"
, msgUnless ]
when write $ save configUI h'
return (msg, slideshow pos h' height)