Permalink
Browse files

bugfix: I was not saving some messages to history

Plus rename of the function that wipes out messages so that it's not used
lightly again.
  • Loading branch information...
1 parent 66e9f55 commit d6f80aa342e4e75e20213d85b7c54812ded41c68 @Mikolaj Mikolaj committed Apr 9, 2011
Showing with 59 additions and 66 deletions.
  1. +17 −28 src/Action.hs
  2. +7 −15 src/Actions.hs
  3. +2 −2 src/Display.hs
  4. +26 −14 src/EffectAction.hs
  5. +7 −7 src/ItemAction.hs
View
@@ -89,8 +89,8 @@ overlay :: String -> Action Bool
overlay txt = Action (\ s e p k a st ms -> displayLevel False s p st ms (Just txt) >>= k st ms)
-- | Set the current message.
-message :: Message -> Action ()
-message nm = Action (\ s e p k a st ms -> k st nm ())
+messageWipeAndSet :: Message -> Action ()
+messageWipeAndSet nm = Action (\ s e p k a st ms -> k st nm ())
-- | Add to the current message.
messageAdd :: Message -> Action ()
@@ -151,7 +151,7 @@ debug x = return () -- liftIO $ hPutStrLn stderr x
abortWith :: Message -> Action a
abortWith msg =
do
- message msg
+ messageWipeAndSet msg
display
abort
@@ -163,33 +163,23 @@ abortIfWith :: Bool -> Message -> Action a
abortIfWith True = abortWith
abortIfWith False = const abort
--- | Print message, await confirmation. Return value indicates if the
--- player tried to abort/escape.
-messageMoreConfirm :: Message -> Action Bool
-messageMoreConfirm msg =
- do
- message (msg ++ more)
- display
- session getConfirm
+-- | Print message, await confirmation. Return value indicates
+-- if the player tried to abort/escape.
+messageMoreConfirm :: Bool -> Message -> Action Bool
+messageMoreConfirm blackAndWhite msg = do
+ messageAdd (msg ++ more)
+ if blackAndWhite then displayBW else display
+ session getConfirm
-- | Print message, await confirmation, ignore confirmation.
messageMore :: Message -> Action ()
-messageMore msg = messageMoreConfirm msg >> return ()
-
--- | Add "-more-" to the current message, await confirmation, clear messages.
-messageAddMore :: Action Bool
-messageAddMore = do
- messageAdd (L.tail more) -- delete the space at the start
- display
- b <- session getConfirm
- resetMessage
- return b
+messageMore msg = resetMessage >> messageMoreConfirm False msg >> return ()
-- | Print a yes/no question and return the player's answer.
messageYesNo :: Message -> Action Bool
messageYesNo msg =
do
- message (msg ++ yesno)
+ messageWipeAndSet (msg ++ yesno)
displayBW -- turn player's attention to the choice
session getYesNo
@@ -208,7 +198,7 @@ messageOverlaysConfirm msg [] =
return True
messageOverlaysConfirm msg (x:xs) =
do
- message msg
+ messageWipeAndSet msg
b <- overlay (x ++ more)
if b
then do
@@ -219,11 +209,10 @@ messageOverlaysConfirm msg (x:xs) =
else stop
else stop
where
- stop =
- do
- resetMessage
- display
- return False
+ stop = do
+ resetMessage
+ display
+ return False
-- | Update the cached perception for the given computation.
withPerception :: Action () -> Action ()
View
@@ -217,16 +217,6 @@ ifRunning t e =
mdir <- gets (mdir . getPlayerBody)
maybe e t mdir
--- | Store current message in the history and reset current message.
-history :: Action ()
-history =
- do
- msg <- resetMessage
- config <- gets sconfig
- let historyMax = Config.get config "ui" "historyMax"
- unless (L.null msg) $
- modify (updateHistory (take historyMax . ((msg ++ " "):)))
-
-- | Update player memory.
remember :: Action ()
remember =
@@ -240,7 +230,7 @@ remember =
openclose :: Bool -> Action ()
openclose o =
do
- message "direction?"
+ messageWipeAndSet "direction?"
display
e <- session nextCommand
pl <- gets splayer
@@ -372,7 +362,7 @@ fleeDungeon =
items = L.concatMap mitems (levelHeroList state)
if total == 0
then do
- go <- messageMoreConfirm "Coward!"
+ go <- resetMessage >> messageMoreConfirm False "Coward!"
when go $
messageMore "Next time try to grab some loot before escape!"
end
@@ -533,13 +523,15 @@ moveOrAttack allowAttacks autoOpen actor dir
else if accessible lmap sloc tloc then do
-- Switching positions requires full access.
actorRunActor actor target
- when (actor == pl) $ message $ lookAt False True state lmap tloc ""
+ when (actor == pl) $
+ messageAdd $ lookAt False True state lmap tloc ""
else abort
Nothing ->
if accessible lmap sloc tloc then do
-- perform the move
updateAnyActor actor $ \ m -> m { mloc = tloc }
- when (actor == pl) $ message $ lookAt False True state lmap tloc ""
+ when (actor == pl) $
+ messageAdd $ lookAt False True state lmap tloc ""
advanceTime actor
else if autoOpen then
-- try to open a door
@@ -555,7 +547,7 @@ moveOrAttack allowAttacks autoOpen actor dir
actorAttackActor :: Actor -> Actor -> Action ()
actorAttackActor (AHero _) target@(AHero _) =
-- Select adjacent hero by bumping into him. Takes no time.
- selectPlayer target >> return ()
+ assertTrue $ selectPlayer target
actorAttackActor source target = do
sm <- gets (getActor source)
case strongestItem (mitems sm) "sword" of
View
@@ -65,8 +65,8 @@ displayBlankConfirm session txt =
display ((0, 0), normalLevelSize) session doBlank x ""
getConfirm session
--- | Waits for a space or return or '?' or '*'. The last two to let keys that
--- request (more) information toggle display of the obtained information off.
+-- | Waits for a space or return or '?' or '*'. The last two act this way,
+-- to let keys that request information toggle display the information off.
getConfirm :: MonadIO m => Session -> m Bool
getConfirm session =
getOptionalConfirm return (const $ getConfirm session) session
View
@@ -100,11 +100,12 @@ effectToAction (Effect.Wound nDm) source target power msg = do
effectToAction Effect.Dominate source target power msg =
if isAMonster target -- Monsters have weaker will than heroes.
then do
- b <- selectPlayer target
+ assertTrue $ selectPlayer target
-- Prevent AI from getting a few free moves until new player ready.
updatePlayerBody (\ m -> m { mtime = 0})
stopRunning
- return b
+ display
+ return True
else return False
effectToAction Effect.SummonFriend source target power msg = do
tm <- gets (getActor target)
@@ -121,7 +122,7 @@ effectToAction Effect.SummonEnemy source target power msg = do
effectToAction Effect.ApplyPerfume source target _ _ = do
pl <- gets splayer
if source == pl && target == pl
- then messageAdd "Tastes like water. No good." >>
+ then messageAdd "Tastes like water. No good to drink." >>
return False
else do
let upd lvl = lvl { lsmell = M.map (const (-100)) (lsmell lvl) }
@@ -185,17 +186,18 @@ focusIfAHero target =
then do
-- Focus on the hero being wounded.
b <- selectPlayer target
- -- Extra prompt, in case many heroes wounded in one turn.
- when b $ messageAddMore >> return ()
+ -- Display status line for the new hero.
+ when b $ display >> return ()
else return ()
summonHeroes :: Int -> Loc -> Action ()
summonHeroes n loc =
assert (n > 0) $ do
newHeroIndex <- gets (fst . scounter)
modify (\ state -> iterate (addHero loc) state !! n)
- b <- selectPlayer (AHero newHeroIndex)
- when b $ messageAddMore >> return ()
+ assertTrue $ selectPlayer (AHero newHeroIndex)
+ -- Display status line for the new hero.
+ display >> return ()
summonMonsters :: Int -> Loc -> Action ()
summonMonsters n loc = do
@@ -214,15 +216,16 @@ checkPartyDeath =
pbody <- gets getPlayerBody
config <- gets sconfig
when (mhp pbody <= 0) $ do -- TODO: change to guard? define mzero? Why are the writes to to files performed when I call abort later? That probably breaks the laws of MonadPlus.
- messageAddMore
- go <- messageMoreConfirm $ subjectMovableVerb (mkind pbody) "die" ++ "."
+ go <- messageMoreConfirm True $
+ subjectMovableVerb (mkind pbody) "die" ++ "."
+ history -- Prevent the messages from being repeated.
let firstDeathEnds = Config.get config "heroes" "firstDeathEnds"
if firstDeathEnds
then gameOver go
else case L.filter (\ (actor, _) -> actor /= pl) ahs of
[] -> gameOver go
(actor, _nln) : _ -> do
- message "The survivors carry on."
+ messageAdd "The survivors carry on."
-- Remove the dead player.
modify (deleteActor pl)
-- At this place the invariant that the player exists fails.
@@ -291,12 +294,21 @@ displayItems :: Message -> Bool -> [Item] -> Action Bool
displayItems msg sorted is = do
state <- get
let inv = unlines $
- L.map (\ i ->
- letterLabel (iletter i) ++ objectItem state i ++ " ")
- ((if sorted then sortBy (cmpLetter' `on` iletter) else id) is)
+ L.map (\ i -> letterLabel (iletter i) ++ objectItem state i ++ " ")
+ ((if sorted then sortBy (cmpLetter' `on` iletter) else id) is)
let ovl = inv ++ more
- message msg
+ messageWipeAndSet msg
overlay ovl
stopRunning :: Action ()
stopRunning = updatePlayerBody (\ p -> p { mdir = Nothing })
+
+-- | Store current message in the history and reset current message.
+history :: Action ()
+history =
+ do
+ msg <- resetMessage
+ config <- gets sconfig
+ let historyMax = Config.get config "ui" "historyMax"
+ unless (L.null msg) $
+ modify (updateHistory (take historyMax . ((msg ++ " "):)))
View
@@ -75,7 +75,7 @@ applyGroupItem actor verb item = do
let consumed = item { icount = 1 }
msg = subjectVerbIObject state body verb consumed ""
loc = mloc body
- when (loc `S.member` ptvisible per) $ message msg
+ when (loc `S.member` ptvisible per) $ messageAdd msg
b <- itemEffectAction consumed actor actor
when b $ removeFromInventory actor consumed loc
advanceTime actor
@@ -122,7 +122,7 @@ zapGroupItem source loc verb item = do
modify (updateLevel (dropItemsAt [consumed] loc))
Nothing -> do
let msg = subjectVerbIObject state sm verb consumed ""
- when (sloc `S.member` ptvisible per) $ message msg
+ when (sloc `S.member` ptvisible per) $ messageAdd msg
modify (updateLevel (dropItemsAt [consumed] loc))
advanceTime source
@@ -168,7 +168,7 @@ dropItem = do
case iOpt of
Just i -> do
removeFromInventory pl i (mloc pbody)
- message (subjectVerbIObject state pbody "drop" i "")
+ messageAdd (subjectVerbIObject state pbody "drop" i "")
modify (updateLevel (dropItemsAt [i] ploc))
Nothing -> neverMind True
playerAdvanceTime
@@ -219,9 +219,9 @@ actorPickupItem actor = do
let (ni, nitems) = joinItem (i { iletter = Just l }) (mitems body)
-- message depends on who picks up and if a hero can perceive it
if isPlayer
- then message (letterLabel (iletter ni) ++ objectItem state ni)
+ then messageAdd (letterLabel (iletter ni) ++ objectItem state ni)
else when perceived $
- message $ subjCompoundVerbIObj state body "pick" "up" i ""
+ messageAdd $ subjCompoundVerbIObj state body "pick" "up" i ""
assertTrue $ removeFromLoc i loc
-- add item to actor's inventory:
updateAnyActor actor $ \ m ->
@@ -246,7 +246,7 @@ pickupItem = do
-- that messages are printed to the player only if the
-- hero can perceive the action.
-- Perhaps this means half of this code should be split and moved
--- to ItemState, to be independent of any IO code from Action/Display. Actually, not, since the message dissplay depends on Display. Unless we return a string to be displayed.
+-- to ItemState, to be independent of any IO code from Action/Display. Actually, not, since the message display depends on Display. Unless we return a string to be displayed.
-- | Let the player choose any item from a list of items.
-- TODO: you can drop an item on the floor, which works correctly,
@@ -279,7 +279,7 @@ getItem prompt p ptext is0 isn = do
interact = do
when (L.null is0 && L.null tis) $
abortWith "Not carrying anything."
- message (prompt ++ " " ++ choice)
+ messageWipeAndSet (prompt ++ " " ++ choice)
display
session nextCommand >>= perform
perform command = do

0 comments on commit d6f80aa

Please sign in to comment.