module Game.LambdaHack.State
(
State(..), TgtMode(..), Cursor(..)
, slevel
, defaultState
, updateCursor, updateTime, updateDiscoveries, updateLevel, updateDungeon
, Diary(..), defaultDiary
, DebugMode(..), cycleMarkVision, toggleOmniscient
) where
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.Binary
import qualified Game.LambdaHack.Config as Config
import qualified System.Random as R
import System.Time
import Game.LambdaHack.Actor
import Game.LambdaHack.Misc
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.FOV
data Diary = Diary
{ smsg :: Msg
, shistory :: [Msg]
}
data State = State
{ splayer :: ActorId
, scursor :: Cursor
, stime :: Time
, sflavour :: FlavourMap
, sdisco :: Discoveries
, sdungeon :: Dungeon.Dungeon
, slid :: Dungeon.LevelId
, scounter :: (Int, Int)
, sparty :: IS.IntSet
, srandom :: R.StdGen
, sconfig :: Config.CP
, 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
}
deriving Show
data DebugMode = DebugMode
{ smarkVision :: Maybe FovMode
, somniscient :: Bool
}
deriving Show
slevel :: State -> Level
slevel State{slid, sdungeon} = sdungeon Dungeon.! slid
defaultDiary :: IO Diary
defaultDiary = do
curDate <- getClockTime
let time = calendarTimeToString $ toUTCTime curDate
return Diary
{ smsg = ""
, shistory = ["Player diary started on " ++ time ++ "."]
}
defaultState :: Config.CP -> FlavourMap -> Dungeon.Dungeon -> Dungeon.LevelId
-> Point -> R.StdGen -> State
defaultState config flavour dng lid ploc g =
State
(AHero 0)
(Cursor TgtOff lid ploc lid)
0
flavour
S.empty
dng
lid
(0, 0)
IS.empty
g
config
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 = s { stime = f (stime 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 smsg
put shistory
get = do
smsg <- get
shistory <- get
return Diary{..}
instance Binary State where
put (State player cursor time flav disco dng lid ct
party g config _) = do
put player
put cursor
put time
put flav
put disco
put dng
put lid
put ct
put party
put (show g)
put config
get = do
player <- get
cursor <- get
time <- get
flav <- get
disco <- get
dng <- get
lid <- get
ct <- get
party <- get
g <- get
config <- get
return
(State player cursor time flav disco dng lid ct
party (read g) config defaultDebugMode)
instance Binary Cursor where
put (Cursor act cln loc rln) = do
put act
put cln
put loc
put rln
get = do
act <- get
cln <- get
loc <- get
rln <- get
return (Cursor act cln loc rln)
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)"