all monster type data is now in one place

src/Actions.hs

@@ -24,6 +24,7 @@ import LevelState
 import Message
 import Movable
 import MovableState
+import Monster
 import MonsterState
 import Perception
 import Random
@@ -302,15 +303,16 @@ actorOpenClose actor v o dir =
     pl    <- gets splayer
     let txt = if o then "open" else "closed"
     let hms = levelHeroList state ++ levelMonsterList state
-    let loc = mloc (getActor state actor)
+    let body = getActor state actor  -- TODO: swap args of getActor, for gets
+    let loc = mloc body
     let isPlayer  = actor == pl
     let isVerbose = v && isPlayer
     let dloc = shift loc dir  -- location we act upon
       in case lmap `at` dloc of
            Tile d@(Door hv o') []
              | secret o' && isPlayer -> -- door is secret, cannot be opened or closed by the player
                                        neverMind isVerbose
-             | maybe o ((|| not o) . (> 10)) o' ->
+             | maybe o ((|| not o) . (> (niq (mtype body)))) o' ->
                                        -- door is in unsuitable state
                                        abortIfWith isVerbose ("already " ++ txt)
              | not (unoccupied hms dloc) ->
@@ -641,7 +643,8 @@ drinkPotion =
                      PotionWater   -> messageAdd "Tastes like water."
                      PotionHealing -> do
                        messageAdd "You feel better."
-                       let php p = min (mhpmax p) (mhp p + baseHp `div` 4)
+                       let php p =
+                             min (nhpMax (mtype p)) (mhp p + baseHp `div` 4)
                        updatePlayerBody (\ p -> p { mhp = php p })
                Just _  -> abortWith "you cannot drink that"
                Nothing -> neverMind True
@@ -694,7 +697,7 @@ dropItem :: Action ()
 dropItem =
   do
     state <- get
-    pbody  <- gets getPlayerBody
+    pbody <- gets getPlayerBody
     ploc <- gets (mloc . getPlayerBody)
     items <- gets (mitems . getPlayerBody)
     if L.null items
@@ -971,7 +974,7 @@ advanceTime :: Actor -> Action ()
 advanceTime actor =
   do
     time <- gets stime
-    updateAnyActor actor $ \ m -> m { mtime = time + mspeed m }
+    updateAnyActor actor $ \ m -> m { mtime = time + (nspeed (mtype m)) }
 
 playerAdvanceTime :: Action ()
 playerAdvanceTime = do
@@ -982,11 +985,11 @@ playerAdvanceTime = do
 regenerate :: Actor -> Action ()
 regenerate actor =
   do
-    pl   <- gets splayer
-    time <- gets stime
-    -- TODO: remove hardcoded time interval, regeneration should be an attribute of the movable
-    let upd m = m { mhp = min (mhpmax m) (mhp m + 1) }
-    when (time `mod` 1500 == 0) $ do
+    pl    <- gets splayer
+    pbody <- gets getPlayerBody
+    time  <- gets stime
+    let upd m = m { mhp = min (nhpMax (mtype m)) (mhp m + 1) }
+    when (time `mod` (nregen (mtype pbody)) == 0) $ do
       -- We really want hero selection to be a purely UI distinction,
       -- so all heroes need to regenerate, not just the player.
       -- TODO: currently only the heroes on the current level regenerate.

src/Display/Gtk.hs

@@ -6,6 +6,7 @@ module Display.Gtk
    bright_blue, bright_magenta, bright_cyan, bright_white,
    Attr, AttrColor) where
 
+import qualified Data.Binary
 import Control.Monad
 import Control.Concurrent
 import Graphics.UI.Gtk.Gdk.Events  -- TODO: replace, deprecated
@@ -193,7 +194,7 @@ doAttr :: TextTag -> AttrKey -> IO ()
 doAttr tt (FG color) = set tt [ textTagForeground := colorToRGB color ]
 doAttr tt (BG color) = set tt [ textTagBackground := colorToRGB color ]
 
-data AttrColor =
+data AttrColor =  -- TODO: move and use in vty, too
     Black
   | Red
   | Green
