module Game.LambdaHack.Actions where
import Control.Monad
import Control.Monad.State hiding (State, state)
import qualified Data.List as L
import qualified Data.IntMap as IM
import Data.Maybe
import qualified Data.IntSet as IS
import Game.LambdaHack.Utils.Assert
import Game.LambdaHack.Action
import Game.LambdaHack.Point
import Game.LambdaHack.Vector
import Game.LambdaHack.Grammar
import qualified Game.LambdaHack.Dungeon as Dungeon
import qualified Game.LambdaHack.HighScore as H
import Game.LambdaHack.Item
import qualified Game.LambdaHack.Key as K
import Game.LambdaHack.Level
import Game.LambdaHack.Actor
import Game.LambdaHack.ActorState
import Game.LambdaHack.Perception
import Game.LambdaHack.State
import qualified Game.LambdaHack.Config as Config
import qualified Game.LambdaHack.Save as Save
import qualified Game.LambdaHack.Effect as Effect
import Game.LambdaHack.EffectAction
import qualified Game.LambdaHack.Tile as Tile
import qualified Game.LambdaHack.Kind as Kind
import qualified Game.LambdaHack.Feature as F
import Game.LambdaHack.DungeonState
import Game.LambdaHack.Content.ActorKind
import Game.LambdaHack.Content.TileKind as TileKind
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Random
displayHistory :: Action ()
displayHistory = do
diary <- currentDiary
msgOverlaysConfirm "History:" [unlines $ shistory diary]
abort
dumpConfig :: Action ()
dumpConfig = do
config <- gets sconfig
let fn = "config.dump"
liftIO $ Config.dump fn config
abortWith $ "Current configuration dumped to file " ++ fn ++ "."
saveGame :: Action ()
saveGame = do
b <- msgYesNo "Really save?"
if b
then do
cops <- contentf Kind.coitem
state <- get
diary <- currentDiary
liftIO $ Save.saveGame state diary
let total = calculateTotal cops state
status = H.Camping
go <- handleScores False status total
when go $ msgMore "See you soon, stronger and braver!"
end
else abortWith "Game resumed."
quitGame :: Action ()
quitGame = do
b <- msgYesNo "Really quit?"
if b
then end
else abortWith "Game resumed."
moveCursor :: Vector -> Int -> Action ()
moveCursor dir n = do
lxsize <- gets (lxsize . slevel)
lysize <- gets (lysize . slevel)
let upd cursor =
let shiftB loc =
shiftBounded lxsize (1, 1, lxsize 2, lysize 2) loc dir
cloc = iterate shiftB (clocation cursor) !! n
in cursor { clocation = cloc }
modify (updateCursor upd)
doLook
move :: Vector -> Action ()
move dir = do
pl <- gets splayer
targeting <- gets (ctargeting . scursor)
if targeting /= TgtOff then moveCursor dir 1 else moveOrAttack True pl dir
ifRunning :: ((Vector, Int) -> Action a) -> Action a -> Action a
ifRunning t e = do
ad <- gets (bdir . getPlayerBody)
maybe e t ad
guessBump :: Kind.Ops TileKind -> F.Feature -> Kind.Id TileKind -> Action ()
guessBump cotile F.Openable t | Tile.hasFeature cotile F.Closable t =
abortWith "already open"
guessBump _ F.Openable _ =
abortWith "not a door"
guessBump cotile F.Closable t | Tile.hasFeature cotile F.Openable t =
abortWith "already closed"
guessBump _ F.Closable _ =
abortWith "not a door"
guessBump cotile F.Ascendable t | Tile.hasFeature cotile F.Descendable t =
abortWith "the way goes down, not up"
guessBump _ F.Ascendable _ =
abortWith "no stairs up"
guessBump cotile F.Descendable t | Tile.hasFeature cotile F.Ascendable t =
abortWith "the way goes up, not down"
guessBump _ F.Descendable _ =
abortWith "no stairs down"
guessBump _ _ _ = neverMind True
bumpTile :: Point -> F.Feature -> Action ()
bumpTile dloc feat = do
cotile <- contentf Kind.cotile
lvl <- gets slevel
let t = lvl `at` dloc
if Tile.hasFeature cotile feat t
then triggerTile dloc
else guessBump cotile feat t
playerAdvanceTime
triggerTile :: Point -> Action ()
triggerTile dloc = do
Kind.Ops{okind, opick} <- contentf Kind.cotile
lvl <- gets slevel
let f (F.Cause effect) = do
pl <- gets splayer
(_b, _msg) <- effectToAction effect 0 pl pl 0
return ()
f (F.ChangeTo group) = do
state <- get
let hms = levelHeroList state ++ levelMonsterList state
case lvl `atI` dloc of
[] -> if unoccupied hms dloc
then do
newTileId <- rndToAction $ opick group (const True)
let adj = (Kind.// [(dloc, newTileId)])
modify (updateLevel (updateLMap adj))
else abortWith "blocked"
_ : _ -> abortWith "jammed"
f _ = return ()
mapM_ f $ TileKind.tfeature $ okind $ lvl `at` dloc
playerTriggerDir :: F.Feature -> Action ()
playerTriggerDir feat = do
msgReset "direction?"
displayAll
e <- session nextCommand
lxsize <- gets (lxsize . slevel)
K.handleDir lxsize e (playerBumpDir feat) (neverMind True)
playerBumpDir :: F.Feature -> Vector -> Action ()
playerBumpDir feat dir = do
pl <- gets splayer
body <- gets (getActor pl)
let dloc = bloc body `shift` dir
bumpTile dloc feat
playerTriggerTile :: F.Feature -> Action ()
playerTriggerTile feat = do
ploc <- gets (bloc . getPlayerBody)
bumpTile ploc feat
actorOpenDoor :: ActorId -> Vector -> Action ()
actorOpenDoor actor dir = do
Kind.COps{ cotile
, coitem
, coactor=Kind.Ops{okind}
} <- contentOps
lvl <- gets slevel
pl <- gets splayer
body <- gets (getActor actor)
bitems <- gets (getActorItem actor)
let dloc = shift (bloc body) dir
t = lvl `at` dloc
isPlayer = actor == pl
isVerbose = isPlayer
iq = aiq $ okind $ bkind body
openPower = Tile.SecretStrength $
if isPlayer
then 1
else case strongestSearch coitem bitems of
Just i -> iq + jpower i
Nothing -> iq
unless (openable cotile lvl openPower dloc) $ neverMind isVerbose
if Tile.hasFeature cotile F.Closable t
then abortIfWith isVerbose "already open"
else if not (Tile.hasFeature cotile F.Closable t ||
Tile.hasFeature cotile F.Openable t ||
Tile.hasFeature cotile F.Hidden t)
then neverMind isVerbose
else triggerTile dloc
advanceTime actor
tgtAscend :: Int -> Action ()
tgtAscend k = do
cotile <- contentf Kind.cotile
cursor <- gets scursor
targeting <- gets (ctargeting . scursor)
slid <- gets slid
lvl <- gets slevel
st <- get
dungeon <- gets sdungeon
let loc = clocation cursor
tile = lvl `at` loc
rightStairs =
k == 1 && Tile.hasFeature cotile (F.Cause Effect.Ascend) tile ||
k == 1 && Tile.hasFeature cotile (F.Cause Effect.Descend) tile
if rightStairs
then case whereTo st k of
Nothing ->
abortWith "no more levels in this direction"
Just (nln, nloc) ->
assert (nln /= slid `blame` (nln, "stairs looped")) $ do
modify (\ state -> state {slid = nln})
lvl2 <- gets slevel
let upd cur =
let clocation =
if Tile.hasFeature cotile F.Exit (lvl2 `rememberAt` nloc)
then nloc
else loc
in cur { clocation, clocLn = nln }
modify (updateCursor upd)
else do
let n = Dungeon.levelNumber slid
depth = Dungeon.depth dungeon
nln = Dungeon.levelDefault $ min depth $ max 1 $ n k
when (nln == slid) $ abortWith "no more levels in this direction"
modify (\ state -> state {slid = nln})
let upd cur = cur {clocLn = nln}
modify (updateCursor upd)
when (targeting == TgtOff) $ do
let upd cur = cur {ctargeting = TgtExplicit}
modify (updateCursor upd)
doLook
cycleHero :: Action ()
cycleHero = do
pl <- gets splayer
hs <- gets (lheroes . slevel)
let i = case pl of AHero n -> n ; _ -> 1
(lt, gt) = IM.split i hs
case IM.keys gt ++ IM.keys lt of
[] -> abortWith "Cannot select any other hero on this level."
ni : _ -> selectPlayer (AHero ni)
>>= assert `trueM` (pl, ni, "hero duplicated")
search :: Action ()
search = do
Kind.COps{coitem, cotile} <- contentOps
lvl <- gets slevel
le <- gets (lsecret . slevel)
lxsize <- gets (lxsize . slevel)
ploc <- gets (bloc . getPlayerBody)
pitems <- gets getPlayerItem
let delta = case strongestSearch coitem pitems of
Just i -> 1 + jpower i
Nothing -> 1
searchTile sle mv =
let loc = shift ploc mv
t = lvl `at` loc
k = Tile.secretStrength (le IM.! loc) delta
in if Tile.hasFeature cotile F.Hidden t
then if k > 0
then IM.insert loc (Tile.SecretStrength k) sle
else IM.delete loc sle
else sle
leNew = L.foldl' searchTile le (moves lxsize)
modify (updateLevel (\ l -> l {lsecret = leNew}))
lvlNew <- gets slevel
let triggerHidden mv = do
let dloc = shift ploc mv
t = lvlNew `at` dloc
when (Tile.hasFeature cotile F.Hidden t && IM.notMember dloc leNew) $
triggerTile dloc
mapM_ triggerHidden (moves lxsize)
playerAdvanceTime
moveOrAttack :: Bool
-> ActorId
-> Vector
-> Action ()
moveOrAttack allowAttacks actor dir = do
cops@Kind.COps{cotile = cotile@Kind.Ops{okind}} <- contentOps
state <- get
pl <- gets splayer
lvl <- gets slevel
sm <- gets (getActor actor)
let sloc = bloc sm
tloc = sloc `shift` dir
tgt <- gets (locToActor tloc)
case tgt of
Just target
| allowAttacks ->
actorAttackActor actor target
| accessible cops lvl sloc tloc -> do
actorRunActor actor target
when (actor == pl) $
msgAdd $ lookAt cops False True state lvl tloc ""
| otherwise -> abortWith ""
Nothing
| accessible cops lvl sloc tloc -> do
updateAnyActor actor $ \ body -> body {bloc = tloc}
when (actor == pl) $
msgAdd $ lookAt cops False True state lvl tloc ""
advanceTime actor
| allowAttacks && actor == pl
&& Tile.canBeHidden cotile (okind $ lvl `rememberAt` tloc) -> do
msgAdd "You search your surroundings."
search
| otherwise -> actorOpenDoor actor dir
actorAttackActor :: ActorId -> ActorId -> Action ()
actorAttackActor source@(AHero _) target@(AHero _) =
selectPlayer target
>>= assert `trueM` (source, target, "player bumps into himself")
actorAttackActor source target = do
Kind.COps{coactor, coitem=coitem@Kind.Ops{opick, okind}} <- contentOps
state <- get
sm <- gets (getActor source)
tm <- gets (getActor target)
per <- currentPerception
bitems <- gets (getActorItem source)
let h2hGroup = if isAHero source then "unarmed" else "monstrous"
h2hKind <- rndToAction $ opick h2hGroup (const True)
let sloc = bloc sm
h2h = Item h2hKind 0 Nothing 1
str = strongestSword coitem bitems
stack = fromMaybe h2h str
single = stack { jcount = 1 }
verb = iverbApply $ okind $ jkind single
msg = actorVerbActorExtra coactor sm verb tm $
if isJust str
then " with " ++ objectItem coitem state single
else ""
visible = sloc `IS.member` totalVisible per
when visible $ msgAdd msg
itemEffectAction 0 source target single
advanceTime source
actorRunActor :: ActorId -> ActorId -> Action ()
actorRunActor source target = do
pl <- gets splayer
sloc <- gets (bloc . getActor source)
tloc <- gets (bloc . getActor target)
updateAnyActor source $ \ m -> m { bloc = tloc }
updateAnyActor target $ \ m -> m { bloc = sloc }
if source == pl
then stopRunning
else when (isAMonster source) $ focusIfAHero target
advanceTime source
rollMonster :: Kind.COps -> Perception -> State -> Rnd State
rollMonster Kind.COps{cotile, coactor=Kind.Ops{opick, okind}} per state = do
let lvl = slevel state
hs = levelHeroList state
ms = levelMonsterList state
isLit = Tile.isLit cotile
rc <- monsterGenChance (Dungeon.levelNumber $ slid state) (L.length ms)
if not rc
then return state
else do
let distantAtLeast d =
\ l _ -> L.all (\ h -> chessDist (lxsize lvl) (bloc h) l > d) hs
loc <-
findLocTry 20 (lmap lvl)
[ \ _ t -> not (isLit t)
, distantAtLeast 30
, distantAtLeast 20
, \ l t -> not (isLit t) || distantAtLeast 20 l t
, distantAtLeast 10
, \ l _ -> not $ l `IS.member` totalVisible per
, distantAtLeast 5
, \ l t -> Tile.hasFeature cotile F.Walkable t
&& l `notElem` L.map bloc (hs ++ ms)
]
mk <- opick "monster" (const True)
hp <- rollDice $ ahp $ okind mk
return $ addMonster cotile mk hp loc state
generateMonster :: Action ()
generateMonster = do
cops <- contentOps
state <- get
per <- currentPerception
nstate <- rndToAction $ rollMonster cops per state
srandom <- gets srandom
put $ nstate {srandom}
regenerateLevelHP :: Action ()
regenerateLevelHP = do
Kind.COps{ coitem
, coactor=coactor@Kind.Ops{okind}
} <- contentOps
time <- gets stime
let upd itemIM a m =
let ak = okind $ bkind m
bitems = fromMaybe [] $ IM.lookup a itemIM
regen = max 10 $
aregen ak `div`
case strongestRegen coitem bitems of
Just i -> 5 * jpower i
Nothing -> 1
in if time `mod` regen /= 0
then m
else addHp coactor 1 m
hi <- gets (lheroItem . slevel)
modify (updateLevel (updateHeroes (IM.mapWithKey (upd hi))))
mi <- gets (lmonItem . slevel)
modify (updateLevel (updateMonsters (IM.mapWithKey (upd mi))))