Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

move time management to particular actions

Possibly, it's correct now in all cases. In particular, targeting is free.
  • Loading branch information...
commit 254a878c0c7ddbcc4fed271fed8bd0d602c4952e 1 parent 54d27e3
@Mikolaj Mikolaj authored
View
32 src/Actions.hs
@@ -117,7 +117,7 @@ acceptCurrent h = do
then endTargeting True
else h -- nothing to accept right now
-moveCursor :: Dir -> Int -> Action () -- TODO: do not take time!!!
+moveCursor :: Dir -> Int -> Action ()
moveCursor dir n = do
(sy, sx) <- gets (lsize . slevel)
let iter :: Int -> (a -> a) -> a -> a -- not in base libs???
@@ -317,9 +317,9 @@ actorOpenClose actor v o dir =
abortIfWith isVerbose "jammed"
_ -> -- there is no door here
neverMind isVerbose
+ advanceTime actor
-- | Perform a level switch to a given level. False, if nothing to do.
--- TODO: in targeting mode do not take time, otherwise take as much as 1 step.
lvlswitch :: LevelName -> Action Bool
lvlswitch nln =
do
@@ -403,6 +403,7 @@ lvlchange vdir =
-- Create a backup of the savegame.
state <- get
liftIO $ Save.saveGame state >> Save.mvBkp (sconfig state)
+ playerAdvanceTime
_ -> -- no stairs
if targeting
then do
@@ -511,6 +512,7 @@ search =
f l m = M.adjust searchTile (shift ploc m) l
slmap = foldl' f lmap moves
modify (updateLevel (updateLMap (const slmap)))
+ playerAdvanceTime
-- | Start the floor targeting mode or toggle between the two floor modes.
targetFloor :: Action ()
@@ -524,8 +526,6 @@ targetFloor = do
-- | Start the monster targeting mode. Cycle between monster targets.
-- TODO: also target a monster by moving the cursor, if in target monster mode.
--- TODO: generally streamline and extend when the commands do not take time,
--- when firing at targets is implemented, when monsters use targets.
-- TODO: sort monsters by distance to the player.
-- TODO: when each hero has his own perception, only target monsters
-- visible by the current player.
@@ -582,7 +582,6 @@ setCursor tgt = do
-- | Perform look around in the current location of the cursor.
-- TODO: depending on tgt, show extra info about tile or monster or both
--- TODO: do not take time
doLook :: Action ()
doLook =
do
@@ -660,6 +659,7 @@ drinkPotion =
updatePlayerBody (\ p -> p { mhp = php p })
Just _ -> abortWith "you cannot drink that"
Nothing -> neverMind True
+ playerAdvanceTime
-- | Finds an actor at a location. Perception irrelevant.
locToActor :: State -> Loc -> Maybe Actor
@@ -689,13 +689,13 @@ fireItem = do
Just a -> actorDamageActor pl a 1 " with a dart"
Nothing -> modify (updateLevel (scatterItems [fired] loc))
Nothing -> abortWith "nothing to fire"
+ playerAdvanceTime
applyItem :: Action ()
applyItem = do
state <- get
per <- currentPerception
pitems <- gets (mitems . getPlayerBody)
- pl <- gets splayer
case findItem (\ i -> itype i == Wand) pitems of
Just (wand, _) -> do
let applied = wand { icount = 1 }
@@ -708,6 +708,7 @@ applyItem = do
selectPlayer targetActor >> return ()
Nothing -> abortWith "no living target to affect"
Nothing -> abortWith "nothing to apply"
+ playerAdvanceTime
dropItem :: Action ()
dropItem =
@@ -727,6 +728,7 @@ dropItem =
message (subjectVerbIObject state pbody "drop" i' "")
dropItemsAt [i'] ploc
Nothing -> neverMind True
+ playerAdvanceTime
dropItemsAt :: [Item] -> Loc -> Action ()
dropItemsAt is loc = modify (updateLevel (scatterItems is loc))
@@ -785,6 +787,7 @@ actorPickupItem actor =
updateAnyActor actor $ \ m ->
m { mitems = nitems, mletter = maxLetter l (mletter movable) }
Nothing -> abortIfWith isPlayer "you cannot carry any more"
+ advanceTime actor
updateAnyActor :: Actor -> (Movable -> Movable) -> Action ()
updateAnyActor actor f = modify (updateAnyActorBody actor f)
@@ -867,7 +870,7 @@ moveOrAttack allowAttacks autoOpen actor dir
-- Moving with no direction is a noop.
-- We include it currently to prevent that
-- monsters attack themselves by accident.
- return ()
+ advanceTime actor
| otherwise = do
-- We start by looking at the target position.
state <- get
@@ -889,9 +892,10 @@ moveOrAttack allowAttacks autoOpen actor dir
else abort
Nothing ->
if accessible lmap sloc tloc then do
- -- perform the move
+ -- perform the move; TODO: make this a separate function
updateAnyActor actor $ \ m -> m { mloc = tloc }
when (actor == pl) $ message $ lookAt False state lmap tloc ""
+ advanceTime actor
else if autoOpen then
-- try to open a door
actorOpenClose actor False True dir
@@ -904,8 +908,8 @@ moveOrAttack allowAttacks autoOpen actor dir
-- and a movable capable of moving through walls can be attacked from an
-- adjacent position.
actorAttackActor :: Actor -> Actor -> Action ()
-actorAttackActor (AHero _) target@(AHero _) = -- TODO: do not take a turn!!!
- -- Select adjacent hero by bumping into him.
+actorAttackActor (AHero _) target@(AHero _) =
+ -- Select adjacent hero by bumping into him. Takes no time.
selectPlayer target >> return ()
actorAttackActor source target = do
state <- get
@@ -917,6 +921,7 @@ actorAttackActor source target = do
then ""
else " with a (+" ++ show sword ++ ") sword" -- TODO: generate proper message
actorDamageActor source target damage weaponMsg
+ advanceTime source
actorDamageActor :: Actor -> Actor -> Int -> String -> Action ()
actorDamageActor source target damage weaponMsg =
@@ -955,7 +960,6 @@ actorDamageActor source target damage weaponMsg =
-- | Resolves the result of an actor running into another.
-- This involves switching positions of the two movables.
--- Always takes time.
actorRunActor :: Actor -> Actor -> Action ()
actorRunActor source target = do
state <- get
@@ -973,6 +977,7 @@ actorRunActor source target = do
-- Extra prompt, in case many heroes disturbed in one turn.
when b $ messageAddMore >> return ()
_ -> return ()
+ advanceTime source
-- | Generate a monster, possibly.
generateMonster :: Action ()
@@ -989,6 +994,11 @@ advanceTime actor =
time <- gets stime
updateAnyActor actor $ \ m -> m { mtime = time + mspeed m }
+playerAdvanceTime :: Action ()
+playerAdvanceTime = do
+ pl <- gets splayer
+ advanceTime pl
+
-- | Possibly regenerate HP for the given actor.
regenerate :: Actor -> Action ()
regenerate actor =
View
6 src/Command.hs
@@ -20,19 +20,19 @@ inventoryCommand = Described "display inventory" inventory
searchCommand = Described "search for secret doors" (checkCursor search)
ascendCommand = Described "ascend a level" (lvlchange Up)
descendCommand = Described "descend a level" (lvlchange Down)
-floorCommand = Described "target location" targetFloor -- TODO: should not take time
+floorCommand = Described "target location" targetFloor
monsterCommand = Described "target monster" targetMonster
drinkCommand = Described "quaff a potion" drinkPotion
fireCommand = Described "fire an item" fireItem
applyCommand = Described "aim a wand " applyItem -- TODO: change descriptions as soon as the command generalized and requires specifying an item
-waitCommand = Described "wait" (return () :: Action ())
+waitCommand = Described "wait" playerAdvanceTime
saveCommand = Described "save and quit the game" saveGame
quitCommand = Described "quit without saving" quitGame
cancelCommand = Described "cancel current action" cancelCurrent
acceptCommand h = Described "accept current choice" (acceptCurrent h)
historyCommand = Described "display previous messages" displayHistory
dumpCommand = Described "dump current configuration" dumpConfig
-heroCommand = Described "cycle among heroes on level" cycleHero -- TODO: should take 0 turns! When it does, use in Turn.hs.
+heroCommand = Described "cycle among heroes on level" cycleHero
moveDirCommand = Described "move in direction" move
runDirCommand = Described "run in direction" run
View
4 src/Display/Curses.hs
@@ -82,8 +82,8 @@ keyTranslate e =
-- No KP_ keys in hscurses and they do not seem actively maintained.
-- For now, movement keys are more important than hero selection:
C.KeyChar c
- | c `elem` "123456789" -> Just (K.KP c)
- | otherwise -> Just (K.Char c)
+ | c `elem` ['1'..'9'] -> Just (K.KP c)
+ | otherwise -> Just (K.Char c)
_ -> Nothing
-- _ -> Just (K.Dbg $ show e)
View
2  src/Display/Vty.hs
@@ -50,7 +50,7 @@ keyTranslate e =
-- No KP_ keys in vty; see https://github.com/coreyoconnor/vty/issues/8
-- For now, movement keys are more important than hero selection:
V.EvKey (KASCII c) []
- | c `elem` "123456789" -> Just (K.KP c)
+ | c `elem` ['1'..'9'] -> Just (K.KP c)
| otherwise -> Just (K.Char c)
_ -> Nothing
-- _ -> Just (K.Dbg $ show e)
View
48 src/Turn.hs
@@ -41,13 +41,13 @@ import Version
--
-- What's happening where:
--
--- handle: check for hero's death, HP regeneration, determine who moves next,
+-- handle: HP regeneration, determine who moves next,
-- dispatch to handleMonsters or handlePlayer
--
-- handlePlayer: remember, display, get and process commmand(s),
--- advance player time, update smell map, update perception
+-- update smell map, update perception
--
--- handleMonsters: find monsters that can move or die
+-- handleMonsters: find monsters that can move
--
-- handleMonster: determine and process monster action, advance monster time
--
@@ -56,8 +56,8 @@ import Version
-- This is rather convoluted, and the functions aren't named very aptly, so we
-- should clean this up later. TODO.
--- | Decide if the hero is ready for another move. Dispatch to either 'handleMonsters'
--- or 'handlePlayer'.
+-- | Decide if the hero is ready for another move.
+-- Dispatch to either 'handleMonsters' or 'handlePlayer'.
handle :: Action ()
handle =
do
@@ -112,8 +112,9 @@ handleMonster actor =
let waiting = dir == (0,0)
let nmdir = if waiting then Nothing else Just dir
-- advance time and update monster
- updateAnyActor actor $ \ m -> m { mtime = time + mspeed m, mdir = nmdir }
- try $ -- if the following action aborts, we just continue
+ updateAnyActor actor $ \ m -> m { mdir = nmdir }
+ tryWith (advanceTime actor) $
+ -- if the following action aborts, we just advance the time and continue
if waiting
then
-- monster is not moving, let's try to pick up an object
@@ -141,21 +142,24 @@ handlePlayer :: Action ()
handlePlayer =
do
debug "handlePlayer"
- remember -- the hero perceives his (potentially new) surroundings
+ remember -- the hero perceives his (potentially new) surroundings
-- determine perception before running player command, in case monsters
-- have opened doors ...
+ oldPlayerTime <- gets (mtime . getPlayerBody)
withPerception playerCommand -- get and process a player command
- -- at this point, the command was successful
- pl <- gets splayer
- advanceTime pl -- TODO: the command handlers should advance the move time
- state <- get
- let time = stime state
- loc = mloc (getPlayerBody state)
- smellTimeout = Config.get (sconfig state) "monsters" "smellTimeout"
- -- update smell
- modify (updateLevel (updateSMap (M.insert loc (time + smellTimeout))))
- -- determine player perception and continue with monster moves
- withPerception handleMonsters
+ -- at this point, the command was successful and possibly took some time
+ newPlayerTime <- gets (mtime . getPlayerBody)
+ if newPlayerTime == oldPlayerTime
+ then withPerception handlePlayer -- no time taken, repeat
+ else do
+ state <- get
+ let time = stime state
+ ploc = mloc (getPlayerBody state)
+ smellTimeout = Config.get (sconfig state) "monsters" "smellTimeout"
+ -- update smell
+ modify (updateLevel (updateSMap (M.insert ploc (time + smellTimeout))))
+ -- determine player perception and continue with monster moves
+ withPerception handleMonsters
-- | Determine and process the next player command.
playerCommand :: Action ()
@@ -234,7 +238,7 @@ stdKeybindings = Keybindings
(K.Char '*', monsterCommand),
(K.Char '/', floorCommand),
(K.Char ':', floorCommand), -- synonym for backward compat.
- (K.Tab , Described "cycle among heroes on level" $ cycleHero >> playerCommand),
+ (K.Tab , heroCommand),
-- items
(K.Char ',', pickupCommand),
@@ -251,7 +255,6 @@ stdKeybindings = Keybindings
-- saving or ending the game
(K.Char 'S', saveCommand),
(K.Char 'Q', quitCommand),
- (K.Esc , cancelCommand),
-- debug modes
(K.Char 'V', Undescribed $ modify toggleVision >> withPerception playerCommand),
@@ -265,6 +268,7 @@ stdKeybindings = Keybindings
(K.Char 'M', historyCommand),
(K.Char 'D', dumpCommand),
(K.Char '?', helpCommand),
- (K.Return , acceptCommand displayHelp)
+ (K.Return , acceptCommand displayHelp),
+ (K.Esc , cancelCommand)
]
}
Please sign in to comment.
Something went wrong with that request. Please try again.