Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

BW mode (implement #11 (comment))

  • Loading branch information...
commit 7f49100aadcb7486912ecaec02d1cab68c34c15a 1 parent 35e6bbd
@Mikolaj Mikolaj authored
View
26 src/Action.hs
@@ -73,21 +73,17 @@ session f = Action (\ s e p k a st ms -> runAction (f s) s e p k a st ms)
sessionIO :: (Session -> IO a) -> Action a
sessionIO f = Action (\ s e p k a st ms -> f s >>= k st ms)
--- | Display the current level, without any message.
-displayWithoutMessage :: Action Bool
-displayWithoutMessage = Action (\ s e p k a st ms -> displayLevel False s p st "" Nothing >>= k st ms)
+-- | Display the current level with modified current message.
+displayGeneric :: ColorMode -> (String -> String) -> Action Bool
+displayGeneric dm f = Action (\ s e p k a st ms -> displayLevel dm s p st (f ms) Nothing >>= k st ms)
--- | Display the current level, with the current message.
+-- | Display the current level, with the current message and color. Most common.
display :: Action Bool
-display = Action (\ s e p k a st ms -> displayLevel False s p st ms Nothing >>= k st ms)
-
--- | Display the current level in black and white, and the current message,
-displayBW :: Action Bool
-displayBW = Action (\ s e p k a st ms -> displayLevel True s p st ms Nothing >>= k st ms)
+display = displayGeneric ColorFull id
-- | Display an overlay on top of the current screen.
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)
+overlay txt = Action (\ s e p k a st ms -> displayLevel ColorFull s p st ms (Just txt) >>= k st ms)
-- | Set the current message.
messageWipeAndSet :: Message -> Action ()
@@ -165,21 +161,21 @@ abortIfWith False _ = abortWith ""
-- | Print message, await confirmation. Return value indicates
-- if the player tried to abort/escape.
-messageMoreConfirm :: Bool -> Message -> Action Bool
-messageMoreConfirm blackAndWhite msg = do
+messageMoreConfirm :: ColorMode -> Message -> Action Bool
+messageMoreConfirm dm msg = do
messageAdd (msg ++ more)
- if blackAndWhite then displayBW else display
+ displayGeneric dm id
session getConfirm
-- | Print message, await confirmation, ignore confirmation.
messageMore :: Message -> Action ()
-messageMore msg = resetMessage >> messageMoreConfirm False msg >> return ()
+messageMore msg = resetMessage >> messageMoreConfirm ColorFull msg >> return ()
-- | Print a yes/no question and return the player's answer.
messageYesNo :: Message -> Action Bool
messageYesNo msg = do
messageWipeAndSet (msg ++ yesno)
- displayBW -- turn player's attention to the choice
+ displayGeneric ColorBW id -- turn player's attention to the choice
session getYesNo
-- | Print a message and an overlay, await confirmation. Return value
View
2  src/Actions.hs
@@ -369,7 +369,7 @@ fleeDungeon =
items = L.concatMap mitems (levelHeroList state)
if total == 0
then do
- go <- resetMessage >> messageMoreConfirm False "Coward!"
+ go <- resetMessage >> messageMoreConfirm ColorFull "Coward!"
when go $
messageMore "Next time try to grab some loot before escape!"
end
View
13 src/Display.hs
@@ -116,10 +116,13 @@ stringByLocation sy xs =
in
(k, \ (y,x) -> M.lookup y m >>= \ n -> M.lookup x n)
+data ColorMode = ColorFull | ColorBW
+
displayLevel ::
- Bool -> Session -> Perceptions -> State -> Message -> Maybe String -> IO Bool
+ ColorMode -> Session -> Perceptions -> State -> Message -> Maybe String
+ -> IO Bool
displayLevel
- blackAndWhite session per
+ dm session per
(state@(State { scursor = cursor,
stime = time,
sassocs = assocs,
@@ -180,9 +183,9 @@ displayLevel
else if bg == Color.defFG && fg == Color.defFG
then reverseVideo
else (fg, bg)
- a = if blackAndWhite
- then Color.defaultAttr
- else optVisually (fg, bg)
+ a = case dm of
+ ColorBW -> Color.defaultAttr
+ ColorFull -> optVisually (fg, bg)
in case over (loc `shift` ((sy+1) * n, 0)) of
Just c -> (Color.defaultAttr, c)
_ -> (a, char)
View
2  src/EffectAction.hs
@@ -227,7 +227,7 @@ 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.
- go <- messageMoreConfirm True $
+ go <- messageMoreConfirm ColorBW $
subjectMovableVerb (mkind pbody) "die" ++ "."
history -- Prevent the messages from being repeated.
let firstDeathEnds = Config.get config "heroes" "firstDeathEnds"
View
4 src/Turn.hs
@@ -75,7 +75,9 @@ handle =
-- monsters can be traced on the map; we disable this functionality if the
-- player is currently running, as it would slow down the running process
-- unnecessarily
- ifRunning (const $ return True) displayWithoutMessage
+ ifRunning
+ (const $ return True)
+ (displayGeneric ColorFull (const ""))
handleMonsters
else do
handlePlayer -- it's the hero's turn!
Please sign in to comment.
Something went wrong with that request. Please try again.