module Game.LambdaHack.State
(
State(..), TgtMode(..), Cursor(..), Status(..)
, slevel, stime
, defaultState
, updateCursor, updateTime, updateDiscoveries, updateLevel, updateDungeon
, Diary(..), defaultDiary
, lookAt, partItemCheat, partItem, partItemNWs
, DebugMode(..), cycleMarkVision, toggleOmniscient
) where
import qualified Data.Set as S
import Data.Binary
import qualified System.Random as R
import System.Time
import Data.Text (Text)
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU
import qualified Data.List as L
import Game.LambdaHack.Actor
import Game.LambdaHack.Point
import Game.LambdaHack.Level
import qualified Game.LambdaHack.Dungeon as Dungeon
import Game.LambdaHack.Item
import Game.LambdaHack.Msg
import Game.LambdaHack.Time
import qualified Game.LambdaHack.Kind as Kind
import Game.LambdaHack.Content.FactionKind
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Effect
import Game.LambdaHack.Flavour
import Game.LambdaHack.Config
data Diary = Diary
{ sreport :: Report
, shistory :: History
}
data State = State
{ splayer :: ActorId
, scursor :: Cursor
, sflavour :: FlavourMap
, sdisco :: Discoveries
, sdungeon :: Dungeon.Dungeon
, slid :: Dungeon.LevelId
, scounter :: Int
, srandom :: R.StdGen
, sconfig :: Config
, stakeTime :: Maybe Bool
, squit :: Maybe (Bool, Status)
, sfaction :: Kind.Id FactionKind
, sdebug :: DebugMode
}
deriving Show
data TgtMode =
TgtOff
| TgtExplicit
| TgtAuto
deriving (Show, Eq)
data Cursor = Cursor
{ ctargeting :: TgtMode
, clocLn :: Dungeon.LevelId
, clocation :: Point
, creturnLn :: Dungeon.LevelId
, ceps :: Int
}
deriving Show
data Status =
Killed !Dungeon.LevelId
| Camping
| Victor
| Restart
deriving (Show, Eq, Ord)
data DebugMode = DebugMode
{ smarkVision :: Maybe FovMode
, somniscient :: Bool
}
deriving Show
slevel :: State -> Level
slevel State{slid, sdungeon} = sdungeon Dungeon.! slid
stime :: State -> Time
stime State{slid, sdungeon} = ltime $ sdungeon Dungeon.! slid
defaultDiary :: IO Diary
defaultDiary = do
dateTime <- getClockTime
let curDate = MU.Text $ T.pack $ calendarTimeToString $ toUTCTime dateTime
return Diary
{ sreport = emptyReport
, shistory = singletonHistory $ singletonReport $
makeSentence ["Player diary started on", curDate]
}
defaultState :: Config -> Kind.Id FactionKind -> FlavourMap
-> Dungeon.Dungeon -> Dungeon.LevelId -> Point -> R.StdGen
-> State
defaultState config sfaction flavour dng lid ploc g =
State
0
(Cursor TgtOff lid ploc lid 0)
flavour
S.empty
dng
lid
0
g
config
Nothing
Nothing
sfaction
defaultDebugMode
defaultDebugMode :: DebugMode
defaultDebugMode = DebugMode
{ smarkVision = Nothing
, somniscient = False
}
updateCursor :: (Cursor -> Cursor) -> State -> State
updateCursor f s = s { scursor = f (scursor s) }
updateTime :: (Time -> Time) -> State -> State
updateTime f s = updateLevel (\ lvl@Level{ltime} -> lvl {ltime = f ltime}) s
updateDiscoveries :: (Discoveries -> Discoveries) -> State -> State
updateDiscoveries f s = s { sdisco = f (sdisco s) }
updateLevel :: (Level -> Level) -> State -> State
updateLevel f s = updateDungeon (Dungeon.adjust f (slid s)) s
updateDungeon :: (Dungeon.Dungeon -> Dungeon.Dungeon) -> State -> State
updateDungeon f s = s {sdungeon = f (sdungeon s)}
cycleMarkVision :: State -> State
cycleMarkVision s@State{sdebug = sdebug@DebugMode{smarkVision}} =
s {sdebug = sdebug {smarkVision = case smarkVision of
Nothing -> Just (Digital 100)
Just (Digital _) -> Just Permissive
Just Permissive -> Just Shadow
Just Shadow -> Just Blind
Just Blind -> Nothing }}
toggleOmniscient :: State -> State
toggleOmniscient s@State{sdebug = sdebug@DebugMode{somniscient}} =
s {sdebug = sdebug {somniscient = not somniscient}}
instance Binary Diary where
put Diary{..} = do
put sreport
put shistory
get = do
sreport <- get
shistory <- get
return Diary{..}
instance Binary State where
put (State player cursor flav disco dng lid ct
g config stakeTime _ sfaction _) = do
put player
put cursor
put flav
put disco
put dng
put lid
put ct
put (show g)
put config
put stakeTime
put sfaction
get = do
player <- get
cursor <- get
flav <- get
disco <- get
dng <- get
lid <- get
ct <- get
g <- get
config <- get
stakeTime <- get
sfaction <- get
return
(State player cursor flav disco dng lid ct (read g) config stakeTime
Nothing sfaction defaultDebugMode)
instance Binary TgtMode where
put TgtOff = putWord8 0
put TgtExplicit = putWord8 1
put TgtAuto = putWord8 2
get = do
tag <- getWord8
case tag of
0 -> return TgtOff
1 -> return TgtExplicit
2 -> return TgtAuto
_ -> fail "no parse (TgtMode)"
instance Binary Cursor where
put (Cursor act cln loc rln eps) = do
put act
put cln
put loc
put rln
put eps
get = do
act <- get
cln <- get
loc <- get
rln <- get
eps <- get
return (Cursor act cln loc rln eps)
instance Binary Status where
put (Killed ln) = putWord8 0 >> put ln
put Camping = putWord8 1
put Victor = putWord8 2
put Restart = putWord8 3
get = do
tag <- getWord8
case tag of
0 -> fmap Killed get
1 -> return Camping
2 -> return Victor
3 -> return Restart
_ -> fail "no parse (Status)"
partItemCheat :: Bool -> Kind.Ops ItemKind -> State -> Item -> MU.Part
partItemCheat cheat coitem@Kind.Ops{okind} state i =
let ik = jkind i
kind = okind ik
identified = L.length (iflavour kind) == 1 ||
ik `S.member` sdisco state
eff = effectToSuffix (ieffect kind)
pwr = if jpower i == 0
then ""
else "(+" <> showT (jpower i) <> ")"
genericName = iname kind
name = let fullName = genericName <+> eff <+> pwr
flavour = getFlavour coitem (sflavour state) ik
in if identified
then fullName
else flavourToName flavour
<+> if cheat then fullName else genericName
in MU.Text name
partItem :: Kind.Ops ItemKind -> State -> Item -> MU.Part
partItem = partItemCheat False
partItemNWs :: Kind.Ops ItemKind -> State -> Item -> MU.Part
partItemNWs coitem s i = MU.NWs (jcount i) $ partItem coitem s i
lookAt :: Kind.COps
-> Bool
-> Bool
-> State
-> Level
-> Point
-> Text
-> Text
lookAt Kind.COps{coitem, cotile=Kind.Ops{oname}} detailed canSee s lvl loc msg
| detailed =
let tile = lvl `rememberAt` loc
in makeSentence [MU.Text $ oname tile] <+> msg <+> isd
| otherwise = msg <+> isd
where
is = lvl `rememberAtI` loc
prefixSee = MU.Text $ if canSee then "you see" else "you remember"
isd = case is of
[] -> ""
_ | length is <= 3 ->
makeSentence [prefixSee, MU.WWandW $ map (partItemNWs coitem s) is]
_ | detailed -> "Objects:"
_ -> "Objects here."