Browse files

rewrite color usage everywhere

TODO: tweak colors a bit and clean up Display2.hs, then differentiate
visited/currently seen/visited dark/illuminated dark dungeon floor.
  • Loading branch information...
1 parent 15c0482 commit f4fa77e4c699f424bc6ab546349319543a6142e3 @Mikolaj Mikolaj committed Mar 23, 2011
Showing with 53 additions and 53 deletions.
  1. +1 −1 src/Display/Gtk.hs
  2. +9 −10 src/Display2.hs
  3. +15 −14 src/Item.hs
  4. +18 −17 src/Level.hs
  5. +2 −2 src/LevelState.hs
  6. +6 −6 src/Monster.hs
  7. +2 −3 src/Version.hs
View
2 src/Display/Gtk.hs
@@ -81,7 +81,7 @@ startup k =
_ -> return False)
let black = Color minBound minBound minBound
- let white = Color maxBound maxBound maxBound
+ white = Color 0xAAAA 0xAAAA 0xAAAA -- White, see below
widgetModifyBase tv StateNormal black
widgetModifyText tv StateNormal white
View
19 src/Display2.hs
@@ -171,10 +171,6 @@ displayLevel session per
gold = maybe 0 (icount . fst) $ findItem (\ i -> iletter i == Just '$') pitems
hs = levelHeroList state
ms = levelMonsterList state
- setFg color = setFG color
- setInv color = if color == white
- then setBG white . setFG black
- else setBG white . setFG color
disp n msg =
display ((0,0),sz) session
(\ loc -> let tile = nlmap `lAt` loc
@@ -183,23 +179,26 @@ displayLevel session per
rea = S.member loc reachable
(rv,ra) = case L.find (\ m -> loc == mloc m) (hs ++ ms) of
_ | sTer > 0 -> viewTerrain sTer False (tterrain tile)
- Just m | sOmn || vis -> let (sym, color) = viewMovable (mtype m) in (sym, (if mloc m == ploc then setInv else setFg) color)
+ Just m | sOmn || vis -> let (sym, color) = viewMovable (mtype m) in (sym, if mloc m == ploc then black else color)
_ | sSml && sml >= 0 -> viewSmell sml
| otherwise -> viewTile vis tile assocs
- vision =
+ (vision, ra2) =
if ctargeting (scursor state)
&& loc == clocation (scursor state)
- then setBG white . setFG black
- else lVision vis rea
+ then (setBG white,
+ if ra == white then black else ra)
+ else if ra == black
+ then (setBG white, ra)
+ else (lVision vis rea, ra)
in
case over (loc `shift` ((sy+1) * n, 0)) of
Just c -> (attr, c)
- _ -> (vision . ra $ attr, rv))
+ _ -> (vision . setFG ra2 $ attr, rv))
msg
(take 40 (levelName nm ++ repeat ' ') ++
take 10 ("$: " ++ show gold ++ repeat ' ') ++
take 15 ("HP: " ++ show php ++ " (" ++ show phpmax ++ ")" ++ repeat ' ') ++
- take 10 ("T: " ++ show (time `div` 10) ++ repeat ' '))
+ take 15 ("T: " ++ show (time `div` 10) ++ repeat ' '))
msgs = splitMsg sx msg
perf k [] = perfo k ""
perf k [xs] = perfo k xs
View
29 src/Item.hs
@@ -11,7 +11,7 @@ import Data.Char
import Data.Function
import Control.Monad
-import Display
+import qualified Display
import Geometry
import Random
@@ -201,21 +201,22 @@ letterLabel :: Maybe Char -> String
letterLabel Nothing = " "
letterLabel (Just c) = c : " - "
-viewItem :: ItemType -> Assocs -> (Char, Attr -> Attr)
+viewItem :: ItemType -> Assocs -> (Char, Display.AttrColor)
viewItem i a = viewItem' i (M.lookup i a)
where
- viewItem' (Sword {}) _ = (')', id)
- viewItem' Dart _ = (')', id)
- viewItem' Ring _ = ('=', id)
- viewItem' Scroll _ = ('?', id)
- viewItem' (Potion {}) (Just Clear) = ('!', setFG bright_blue)
- viewItem' (Potion {}) (Just White) = ('!', setFG bright_white)
- viewItem' (Potion {}) _ = ('!', id)
- viewItem' Wand _ = ('/', id)
- viewItem' Gold _ = ('$', setFG bright_yellow)
- viewItem' Gem _ = ('*', setFG bright_magenta)
- viewItem' Amulet _ = ('"', id)
- viewItem' _ _ = ('~', id)
+ wh = Display.white
+ viewItem' (Sword {}) _ = (')', wh)
+ viewItem' Dart _ = (')', wh)
+ viewItem' Ring _ = ('=', wh)
+ viewItem' Scroll _ = ('?', wh)
+ viewItem' (Potion {}) (Just Clear) = ('!', Display.bright_blue)
+ viewItem' (Potion {}) (Just White) = ('!', Display.bright_cyan)
+ viewItem' (Potion {}) _ = ('!', wh)
+ viewItem' Wand _ = ('/', wh)
+ viewItem' Gold _ = ('$', Display.bright_yellow)
+ viewItem' Gem _ = ('*', Display.bright_magenta)
+ viewItem' Amulet _ = ('"', wh)
+ viewItem' _ _ = ('~', wh)
-- | Adds an item to a list of items, joining equal items.
-- Also returns the joined item.
View
35 src/Level.hs
@@ -17,7 +17,7 @@ import Geometry
import Movable
import Item
import Random
-import Display
+import qualified Display
-- | Names of the dungeon levels are represented using a
-- custom data structure.
@@ -506,6 +506,7 @@ lookTerrain (Door _ (Just _)) = "A wall." -- secret
lookTerrain (Wall _ ) = "A wall."
lookTerrain _ = ""
+wh = Display.white
-- | The parameter "n" is the level of evolution:
--
-- 0: final
@@ -515,42 +516,42 @@ lookTerrain _ = ""
-- 4: only rooms
--
-- The Bool indicates whether the loc is currently visible.
-viewTerrain :: Int -> Bool -> Terrain -> (Char, Attr -> Attr)
-viewTerrain n b Rock = (' ', id)
+viewTerrain :: Int -> Bool -> Terrain -> (Char, Display.AttrColor)
+viewTerrain n b Rock = (' ', wh)
viewTerrain n b (Opening d)
- | n <= 3 = ('.', id)
+ | n <= 3 = ('.', wh)
| otherwise = viewTerrain 0 b (Wall d)
-viewTerrain n b (Floor Light) = ('.', id)
-viewTerrain n b (Floor Dark) = if b then ('.', id) else (' ', id)
-viewTerrain n b Unknown = (' ', id)
+viewTerrain n b (Floor Light) = ('.', wh)
+viewTerrain n b (Floor Dark) = if b then ('.', wh) else (' ', wh)
+viewTerrain n b Unknown = (' ', wh)
viewTerrain n b Corridor
- | n <= 3 = ('#', id)
+ | n <= 3 = ('#', wh)
| otherwise = viewTerrain 0 b Rock
viewTerrain n b (Wall p)
- | p == O = ('O', id)
- | p `elem` [L, R] = ('|', id)
- | otherwise = ('-', id)
+ | p == O = ('O', wh)
+ | p `elem` [L, R] = ('|', wh)
+ | otherwise = ('-', wh)
viewTerrain n b (Stairs _ Up _)
- | n <= 1 = ('<', id)
+ | n <= 1 = ('<', wh)
| otherwise = viewTerrain 0 b (Floor Dark)
viewTerrain n b (Stairs _ Down _)
- | n <= 1 = ('>', id)
+ | n <= 1 = ('>', wh)
| otherwise = viewTerrain 0 b (Floor Dark)
viewTerrain n b (Door d (Just 0))
- | n <= 2 = ('+', setFG yellow)
+ | n <= 2 = ('+', Display.yellow)
| otherwise = viewTerrain n b (Opening d)
viewTerrain n b (Door d (Just _))
| n <= 2 = viewTerrain n b (Wall d) -- secret door
| otherwise = viewTerrain n b (Opening d)
viewTerrain n b (Door p Nothing)
- | n <= 2 = (if p `elem` [L, R] then '-' else '|', setFG yellow)
+ | n <= 2 = (if p `elem` [L, R] then '-' else '|', Display.yellow)
| otherwise = viewTerrain n b (Opening p)
-viewSmell :: Int -> (Char, Attr -> Attr)
+viewSmell :: Int -> (Char, Display.AttrColor)
viewSmell n = let k | n > 9 = '*'
| n < 0 = '-'
| otherwise = head . show $ n
- in (k, setFG black . setBG green)
+ in (k, Display.green)
-- TODO: Really scatter around, if more than one or location occupied?
-- Scatter randomly or not?
View
4 src/LevelState.hs
@@ -1,14 +1,14 @@
module LevelState where
-import Display
+import qualified Display
import Geometry
import Level
import State
import Item
import ItemState
import Grammar
-viewTile :: Bool -> Tile -> Assocs -> (Char, Attr -> Attr)
+viewTile :: Bool -> Tile -> Assocs -> (Char, Display.AttrColor)
viewTile b (Tile t []) a = viewTerrain 0 b t
viewTile b (Tile t (i:_)) a = viewItem (itype i) a
View
12 src/Monster.hs
@@ -5,7 +5,7 @@ import Control.Monad
import Geometry
import Random
-import Display
+import qualified Display
-- TODO: move _all_ monster data here from Grammar.hs, etc.
@@ -46,11 +46,11 @@ newMonster template loc ftp =
speed Nose = 11
-- Heroes are white, monsters are colorful.
-viewMovable :: MovableType -> (Char, AttrColor)
-viewMovable (Hero sym _) = (sym, white)
-viewMovable Eye = ('e', red)
-viewMovable FastEye = ('e', blue)
-viewMovable Nose = ('n', green)
+viewMovable :: MovableType -> (Char, Display.AttrColor)
+viewMovable (Hero sym _) = (sym, Display.bright_white)
+viewMovable Eye = ('e', Display.bright_red)
+viewMovable FastEye = ('e', Display.bright_blue)
+viewMovable Nose = ('n', Display.green)
instance Binary MovableType where
put (Hero symbol name) = putWord8 0 >> put symbol >> put name
View
5 src/Version.hs
@@ -5,8 +5,7 @@ import Data.Version
-- Cabal
import qualified Paths_LambdaHack as Self (version)
-import Display
+import qualified Display
version :: String
-version = showVersion Self.version ++ " (" ++ displayId ++ " frontend)"
-
+version = showVersion Self.version ++ " (" ++ Display.displayId ++ " frontend)"

0 comments on commit f4fa77e

Please sign in to comment.