@@ -212,6 +213,12 @@ data AttrColor =
   | BrWhite
   deriving (Show, Eq, Ord, Enum, Bounded)
 
+instance Data.Binary.Binary AttrColor where
+  put c = Data.Binary.putWord8 $ toEnum $ fromEnum c
+  get = do
+    c <- Data.Binary.getWord8
+    return $ toEnum $ fromEnum c
+
 -- Mimics the Linux console; good old retro feel and more useful than xterm.
 colorToRGB :: AttrColor -> String
 colorToRGB Black     = "#000000"

src/Display2.hs

@@ -150,7 +150,7 @@ displayLevel session per
                              sassocs = assocs,
                              slevel  = lvl@(Level nm hs sz@(sy,sx) ms smap nlmap lmeta) }))
              msg moverlay =
-  let Movable { mhpmax = phpmax, mhp = php, mdir = pdir,
+  let Movable { mtype = mt, mhp = php, mdir = pdir,
                 mloc = ploc, mitems = pitems } =
         getPlayerBody state
       overlay = maybe "" id moverlay
@@ -179,7 +179,7 @@ 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 black else color)
+                                           Just m | sOmn || vis  -> (nsymbol (mtype m), if mloc m == ploc then black else (ncolor (mtype m)))
                                            _ | sSml && sml >= 0  -> viewSmell sml
                                              | otherwise         -> viewTile vis tile assocs
                                (vision, ra2) =
@@ -197,7 +197,7 @@ displayLevel session per
                 msg
                 (take 40 (levelName nm ++ repeat ' ') ++
                  take 10 ("$: " ++ show gold ++ repeat ' ') ++
-                 take 15 ("HP: " ++ show php ++ " (" ++ show phpmax ++ ")" ++ repeat ' ') ++
+                 take 15 ("HP: " ++ show php ++ " (" ++ show (nhpMax mt) ++ ")" ++ repeat ' ') ++
                  take 15 ("T: " ++ show (time `div` 10) ++ repeat ' '))
       msgs = splitMsg sx msg
       perf k []     = perfo k ""

src/Grammar.hs

@@ -10,19 +10,14 @@ import ItemState
 
 -- | How to refer to a movable in object position of a sentence.
 objectMovable :: MovableType -> String
-objectMovable (Hero _ s) = s
-objectMovable Eye        = "the reducible eye"
-objectMovable FastEye    = "the super-fast eye"
-objectMovable Nose       = "the point-free nose"
+objectMovable mt = nname mt
 
 -- | How to refer to a movable in subject position of a sentence.
 subjectMovable :: MovableType -> String
 subjectMovable x = let (s:r) = objectMovable x in toUpper s : r
 
 verbMovable :: MovableType -> String -> String
-verbMovable (Hero _ "you") v = v
-verbMovable (Hero _ s)     v = v ++ "s"
-verbMovable _              v = v ++ "s"
+verbMovable mt v = if nname mt == "you" then v else v ++ "s"
 
 -- | Sentences such like "The dog barks".
 subjectMovableVerb :: MovableType -> String -> String

src/HeroState.hs

@@ -15,7 +15,8 @@ import State
 
 templateHero :: Char -> String -> Loc -> Int -> Movable
 templateHero symbol name ploc hp =
-  Movable (Hero symbol name) hp hp Nothing TCursor ploc [] 'a' 10 0
+  let mt = hero {nhpMin = hp, nhpMax = hp, nsymbol = symbol, nname = name }
+  in  Movable mt hp Nothing TCursor ploc [] 'a' 0
 
 -- | Create a new hero on the current level, close to the given location.
 addHero :: Loc -> Int -> String -> State -> Int -> State

src/Monster.hs

@@ -7,61 +7,104 @@ import Geometry
 import Random
 import qualified Display
 
