Permalink
Browse files

all monster type data is now in one place

  • Loading branch information...
1 parent d0e9837 commit cf8765ac7a29ba0651d29d0c4a66b2d87431c38a @Mikolaj Mikolaj committed Mar 23, 2011
Showing with 139 additions and 100 deletions.
  1. +13 −10 src/Actions.hs
  2. +8 −1 src/Display/Gtk.hs
  3. +3 −3 src/Display2.hs
  4. +2 −7 src/Grammar.hs
  5. +2 −1 src/HeroState.hs
  6. +94 −51 src/Monster.hs
  7. +12 −9 src/MonsterState.hs
  8. +2 −8 src/Movable.hs
  9. +3 −10 src/StrategyState.hs
View
23 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.
View
9 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"
View
6 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 ""
View
9 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
View
3 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
View
145 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)
View
21 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
View
10 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)
View
13 src/StrategyState.hs
@@ -23,11 +23,7 @@ strategy actor
slevel = Level { lsmell = nsmap,
lmap = lmap } })
per =
- case mt of
- Eye -> slowEye
- FastEye -> fastEye
- Nose -> nose
- _ -> onlyAccessible moveRandomly
+ if nsmell mt then nose else openEye -- TODO: unify the 2 kinds using nsight
where
-- TODO: set monster targets and then prefer targets to other heroes
Movable { mtype = mt, mloc = me, mdir = mdir } = getActor state actor
@@ -60,7 +56,7 @@ strategy actor
-- Monsters don't see doors more secret than that. Enforced when actually
-- opening doors, too, so that monsters don't cheat.
-- TODO: vary the parameter per monster intelligence level.
- onlyOpenable = onlyMoves (openable 10 lmap) me
+ onlyOpenable = onlyMoves (openable (niq mt) lmap) me
smells = L.map fst $
L.sortBy (\ (_,s1) (_,s2) -> compare s2 s1) $
L.filter (\ (_,s) -> s > 0) $
@@ -72,13 +68,10 @@ strategy actor
.| onlyLootPresent moveRandomly
.| onlyPreservesDir moveRandomly
- slowEye = playerAdjacent .=> return towardsPlayer
+ openEye = playerAdjacent .=> return towardsPlayer
.| not playerVisible .=> onlyOpenable eye
.| onlyAccessible eye
- fastEye = playerAdjacent .=> return towardsPlayer
- .| onlyAccessible eye
-
nose = playerAdjacent .=> return towardsPlayer
.| (onlyAccessible $
lootPresent me .=> wait

0 comments on commit cf8765a

Please sign in to comment.