--- TODO: move _all_ monster data here from Grammar.hs, etc.
-
-data MovableType =
-    Hero Char String
-  | Eye
-  | FastEye
-  | Nose
+data MovableType = MovableType
+  { nhpMin   :: !Int,                -- ^ minimal initial hp
+    nhpMax   :: !Int,                -- ^ maximal possible and initial hp
+    nspeed   :: !Time,               -- ^ natural speed
+    nsymbol  :: !Char,               -- ^ map symbol
+    ncolor   :: !Display.AttrColor,  -- ^ map color
+    nname    :: String,              -- ^ name
+    nsight   :: !Bool,               -- ^ can it see?
+    nsmell   :: !Bool,               -- ^ can it smell?
+    niq      :: !Int,                -- ^ intelligence
+    nregen   :: !Int,                -- ^ regeneration interval
+    nfreq    :: !Int                 -- ^ dungeon frequency
+  }
   deriving (Show, Eq)
 
--- | Monster frequencies (TODO: should of course vary much more
--- on local circumstances).
-monsterFrequency :: Frequency MovableType
-monsterFrequency =
-  Frequency
-  [
-    (2, Nose),
-    (6, Eye),
-    (1, FastEye)
-  ]
-
--- | Generate monster.
-newMonster :: (MovableType -> Int -> Loc -> Int -> a) ->
-              Loc -> Frequency MovableType -> Rnd a
-newMonster template loc ftp =
-    do
-      tp <- frequency ftp
-      hp <- hps tp
-      let s = speed tp
-      return (template tp hp loc s)
-  where
-    hps Eye      = randomR (1,12)  -- falls in 1--4 unarmed rounds
-    hps FastEye  = randomR (1,6)   -- 1--2
-    hps Nose     = randomR (6,13)  -- 2--5 and in 1 round of the strongest sword
+hero, eye, fastEye, nose :: MovableType
+hero = MovableType
+  { nhpMin  = 50,
+    nhpMax  = 50,
+    nspeed  = 10,
+    nsymbol = '@',
+    nname   = "you",
+    ncolor  = Display.bright_white,  -- Heroes white, monsters colorful.
+    nsight  = True,
+    nsmell  = False,
+    niq     = 13,  -- Can see that secret doors under alien control.
+    nregen  = 1500,
+    nfreq   = 0
+  }
 
-    speed Eye      = 10
-    speed FastEye  = 4
-    speed Nose     = 11
+eye = MovableType
+  { nhpMin  = 1,  -- falls in 1--4 unarmed rounds
+    nhpMax  = 12,
+    nspeed  = 10,
+    nsymbol = 'e',
+    ncolor  = Display.bright_red,
+    nname   = "the reducible eye",
+    nsight  = True,
+    nsmell  = False,
+    niq     = 10,
+    nregen  = 1500,
+    nfreq   = 6
+  }
+fastEye = MovableType
+  { nhpMin  = 1,  -- falls in 1--2 unarmed rounds
+    nhpMax  = 6,
+    nspeed  = 4,
+    nsymbol = 'e',
+    ncolor  = Display.bright_blue,
+    nname   = "the super-fast eye",
+    nsight  = True,
+    nsmell  = False,
+    niq     = 3,
+    nregen  = 1500,
+    nfreq   = 1
+  }
+nose = MovableType
+  { nhpMin  = 6,  -- 2--5 and in 1 round of the strongest sword
+    nhpMax  = 13,
+    nspeed  = 11,
+    nsymbol = 'n',
+    ncolor  = Display.green,
+    nname   = "the point-free nose",
+    nsight  = False,
+    nsmell  = True,
+    niq     = 0,
+    nregen  = 1500,
+    nfreq   = 6
+  }
 
--- Heroes are white, monsters are colorful.
-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)
+-- | The list of types of monster that appear randomly throughout the dungeon.
+roamingMts :: [MovableType]
+roamingMts = [eye, fastEye, nose]
 
 instance Binary MovableType where
-  put (Hero symbol name) = putWord8 0 >> put symbol >> put name
-  put Eye                = putWord8 1
-  put FastEye            = putWord8 2
-  put Nose               = putWord8 3
+  put (MovableType nhpMin nhpMax nsp nsym ncol nnm nsi nsm niq nreg nfreq) =
+    do
+      put nhpMin
+      put nhpMax
+      put nsp
+      put nsym
+      put ncol
+      put nnm
+      put nsi
+      put nsm
+      put niq
+      put nreg
+      put nfreq
   get = do
-          tag <- getWord8
-          case tag of
-            0 -> liftM2 Hero get get
-            1 -> return Eye
-            2 -> return FastEye
-            3 -> return Nose
-            _ -> fail "no parse (MovableType)"
+    nhpMin <- get
+    nhpMax <- get
+    nsp    <- get
+    nsym   <- get
+    ncol   <- get
+    nnm    <- get
+    nsi    <- get
+    nsm    <- get
+    niq    <- get
+    nreg   <- get
+    nfreq  <- get
+    return (MovableType nhpMin nhpMax nsp nsym ncol nnm nsi nsm niq nreg nfreq)

src/MonsterState.hs

@@ -18,9 +18,10 @@ import Random
 -- move immediately after generation; this does not seem like
 -- a bad idea, but it would certainly be "more correct" to set
 -- the time to the creation time instead
-templateMonster :: MovableType -> Int -> Loc -> Int -> Movable
-templateMonster tp hp loc s =
-  Movable tp hp hp Nothing TCursor loc [] 'a' s 0
+templateMonster :: MovableType -> Loc -> Rnd Movable
+templateMonster mt loc = do
+  hp <- randomR (nhpMin mt, nhpMax mt)
+  return $ Movable mt hp Nothing TCursor loc [] 'a' 0
 
 newMonsterIndex :: State -> Int
 newMonsterIndex (State { slevel = lvl, sdungeon = Dungeon m }) =
@@ -43,11 +44,13 @@ addMonster state@(State { slevel = lvl }) = do
         -- visible by the player (if possible -- not possible for bigrooms)
         -- levels with few rooms are dangerous, because monsters may spawn
         -- in adjacent and unexpected places
-        sm <- findLocTry 1000 lvl
-              (\ l t -> open t
-                        && not (l `L.elem` L.map mloc (hs ++ ms)))
-              (\ l t -> floor t
-                        && L.all (\pl -> distance (mloc pl, l) > 400) hs)
-        m <- newMonster templateMonster sm monsterFrequency
+        loc <- findLocTry 1000 lvl
+               (\ l t -> open t
+                         && not (l `L.elem` L.map mloc (hs ++ ms)))
+               (\ l t -> floor t
+                         && L.all (\ pl -> distance (mloc pl, l) > 400) hs)
+        let fmt = Frequency $ L.zip (L.map nfreq roamingMts) roamingMts
+        mt <- frequency fmt
+        m  <- templateMonster mt loc
         return (updateMonsters (IM.insert ni m) lvl)
     else return lvl

src/Movable.hs

@@ -9,43 +9,37 @@ import Monster
 
 data Movable = Movable
                 { mtype   :: !MovableType,
-                  mhpmax  :: !Int,
                   mhp     :: !Int,
                   mdir    :: Maybe Dir,  -- for monsters: the dir the monster last moved; TODO: use target for this, instead and use mdir to signal the monster wants to switch position with a hero (if the monster is smart/big enough)
                                          -- for heroes: the dir the hero is running
                   mtarget :: Target,
                   mloc    :: !Loc,
                   mitems  :: [Item],     -- inventory
                   mletter :: !Char,      -- next inventory letter
-                  mspeed  :: !Time,      -- speed (i.e., delay before next action)
                   mtime   :: !Time }     -- time of next action
   deriving Show
 
 instance Binary Movable where
-  put (Movable mt mhpm mhp md tgt ml minv mletter mspeed mtime) =
+  put (Movable mt mhp md tgt ml minv mletter mtime) =
     do
       put mt
-      put mhpm
       put mhp
       put md
       put tgt
       put ml
       put minv
       put mletter
-      put mspeed
       put mtime
   get = do
           mt      <- get
-          mhpm    <- get
           mhp     <- get
           md      <- get
           tgt     <- get
           ml      <- get
           minv    <- get
           mletter <- get
-          mspeed  <- get
           mtime   <- get
-          return (Movable mt mhpm mhp md tgt ml minv mletter mspeed mtime)
+          return (Movable mt mhp md tgt ml minv mletter mtime)
 
 data Actor = AHero Int     -- ^ hero index (on the lheroes intmap)
            | AMonster Int  -- ^ monster index (on the lmonsters intmap)