Permalink
Browse files

rename Movable type to Actor and lots of related renames

(2/2) of #11 (comment)
  • Loading branch information...
1 parent a72f566 commit 22d655351b297db0c852420a8c9ee9ce59ff3379 @Mikolaj Mikolaj committed Aug 16, 2011
View
6 LambdaHack.cabal
@@ -25,14 +25,14 @@ flag vty
executable LambdaHack
main-is: Main.hs
hs-source-dirs:src
- other-modules: Action, Actions, Color, Command, Config, ConfigDefault,
+ other-modules: Action, Actions, ActorAdd, ActorKind, Actor, ActorState,
+ Color, Command, Config, ConfigDefault,
Display, Dungeon, DungeonState, Effect, EffectAction, File,
FOV, FOV.Common, FOV.Digital, FOV.Permissive, FOV.Shadow,
Frequency, Geometry, GeometryRnd, Grammar,
HighScores, Item, ItemKind, ItemAction,
Keys, Keybindings, Level, LevelState,
- Main, Message, MovableAdd, MovableKind, Movable, MovableState,
- Multiline, Perception, Random,
+ Main, Message, Multiline, Perception, Random,
Save, State, Strategy, StrategyState,
Turn, Terrain, Version
build-depends: base >= 4 && < 5, containers >= 0.1 && < 1,
View
12 src/Action.hs
@@ -12,9 +12,9 @@ import Display hiding (display)
import Message
import State
import Level
-import Movable
-import MovableState
-import MovableKind
+import Actor
+import ActorState
+import ActorKind
import qualified Save
newtype Action a = Action
@@ -228,10 +228,10 @@ checkCursor h = do
then h
else abortWith "this command does not work on remote levels"
-updateAnyActor :: ActorId -> (Movable -> Movable) -> Action ()
+updateAnyActor :: ActorId -> (Actor -> Actor) -> Action ()
updateAnyActor actor f = modify (updateAnyActorBody actor f)
-updatePlayerBody :: (Movable -> Movable) -> Action ()
+updatePlayerBody :: (Actor -> Actor) -> Action ()
updatePlayerBody f = do
pl <- gets splayer
updateAnyActor pl f
@@ -240,7 +240,7 @@ updatePlayerBody f = do
advanceTime :: ActorId -> Action ()
advanceTime actor = do
time <- gets stime
- let upd m = m { mtime = time + (nspeed (mkind m)) }
+ let upd m = m { atime = time + (bspeed (akind m)) }
-- A hack to synchronize the whole party:
pl <- gets splayer
if (actor == pl || isAHero actor)
View
110 src/Actions.hs
@@ -22,10 +22,10 @@ import qualified Keys as K
import Level
import LevelState
import Message
-import Movable
-import MovableState
-import MovableKind
-import MovableAdd
+import Actor
+import ActorState
+import ActorKind
+import ActorAdd
import Perception
import Random
import State
@@ -82,31 +82,31 @@ quitGame =
endTargeting :: Bool -> Action ()
endTargeting accept = do
returnLn <- gets (creturnLn . scursor)
- target <- gets (mtarget . getPlayerBody)
+ target <- gets (atarget . getPlayerBody)
cloc <- gets (clocation . scursor)
lvlSwitch returnLn -- return to the original level of the player
modify (updateCursor (\ c -> c { ctargeting = False }))
let isEnemy = case target of TEnemy _ _ -> True ; _ -> False
when (not isEnemy) $
if accept
- then updatePlayerBody (\ p -> p { mtarget = TLoc cloc })
- else updatePlayerBody (\ p -> p { mtarget = TCursor })
+ then updatePlayerBody (\ p -> p { atarget = TLoc cloc })
+ else updatePlayerBody (\ p -> p { atarget = TCursor })
endTargetingMsg
endTargetingMsg :: Action ()
endTargetingMsg = do
- pkind <- gets (mkind . getPlayerBody)
- target <- gets (mtarget . getPlayerBody)
+ pkind <- gets (akind . getPlayerBody)
+ target <- gets (atarget . getPlayerBody)
state <- get
let verb = "target"
targetMsg = case target of
TEnemy a _ll ->
case findActorAnyLevel a state of
- Just (_, m) -> objectMovable (mkind m)
+ Just (_, m) -> objectActor (akind m)
Nothing -> "a long gone adversary"
TLoc loc -> "location " ++ show loc
TCursor -> "current cursor position continuously"
- messageAdd $ subjectMovableVerb pkind verb ++ " " ++ targetMsg ++ "."
+ messageAdd $ subjectActorVerb pkind verb ++ " " ++ targetMsg ++ "."
-- | Cancel something, e.g., targeting mode, resetting the cursor
-- to the position of the player. Chosen target is not invalidated.
@@ -149,7 +149,7 @@ run dir = do
if targeting
then moveCursor dir 10
else do
- updatePlayerBody (\ p -> p { mdir = Just dir })
+ updatePlayerBody (\ p -> p { adir = Just dir })
-- attacks and opening doors disallowed while running
moveOrAttack False False pl dir
@@ -160,7 +160,7 @@ continueRun :: Dir -> Action ()
continueRun dir =
do
state <- get
- loc <- gets (mloc . getPlayerBody)
+ loc <- gets (aloc . getPlayerBody)
per <- currentPerception
msg <- currentMessage
ms <- gets (lmonsters . slevel)
@@ -170,12 +170,12 @@ continueRun dir =
let dms = case pl of
AMonster n -> IM.delete n ms -- don't be afraid of yourself
AHero _ -> ms
- mslocs = S.fromList (L.map mloc (IM.elems dms))
+ mslocs = S.fromList (L.map aloc (IM.elems dms))
monstersVisible = not (S.null (mslocs `S.intersection` ptvisible per))
newsReported = not (L.null msg)
t = lmap `at` loc -- tile at current location
itemsHere = not (L.null (titems t))
- heroThere = L.elem (loc `shift` dir) (L.map mloc (IM.elems hs))
+ heroThere = L.elem (loc `shift` dir) (L.map aloc (IM.elems hs))
dirOK = accessible lmap loc (loc `shift` dir)
-- What happens next is mostly depending on the terrain we're currently on.
let exit (Stairs {}) = True
@@ -214,8 +214,8 @@ continueRun dir =
ifRunning :: (Dir -> Action a) -> Action a -> Action a
ifRunning t e =
do
- mdir <- gets (mdir . getPlayerBody)
- maybe e t mdir
+ adir <- gets (adir . getPlayerBody)
+ maybe e t adir
-- | Update player memory.
remember :: Action ()
@@ -248,13 +248,13 @@ actorOpenClose actor v o dir =
body <- gets (getActor actor)
let txt = if o then "open" else "closed"
let hms = levelHeroList state ++ levelMonsterList state
- let loc = mloc body
+ let loc = aloc body
let isPlayer = actor == pl
let isVerbose = v && isPlayer
let dloc = shift loc dir -- location we act upon
- let openPower = case strongestItem (mitems body) "ring" of
- Just i -> niq (mkind body) + ipower i
- Nothing -> niq (mkind body)
+ let openPower = case strongestItem (aitems body) "ring" of
+ Just i -> biq (akind body) + ipower i
+ Nothing -> biq (akind body)
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
@@ -263,7 +263,7 @@ actorOpenClose actor v o dir =
-- door is in unsuitable state
abortIfWith isVerbose ("already " ++ txt)
| not (unoccupied hms dloc) ->
- -- door is blocked by a movable
+ -- door is blocked by an actor
abortIfWith isVerbose "blocked"
| otherwise -> -- door can be opened / closed
-- TODO: print message if action performed by monster and perceived
@@ -299,7 +299,7 @@ lvlChange vdir =
pbody <- gets getPlayerBody
pl <- gets splayer
map <- gets (lmap . slevel)
- let loc = if targeting then clocation cursor else mloc pbody
+ let loc = if targeting then clocation cursor else aloc pbody
case map `at` loc of
Tile (Stairs _ vdir' next) is
| vdir == vdir' -> -- stairs are in the right direction
@@ -337,13 +337,13 @@ lvlChange vdir =
modify (insertActor pl pbody)
-- At this place the invariant is restored again.
-- Land the player at the other end of the stairs.
- updatePlayerBody (\ p -> p { mloc = nloc })
+ updatePlayerBody (\ p -> p { aloc = nloc })
-- Change the level of the player recorded in cursor.
modify (updateCursor (\ c -> c { creturnLn = nln }))
-- Bail out if anybody blocks the staircase.
inhabitants <- gets (locToActors nloc)
when (length inhabitants > 1) abort
- -- The invariant "at most one movable on a tile" restored.
+ -- The invariant "at most one actor on a tile" restored.
-- Create a backup of the savegame.
state <- get
liftIO $ Save.saveGame state >> Save.mvBkp (sconfig state)
@@ -366,7 +366,7 @@ fleeDungeon =
do
state <- get
let total = calculateTotal state
- items = L.concatMap mitems (levelHeroList state)
+ items = L.concatMap aitems (levelHeroList state)
if total == 0
then do
go <- messageClear >> messageMoreConfirm ColorFull "Coward!"
@@ -400,8 +400,8 @@ search :: Action ()
search =
do
lmap <- gets (lmap . slevel)
- ploc <- gets (mloc . getPlayerBody)
- pitems <- gets (mitems . getPlayerBody)
+ ploc <- gets (aloc . getPlayerBody)
+ pitems <- gets (aitems . getPlayerBody)
let delta = case strongestItem pitems "ring" of
Just i -> 1 + ipower i
Nothing -> 1
@@ -416,14 +416,14 @@ search =
-- | Start the floor targeting mode or reset the cursor location to the player.
targetFloor :: Action ()
targetFloor = do
- ploc <- gets (mloc . getPlayerBody)
- target <- gets (mtarget . getPlayerBody)
+ ploc <- gets (aloc . getPlayerBody)
+ target <- gets (atarget . getPlayerBody)
targeting <- gets (ctargeting . scursor)
let tgt = case target of
_ | targeting -> TLoc ploc -- double key press: reset cursor
TEnemy _ _ -> TCursor -- forget enemy target, keep the cursor
t -> t -- keep the target from previous targeting session
- updatePlayerBody (\ p -> p { mtarget = tgt })
+ updatePlayerBody (\ p -> p { atarget = tgt })
setCursor tgt
-- | Start the monster targeting mode. Cycle between monster targets.
@@ -434,7 +434,7 @@ targetMonster = do
pl <- gets splayer
ms <- gets (lmonsters . slevel)
per <- currentPerception
- target <- gets (mtarget . getPlayerBody)
+ target <- gets (atarget . getPlayerBody)
targeting <- gets (ctargeting . scursor)
let i = case target of
TEnemy (AMonster n) _ | targeting -> n -- try next monster
@@ -445,19 +445,19 @@ targetMonster = do
AHero _ -> ms
(lt, gt) = IM.split i dms
gtlt = IM.assocs gt ++ IM.assocs lt
- lf = L.filter (\ (_, m) -> actorSeesLoc pl (mloc m) per (Just pl)) gtlt
+ lf = L.filter (\ (_, m) -> actorSeesLoc pl (aloc m) per (Just pl)) gtlt
tgt = case lf of
[] -> target -- no monsters in sight, stick to last target
- (ni, nm) : _ -> TEnemy (AMonster ni) (mloc nm) -- pick the next
- updatePlayerBody (\ p -> p { mtarget = tgt })
+ (na, nm) : _ -> TEnemy (AMonster na) (aloc nm) -- pick the next
+ updatePlayerBody (\ p -> p { atarget = tgt })
setCursor tgt
-- | Set, activate and display cursor information.
setCursor :: Target -> Action ()
setCursor tgt = do
state <- get
per <- currentPerception
- ploc <- gets (mloc . getPlayerBody)
+ ploc <- gets (aloc . getPlayerBody)
ln <- gets (lname . slevel)
let upd cursor =
let cloc = case targetToLoc (ptvisible per) state of
@@ -476,12 +476,12 @@ doLook =
state <- get
lmap <- gets (lmap . slevel)
per <- currentPerception
- target <- gets (mtarget . getPlayerBody)
+ target <- gets (atarget . getPlayerBody)
let canSee = S.member loc (ptvisible per)
monsterMsg =
if canSee
- then case L.find (\ m -> mloc m == loc) (levelMonsterList state) of
- Just m -> subjectMovable (mkind m) ++ " is here. "
+ then case L.find (\ m -> aloc m == loc) (levelMonsterList state) of
+ Just m -> subjectActor (akind m) ++ " is here. "
Nothing -> ""
else ""
mode = case target of
@@ -519,7 +519,7 @@ moveOrAttack allowAttacks autoOpen actor dir
pl <- gets splayer
lmap <- gets (lmap . slevel)
sm <- gets (getActor actor)
- let sloc = mloc sm -- source location
+ let sloc = aloc sm -- source location
tloc = sloc `shift` dir -- target location
tgt <- gets (locToActor tloc)
case tgt of
@@ -536,7 +536,7 @@ moveOrAttack allowAttacks autoOpen actor dir
Nothing ->
if accessible lmap sloc tloc then do
-- perform the move
- updateAnyActor actor $ \ m -> m { mloc = tloc }
+ updateAnyActor actor $ \ body -> body { aloc = tloc }
when (actor == pl) $
messageAdd $ lookAt False True state lmap tloc ""
advanceTime actor
@@ -551,9 +551,9 @@ moveOrAttack allowAttacks autoOpen actor dir
-- | Resolves the result of an actor moving into another. Usually this
-- involves melee attack, but with two heroes it just changes focus.
--- Movables on blocked locations can be attacked without any restrictions.
--- For instance, a movable on an open door can be attacked diagonally,
--- and a movable capable of moving through walls can be attacked from an
+-- Actors on blocked locations can be attacked without any restrictions.
+-- For instance, an actor on an open door can be attacked diagonally,
+-- and an actor capable of moving through walls can be attacked from an
-- adjacent position.
-- This function is analogous to zapGroupItem, but for melee
-- and not using up the weapon.
@@ -568,11 +568,11 @@ actorAttackActor source target = do
per <- currentPerception
let groupName = "sword"
verb = attackToVerb groupName
- sloc = mloc sm
+ sloc = aloc sm
swordKindIndex = fromJust $ L.elemIndex ItemKind.sword ItemKind.loot
-- The hand-to-hand "weapon", equivalent to +0 sword.
h2h = Item swordKindIndex 0 Nothing 1
- str = strongestItem (mitems sm) groupName
+ str = strongestItem (aitems sm) groupName
stack = fromMaybe h2h str
single = stack { icount = 1 }
-- The message describes the source part of the action.
@@ -592,14 +592,14 @@ attackToVerb "mace" = "bludgeon"
attackToVerb _ = "hit"
-- | Resolves the result of an actor running into another.
--- This involves switching positions of the two movables.
+-- This involves switching positions of the two actors.
actorRunActor :: ActorId -> ActorId -> Action ()
actorRunActor source target = do
pl <- gets splayer
- sloc <- gets (mloc . getActor source) -- source location
- tloc <- gets (mloc . getActor target) -- target location
- updateAnyActor source $ \ m -> m { mloc = tloc }
- updateAnyActor target $ \ m -> m { mloc = sloc }
+ sloc <- gets (aloc . getActor source) -- source location
+ tloc <- gets (aloc . getActor target) -- target location
+ updateAnyActor source $ \ m -> m { aloc = tloc }
+ updateAnyActor target $ \ m -> m { aloc = sloc }
if source == pl
then stopRunning -- do not switch positions repeatedly
else if isAMonster source
@@ -615,19 +615,19 @@ generateMonster =
nstate <- liftIO $ rndToIO $ rollMonster state
modify (const nstate)
--- | Possibly regenerate HP for all movables on the current level.
+-- | Possibly regenerate HP for all actors on the current level.
regenerateLevelHP :: Action ()
regenerateLevelHP =
do
time <- gets stime
let upd m =
- let regen = nregen (mkind m) `div`
- case strongestItem (mitems m) "amulet" of
+ let regen = bregen (akind m) `div`
+ case strongestItem (aitems m) "amulet" of
Just i -> ipower i
Nothing -> 1
in if time `mod` regen /= 0
then m
- else m { mhp = min (nhpMax (mkind m)) (mhp m + 1) }
+ else m { ahp = min (bhpMax (akind m)) (ahp m + 1) }
-- We really want hero selection to be a purely UI distinction,
-- so all heroes need to regenerate, not just the player.
-- Only the heroes on the current level regenerate (others are frozen
View
62 src/Movable.hs → src/Actor.hs
@@ -1,47 +1,47 @@
-module Movable where
+module Actor where
import Data.Binary
import Control.Monad
import Geometry
import Item
-import MovableKind
+import ActorKind
-- | Monster properties that are changing a lot. If they are dublets
--- of properties form MovableKind, the intention is they may be modified
+-- of properties form ActorKind, the intention is they may be modified
-- temporarily, but will return to the original value over time. E.g., HP.
-data Movable = Movable
- { mkind :: !MovableKind, -- ^ kind of the movable; TODO: make this Int
- mhp :: !Int, -- ^ current hit pints
- mdir :: Maybe Dir, -- ^ the direction of running
- mtarget :: Target, -- ^ the target for distance attacks and AI
- mloc :: !Loc, -- ^ current location
- mitems :: [Item], -- ^ inventory
- mletter :: !Char, -- ^ next inventory letter
- mtime :: !Time } -- ^ time of next action
+data Actor = Actor
+ { akind :: !ActorKind, -- ^ kind of the actor; TODO: make this Int
+ ahp :: !Int, -- ^ current hit pints
+ adir :: Maybe Dir, -- ^ the direction of running
+ atarget :: Target, -- ^ the target for distance attacks and AI
+ aloc :: !Loc, -- ^ current location
+ aitems :: [Item], -- ^ inventory
+ aletter :: !Char, -- ^ next inventory letter
+ atime :: !Time } -- ^ time of next action
deriving Show
-instance Binary Movable where
- put (Movable mk mhp md tgt ml minv mletter mtime) =
+instance Binary Actor where
+ put (Actor akind ahp adir atarget aloc aitems aletter atime) =
do
- put mk
- put mhp
- put md
- put tgt
- put ml
- put minv
- put mletter
- put mtime
+ put akind
+ put ahp
+ put adir
+ put atarget
+ put aloc
+ put aitems
+ put aletter
+ put atime
get = do
- mk <- get
- mhp <- get
- md <- get
- tgt <- get
- ml <- get
- minv <- get
- mletter <- get
- mtime <- get
- return (Movable mk mhp md tgt ml minv mletter mtime)
+ akind <- get
+ ahp <- get
+ adir <- get
+ atarget <- get
+ aloc <- get
+ aitems <- get
+ aletter <- get
+ atime <- get
+ return (Actor akind ahp adir atarget aloc aitems aletter atime)
data ActorId = AHero Int -- ^ hero index (on the lheroes intmap)
| AMonster Int -- ^ monster index (on the lmonsters intmap)
View
26 src/MovableAdd.hs → src/ActorAdd.hs
@@ -1,4 +1,4 @@
-module MovableAdd where
+module ActorAdd where
import Prelude hiding (floor)
import qualified Data.IntMap as IM
@@ -12,9 +12,9 @@ import Geometry
import State
import Level
import Dungeon
-import Movable
-import MovableState
-import MovableKind
+import Actor
+import ActorState
+import ActorKind
import Random
import qualified Config
@@ -24,15 +24,15 @@ import qualified Config
-- 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
-template :: MovableKind -> Int -> Loc -> Movable
-template mk hp loc = Movable mk hp Nothing TCursor loc [] 'a' 0
+template :: ActorKind -> Int -> Loc -> Actor
+template mk hp loc = Actor mk hp Nothing TCursor loc [] 'a' 0
nearbyFreeLoc :: Loc -> State -> Loc
nearbyFreeLoc origin state@(State { slevel = Level { lmap = map } }) =
let hs = levelHeroList state
ms = levelMonsterList state
places = origin : L.nub (concatMap surroundings places)
- good loc = open (map `at` loc) && not (loc `L.elem` L.map mloc (hs ++ ms))
+ good loc = open (map `at` loc) && not (loc `L.elem` L.map aloc (hs ++ ms))
in fromMaybe (error "no nearby free location found") $ L.find good places
-- Adding heroes
@@ -47,7 +47,7 @@ addHero :: Loc -> State -> State
addHero ploc state =
let config = sconfig state
bHP = Config.get config "heroes" "baseHP"
- mk = hero {nhpMin = bHP, nhpMax = bHP, nsymbol = symbol, nname = name }
+ mk = hero {bhpMin = bHP, bhpMax = bHP, bsymbol = symbol, bname = name }
loc = nearbyFreeLoc ploc state
n = fst (scounter state)
symbol = if n < 1 || n > 9 then '@' else Char.intToDigit n
@@ -76,7 +76,7 @@ monsterGenChance (LambdaCave depth) numMonsters =
monsterGenChance _ _ = return False
-- | Create a new monster in the level, at a random position.
-addMonster :: MovableKind -> Int -> Loc -> State -> State
+addMonster :: ActorKind -> Int -> Loc -> State -> State
addMonster mk hp ploc state = do
let loc = nearbyFreeLoc ploc state
n = snd (scounter state)
@@ -99,10 +99,10 @@ rollMonster state@(State { slevel = lvl }) = do
-- in adjacent and unexpected places
loc <- findLocTry 1000 lvl
(\ l t -> open t
- && not (l `L.elem` L.map mloc (hs ++ ms)))
+ && not (l `L.elem` L.map aloc (hs ++ ms)))
(\ l t -> floor t
- && L.all (\ pl -> distance (mloc pl, l) > 400) hs)
- let fmk = Frequency $ L.zip (L.map nfreq dungeonMonsters) dungeonMonsters
+ && L.all (\ pl -> distance (aloc pl, l) > 400) hs)
+ let fmk = Frequency $ L.zip (L.map bfreq dungeonMonsters) dungeonMonsters
mk <- frequency fmk
- hp <- randomR (nhpMin mk, nhpMax mk)
+ hp <- randomR (bhpMin mk, bhpMax mk)
return $ addMonster mk hp loc state
View
111 src/ActorKind.hs
@@ -0,0 +1,111 @@
+module ActorKind where
+
+import Data.Binary
+import Control.Monad
+
+import Geometry
+import Random
+import qualified Color
+
+-- | Monster properties that are changing rarely and permanently.
+data ActorKind = ActorKind
+ { bhpMin :: !Int, -- ^ minimal initial hp
+ bhpMax :: !Int, -- ^ maximal possible and initial hp
+ bspeed :: !Time, -- ^ natural speed
+ bsymbol :: !Char, -- ^ map symbol
+ bcolor :: !Color.Color, -- ^ map color
+ bname :: String, -- ^ name
+ bsight :: !Bool, -- ^ can it see?
+ bsmell :: !Bool, -- ^ can it smell?
+ biq :: !Int, -- ^ intelligence
+ bregen :: !Int, -- ^ regeneration interval
+ bfreq :: !Int -- ^ dungeon frequency
+ }
+ deriving (Show, Eq)
+
+instance Binary ActorKind where
+ put (ActorKind 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
+ nhpMin <- get
+ nhpMax <- get
+ nsp <- get
+ nsym <- get
+ ncol <- get
+ nnm <- get
+ nsi <- get
+ nsm <- get
+ niq <- get
+ nreg <- get
+ nfreq <- get
+ return (ActorKind nhpMin nhpMax nsp nsym ncol nnm nsi nsm niq nreg nfreq)
+
+-- | The list of kinds of monsters that appear randomly throughout the dungeon.
+dungeonMonsters :: [ActorKind]
+dungeonMonsters = [eye, fastEye, nose]
+
+hero, eye, fastEye, nose :: ActorKind
+hero = ActorKind
+ { bhpMin = 50,
+ bhpMax = 50,
+ bspeed = 10,
+ bsymbol = '@',
+ bname = "you",
+ bcolor = Color.BrWhite, -- Heroes white, monsters colorful.
+ bsight = True,
+ bsmell = False,
+ biq = 13, -- Can see secret doors under alien control.
+ bregen = 1500,
+ bfreq = 0
+ }
+
+eye = ActorKind
+ { bhpMin = 1, -- falls in 1--4 unarmed rounds
+ bhpMax = 12,
+ bspeed = 10,
+ bsymbol = 'e',
+ bcolor = Color.BrRed,
+ bname = "the reducible eye",
+ bsight = True,
+ bsmell = False,
+ biq = 8,
+ bregen = 1500,
+ bfreq = 6
+ }
+fastEye = ActorKind
+ { bhpMin = 1, -- falls in 1--2 unarmed rounds
+ bhpMax = 6,
+ bspeed = 4,
+ bsymbol = 'e',
+ bcolor = Color.BrBlue,
+ bname = "the super-fast eye",
+ bsight = True,
+ bsmell = False,
+ biq = 12,
+ bregen = 1500,
+ bfreq = 1
+ }
+nose = ActorKind
+ { bhpMin = 6, -- 2--5 and in 1 round of the strongest sword
+ bhpMax = 13,
+ bspeed = 11,
+ bsymbol = 'n',
+ bcolor = Color.Green,
+ bname = "the point-free nose",
+ bsight = False,
+ bsmell = True,
+ biq = 0,
+ bregen = 1500,
+ bfreq = 2
+ }
View
22 src/MovableState.hs → src/ActorState.hs
@@ -1,4 +1,4 @@
-module MovableState where
+module ActorState where
import qualified Data.List as L
import qualified Data.Set as S
@@ -9,7 +9,7 @@ import Data.Maybe
import Control.Exception (assert)
import Geometry
-import Movable
+import Actor
import Level
import Dungeon
import State
@@ -18,7 +18,7 @@ import State
-- All the other actor and level operations only consider the current level.
-- | Finds an actor body on any level. Error if not found.
-findActorAnyLevel :: ActorId -> State -> Maybe (LevelName, Movable)
+findActorAnyLevel :: ActorId -> State -> Maybe (LevelName, Actor)
findActorAnyLevel actor state@(State { slevel = lvl,
sdungeon = Dungeon m }) =
let chk lvl =
@@ -28,7 +28,7 @@ findActorAnyLevel actor state@(State { slevel = lvl,
AMonster n -> IM.lookup n (lmonsters lvl)
in listToMaybe $ mapMaybe chk (lvl : M.elems m)
-getPlayerBody :: State -> Movable
+getPlayerBody :: State -> Actor
getPlayerBody state = snd $ fromMaybe (error "getPlayerBody") $
findActorAnyLevel (splayer state) state
@@ -41,7 +41,7 @@ allHeroesAnyLevel state =
L.map (\ (i, _) -> (AHero i, ln)) (IM.assocs hs)
in L.concatMap one (slevel state : M.elems m)
-updateAnyActorBody :: ActorId -> (Movable -> Movable) -> State -> State
+updateAnyActorBody :: ActorId -> (Actor -> Actor) -> State -> State
updateAnyActorBody actor f state =
case findActorAnyLevel actor state of
Just (ln, _) ->
@@ -59,15 +59,15 @@ updateAnyLevel f ln state@(State { slevel = level,
-- | Calculate the location of player's target.
targetToLoc :: S.Set Loc -> State -> Maybe Loc
targetToLoc visible state =
- case mtarget (getPlayerBody state) of
+ case atarget (getPlayerBody state) of
TLoc loc -> Just loc
TCursor ->
if lname (slevel state) == clocLn (scursor state)
then Just $ clocation (scursor state)
else Nothing -- cursor invalid: set at a different level
TEnemy a _ll -> do
guard $ memActor a state -- alive and on the current level?
- let loc = mloc (getActor a state)
+ let loc = aloc (getActor a state)
guard $ S.member loc visible -- visible?
return loc
@@ -81,7 +81,7 @@ memActor a (State { slevel = lvl }) =
AMonster n -> IM.member n (lmonsters lvl)
-- | Gets actor body from the current level. Error if not found.
-getActor :: ActorId -> State -> Movable
+getActor :: ActorId -> State -> Actor
getActor a (State { slevel = lvl }) =
case a of
AHero n -> lheroes lvl IM.! n
@@ -95,13 +95,13 @@ deleteActor a =
AMonster n -> updateLevel (updateMonsters (IM.delete n))
-- | Add actor to the current level.
-insertActor :: ActorId -> Movable -> State -> State
+insertActor :: ActorId -> Actor -> State -> State
insertActor a m =
case a of
AHero n -> updateLevel (updateHeroes (IM.insert n m))
AMonster n -> updateLevel (updateMonsters (IM.insert n m))
-levelHeroList, levelMonsterList :: State -> [Movable]
+levelHeroList, levelMonsterList :: State -> [Actor]
levelHeroList (State { slevel = Level { lheroes = hs } }) = IM.elems hs
levelMonsterList (State { slevel = Level { lmonsters = ms } }) = IM.elems ms
@@ -118,5 +118,5 @@ locToActors loc state =
where
getIndex (projection, injection) =
let l = IM.assocs $ projection $ slevel state
- im = L.filter (\ (_i, m) -> mloc m == loc) l
+ im = L.filter (\ (_i, m) -> aloc m == loc) l
in fmap (injection . fst) im
View
20 src/Display.hs
@@ -30,9 +30,9 @@ import Level
import LevelState
import Dungeon
import Perception
-import Movable
-import MovableState
-import MovableKind
+import Actor
+import ActorState
+import ActorKind
import Item
import qualified Keys as K
import qualified Terrain
@@ -128,8 +128,8 @@ displayLevel
sassocs = assocs,
slevel = Level ln _ (sy, sx) _ smap lmap _ }))
msg moverlay =
- let Movable { mkind = MovableKind { nhpMax = xhp },
- mhp = php, mloc = ploc, mitems = pitems } = getPlayerBody state
+ let Actor { akind = ActorKind { bhpMax = xhp },
+ ahp = php, aloc = ploc, aitems = pitems } = getPlayerBody state
reachable = ptreachable per
visible = ptvisible per
overlay = fromMaybe "" moverlay
@@ -155,20 +155,20 @@ displayLevel
dis n loc =
let tile = lmap `lAt` loc
sml = ((smap ! loc) - time) `div` 100
- viewMovable loc (Movable { mkind = mk })
+ viewActor loc (Actor { akind = mk })
| loc == ploc && ln == creturnLn cursor =
- (nsymbol mk, Color.defBG) -- highlight player
- | otherwise = (nsymbol mk, ncolor mk)
+ (bsymbol mk, Color.defBG) -- highlight player
+ | otherwise = (bsymbol mk, bcolor mk)
viewSmell :: Int -> Char
viewSmell n
| n > 9 = '*'
| n < 0 = '-'
| otherwise = Char.intToDigit n
rainbow loc = toEnum ((fst loc + snd loc) `mod` 14 + 1)
(char, fg) =
- case L.find (\ m -> loc == mloc m) (hs ++ ms) of
+ case L.find (\ m -> loc == aloc m) (hs ++ ms) of
_ | sTer > 0 -> Terrain.viewTerrain sTer False (tterrain tile)
- Just m | sOmn || vis -> viewMovable loc m
+ Just m | sOmn || vis -> viewActor loc m
_ | sSml && sml >= 0 -> (viewSmell sml, rainbow loc)
| otherwise -> viewTile vis tile assocs
vis = S.member loc visible
View
56 src/EffectAction.hs
@@ -23,10 +23,10 @@ import qualified Keys as K
import Level
import LevelState
import Message
-import Movable
-import MovableState
-import MovableKind
-import MovableAdd
+import Actor
+import ActorState
+import ActorKind
+import ActorAdd
import Perception
import Random
import State
@@ -49,36 +49,36 @@ effectToAction :: Effect.Effect -> ActorId -> ActorId -> Int ->
effectToAction Effect.NoEffect source target power = nullEffect
effectToAction Effect.Heal _source target power = do
tm <- gets (getActor target)
- if mhp tm >= nhpMax (mkind tm) || power <= 0
+ if ahp tm >= bhpMax (akind tm) || power <= 0
then nullEffect
else do
focusIfAHero target
- let upd m = m { mhp = min (nhpMax (mkind m)) (mhp m + power) }
+ let upd m = m { ahp = min (bhpMax (akind m)) (ahp m + power) }
updateAnyActor target upd
- return (True, subjectMovableVerb (mkind tm) "feel" ++ " better.")
+ return (True, subjectActorVerb (akind tm) "feel" ++ " better.")
effectToAction (Effect.Wound nDm) source target power = do
n <- liftIO $ rndToIO $ rollDice nDm
if (n + power <= 0) then nullEffect else do
focusIfAHero target
tm <- gets (getActor target)
- let newHP = mhp tm - n - power
+ let newHP = ahp tm - n - power
killed = newHP <= 0
msg = if source == target -- a potion of wounding, etc.
- then subjectMovableVerb (mkind tm) "feel"
+ then subjectActorVerb (akind tm) "feel"
++ if killed then " mortally" else ""
++ " wounded."
else if killed
then if isAHero target
then ""
- else subjectMovableVerb (mkind tm) "die" ++ "."
+ else subjectActorVerb (akind tm) "die" ++ "."
else if isAHero target
- then subjectMovableVerb (mkind tm) "lose"
+ then subjectActorVerb (akind tm) "lose"
++ " " ++ show (n + power) ++ "HP."
- else subjectMovableVerb (mkind tm) "hiss" ++ " in pain."
- updateAnyActor target $ \ m -> m { mhp = newHP } -- Damage the target.
+ else subjectActorVerb (akind tm) "hiss" ++ " in pain."
+ updateAnyActor target $ \ m -> m { ahp = newHP } -- Damage the target.
when killed $ do
-- Place the actor's possessions on the map.
- modify (updateLevel (dropItemsAt (mitems tm) (mloc tm)))
+ modify (updateLevel (dropItemsAt (aitems tm) (aloc tm)))
-- Clean bodies up.
pl <- gets splayer
if target == pl
@@ -90,21 +90,21 @@ effectToAction Effect.Dominate source target power =
then do
assertTrue $ selectPlayer target
-- Prevent AI from getting a few free moves until new player ready.
- updatePlayerBody (\ m -> m { mtime = 0})
+ updatePlayerBody (\ m -> m { atime = 0})
display
return (True, "")
else nullEffect
effectToAction Effect.SummonFriend source target power = do
tm <- gets (getActor target)
if isAHero source
- then summonHeroes (1 + power) (mloc tm)
- else summonMonsters (1 + power) (mloc tm)
+ then summonHeroes (1 + power) (aloc tm)
+ else summonMonsters (1 + power) (aloc tm)
return (True, "")
effectToAction Effect.SummonEnemy source target power = do
tm <- gets (getActor target)
if not $ isAHero source -- a trick: monster player will summon a hero
- then summonHeroes (1 + power) (mloc tm)
- else summonMonsters (1 + power) (mloc tm)
+ then summonHeroes (1 + power) (aloc tm)
+ else summonMonsters (1 + power) (aloc tm)
return (True, "")
effectToAction Effect.ApplyPerfume source target _ =
if source == target
@@ -135,7 +135,7 @@ itemEffectAction source target item = do
-- Determine how the player perceives the event.
-- TODO: factor it out as a function messageActor
-- and messageActorVerb (incorporating subjectActorVerb).
- if mloc tm `S.member` ptvisible per
+ if aloc tm `S.member` ptvisible per
then messageAdd msg
else if not b
then return () -- Victim is not seen, nothing interestng happens.
@@ -184,11 +184,11 @@ selectPlayer actor =
lvlSwitch nln
-- Set smell display, depending on player capabilities.
-- This also resets FOV mode.
- modify (\ s -> s { ssensory = if MovableKind.nsmell (mkind pbody)
+ modify (\ s -> s { ssensory = if ActorKind.bsmell (akind pbody)
then Smell
else Implicit })
-- Announce.
- messageAdd $ subjectMovable (mkind pbody) ++ " selected."
+ messageAdd $ subjectActor (akind pbody) ++ " selected."
return True
focusIfAHero :: ActorId -> Action ()
@@ -212,9 +212,9 @@ summonHeroes n loc =
summonMonsters :: Int -> Loc -> Action ()
summonMonsters n loc = do
- let fmk = Frequency $ L.zip (L.map nfreq dungeonMonsters) dungeonMonsters
+ let fmk = Frequency $ L.zip (L.map bfreq dungeonMonsters) dungeonMonsters
mk <- liftIO $ rndToIO $ frequency fmk
- modify (\ state -> iterate (addMonster mk (nhpMax mk) loc) state !! n)
+ modify (\ state -> iterate (addMonster mk (bhpMax mk) loc) state !! n)
-- | Remove dead heroes, check if game over.
-- For now we only check the selected hero, but if poison, etc.
@@ -226,9 +226,9 @@ checkPartyDeath =
pl <- gets splayer
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.
+ when (ahp 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 ColorBW $
- subjectMovableVerb (mkind pbody) "die" ++ "."
+ subjectActorVerb (akind pbody) "die" ++ "."
history -- Prevent the messages from being repeated.
let firstDeathEnds = Config.get config "heroes" "firstDeathEnds"
if firstDeathEnds
@@ -260,7 +260,7 @@ gameOver showEndingScreens =
-- | Calculate loot's worth for heroes on the current level.
calculateTotal :: State -> Int
calculateTotal s =
- L.sum $ L.map itemPrice $ L.concatMap mitems (levelHeroList s)
+ L.sum $ L.map itemPrice $ L.concatMap aitems (levelHeroList s)
-- | Handle current score and display it with the high scores. Scores
-- should not be shown during the game, because ultimately the worth of items might give
@@ -312,7 +312,7 @@ displayItems msg sorted is = do
overlay ovl
stopRunning :: Action ()
-stopRunning = updatePlayerBody (\ p -> p { mdir = Nothing })
+stopRunning = updatePlayerBody (\ p -> p { adir = Nothing })
-- | Store current message in the history and reset current message.
history :: Action ()
View
48 src/Grammar.hs
@@ -6,8 +6,8 @@ import Data.List as L
import qualified Data.IntMap as IM
import Item
-import Movable
-import MovableKind
+import Actor
+import ActorKind
import State
import ItemKind
import Effect
@@ -24,41 +24,41 @@ capitalize :: String -> String
capitalize [] = []
capitalize (c : cs) = toUpper c : cs
--- | How to refer to a movable in object position of a sentence.
-objectMovable :: MovableKind -> String
-objectMovable mk = nname mk
+-- | How to refer to an actor in object position of a sentence.
+objectActor :: ActorKind -> String
+objectActor mk = bname mk
--- | How to refer to a movable in subject position of a sentence.
-subjectMovable :: MovableKind -> String
-subjectMovable x = capitalize $ objectMovable x
+-- | How to refer to an actor in subject position of a sentence.
+subjectActor :: ActorKind -> String
+subjectActor x = capitalize $ objectActor x
-verbMovable :: MovableKind -> String -> String
-verbMovable mk v = if nname mk == "you" then v else suffixS v
+verbActor :: ActorKind -> String -> String
+verbActor mk v = if bname mk == "you" then v else suffixS v
-- | Sentences such like "The dog barks".
-subjectMovableVerb :: MovableKind -> String -> String
-subjectMovableVerb x v = subjectMovable x ++ " " ++ verbMovable x v
+subjectActorVerb :: ActorKind -> String -> String
+subjectActorVerb x v = subjectActor x ++ " " ++ verbActor x v
-compoundVerbMovable :: MovableKind -> String -> String -> String
-compoundVerbMovable m v p = verbMovable m v ++ " " ++ p
+compoundVerbActor :: ActorKind -> String -> String -> String
+compoundVerbActor m v p = verbActor m v ++ " " ++ p
-subjectVerbIObject :: State -> Movable -> String -> Item -> String -> String
+subjectVerbIObject :: State -> Actor -> String -> Item -> String -> String
subjectVerbIObject state m v o add =
- subjectMovable (mkind m) ++ " " ++
- verbMovable (mkind m) v ++ " " ++
+ subjectActor (akind m) ++ " " ++
+ verbActor (akind m) v ++ " " ++
objectItem state o ++ add ++ "."
-subjectVerbMObject :: Movable -> String -> Movable -> String -> String
+subjectVerbMObject :: Actor -> String -> Actor -> String -> String
subjectVerbMObject m v o add =
- subjectMovable (mkind m) ++ " " ++
- verbMovable (mkind m) v ++ " " ++
- objectMovable (mkind o) ++ add ++ "."
+ subjectActor (akind m) ++ " " ++
+ verbActor (akind m) v ++ " " ++
+ objectActor (akind o) ++ add ++ "."
-subjCompoundVerbIObj :: State -> Movable -> String -> String ->
+subjCompoundVerbIObj :: State -> Actor -> String -> String ->
Item -> String -> String
subjCompoundVerbIObj state m v p o add =
- subjectMovable (mkind m) ++ " " ++
- compoundVerbMovable (mkind m) v p ++ " " ++
+ subjectActor (akind m) ++ " " ++
+ compoundVerbActor (akind m) v p ++ " " ++
objectItem state o ++ add ++ "."
makeObject :: Int -> (String -> String) -> String -> String
View
38 src/ItemAction.hs
@@ -22,10 +22,10 @@ import qualified Keys as K
import Level
import LevelState
import Message
-import Movable
-import MovableState
-import MovableKind
-import MovableAdd
+import Actor
+import ActorState
+import ActorKind
+import ActorAdd
import Perception
import Random
import State
@@ -42,7 +42,7 @@ import EffectAction
-- | Display inventory
inventory :: Action a
inventory = do
- items <- gets (mitems . getPlayerBody)
+ items <- gets (aitems . getPlayerBody)
if L.null items
then abortWith "Not carrying anything."
else do
@@ -74,15 +74,15 @@ applyGroupItem actor verb item = do
-- only one item consumed, even if several in inventory
let consumed = item { icount = 1 }
msg = subjectVerbIObject state body verb consumed ""
- loc = mloc body
+ loc = aloc body
removeFromInventory actor consumed loc
when (loc `S.member` ptvisible per) $ messageAdd msg
itemEffectAction actor actor consumed
advanceTime actor
playerApplyGroupItem :: String -> Action ()
playerApplyGroupItem groupName = do
- is <- gets (mitems . getPlayerBody)
+ is <- gets (aitems . getPlayerBody)
iOpt <- getGroupItem is groupName
("What to " ++ applyToVerb groupName ++ "?") "in inventory"
pl <- gets splayer
@@ -114,7 +114,7 @@ zapGroupItem source loc verb item = do
per <- currentPerception
let consumed = item { icount = 1 }
msg = subjectVerbIObject state sm verb consumed ""
- sloc = mloc sm
+ sloc = aloc sm
removeFromInventory source consumed sloc
-- The message describes the source part of the action.
when (sloc `S.member` ptvisible per) $ messageAdd msg
@@ -131,7 +131,7 @@ zapGroupItem source loc verb item = do
playerZapGroupItem :: String -> Action ()
playerZapGroupItem groupName = do
state <- get
- is <- gets (mitems . getPlayerBody)
+ is <- gets (aitems . getPlayerBody)
iOpt <- getGroupItem is groupName
("What to " ++ zapToVerb groupName ++ "?") "in inventory"
pl <- gets splayer
@@ -166,13 +166,13 @@ dropItem = do
pl <- gets splayer
state <- get
pbody <- gets getPlayerBody
- ploc <- gets (mloc . getPlayerBody)
- items <- gets (mitems . getPlayerBody)
+ ploc <- gets (aloc . getPlayerBody)
+ items <- gets (aitems . getPlayerBody)
iOpt <- getAnyItem "What to drop?" items "inventory"
case iOpt of
Just stack -> do
let i = stack { icount = 1 }
- removeOnlyFromInventory pl i (mloc pbody)
+ removeOnlyFromInventory pl i (aloc pbody)
messageAdd (subjectVerbIObject state pbody "drop" i "")
modify (updateLevel (dropItemsAt [i] ploc))
Nothing -> neverMind True
@@ -182,7 +182,7 @@ dropItem = do
-- makes it impossible to drop items if the floor not empty.
removeOnlyFromInventory :: ActorId -> Item -> Loc -> Action ()
removeOnlyFromInventory actor i loc = do
- updateAnyActor actor (\ m -> m { mitems = removeItemByLetter i (mitems m) })
+ updateAnyActor actor (\ m -> m { aitems = removeItemByLetter i (aitems m) })
-- | Remove given item from an actor's inventory or floor.
-- TODO: this is subtly wrong: if identical items are on the floor and in
@@ -195,7 +195,7 @@ removeFromInventory :: ActorId -> Item -> Loc -> Action ()
removeFromInventory actor i loc = do
b <- removeFromLoc i loc
when (not b) $
- updateAnyActor actor (\ m -> m { mitems = removeItemByLetter i (mitems m) })
+ updateAnyActor actor (\ m -> m { aitems = removeItemByLetter i (aitems m) })
-- | Remove given item from the given location. Tell if successful.
removeFromLoc :: Item -> Loc -> Action Bool
@@ -217,17 +217,17 @@ actorPickupItem actor = do
per <- currentPerception
lmap <- gets (lmap . slevel)
body <- gets (getActor actor)
- let loc = mloc body
+ let loc = aloc body
t = lmap `at` loc -- the map tile in question
perceived = loc `S.member` ptvisible per
isPlayer = actor == pl
-- check if something is here to pick up
case titems t of
[] -> abortIfWith isPlayer "nothing here"
i:rs -> -- pick up first item; TODO: let player select item;not for monsters
- case assignLetter (iletter i) (mletter body) (mitems body) of
+ case assignLetter (iletter i) (aletter body) (aitems body) of
Just l -> do
- let (ni, nitems) = joinItem (i { iletter = Just l }) (mitems body)
+ let (ni, nitems) = joinItem (i { iletter = Just l }) (aitems body)
-- message depends on who picks up and if a hero can perceive it
if isPlayer
then messageAdd (letterLabel (iletter ni) ++ objectItem state ni)
@@ -236,7 +236,7 @@ actorPickupItem actor = do
assertTrue $ removeFromLoc i loc
-- add item to actor's inventory:
updateAnyActor actor $ \ m ->
- m { mitems = nitems, mletter = maxLetter l (mletter body) }
+ m { aitems = nitems, aletter = maxLetter l (aletter body) }
Nothing -> abortIfWith isPlayer "cannot carry any more"
advanceTime actor
@@ -278,7 +278,7 @@ getItem :: String -> -- prompt message
getItem prompt p ptext is0 isn = do
lmap <- gets (lmap . slevel)
body <- gets getPlayerBody
- let loc = mloc body
+ let loc = aloc body
t = lmap `at` loc -- the map tile in question
tis = titems t
floorMsg = if L.null tis then "" else " -,"
View
12 src/Level.hs
@@ -9,7 +9,7 @@ import qualified Data.IntMap as IM
import Geometry
import GeometryRnd
-import Movable
+import Actor
import Item
import Random
import qualified Terrain
@@ -34,7 +34,7 @@ levelNumber (LambdaCave n) = n
-- | A dungeon location is a level together with a location on that level.
type DungeonLoc = (LevelName, Loc)
-type Party = IM.IntMap Movable
+type Party = IM.IntMap Actor
data Level = Level
{ lname :: LevelName,
@@ -152,10 +152,10 @@ passive = Terrain.passive . tterrain
perceptible :: Tile -> [Dir]
perceptible = Terrain.perceptible . tterrain
--- Checks for the presence of movables. Does *not* check if the tile is open.
-unoccupied :: [Movable] -> Loc -> Bool
-unoccupied movables loc =
- all (\ m -> mloc m /= loc) movables
+-- Checks for the presence of actors. Does *not* check if the tile is open.
+unoccupied :: [Actor] -> Loc -> Bool
+unoccupied actors loc =
+ all (\ body -> aloc body /= loc) actors
-- check whether one location is accessible from the other
-- precondition: the two locations are next to each other
View
2 src/Main.hs
@@ -11,7 +11,7 @@ import Random
import qualified Save
import Turn
import qualified Config
-import MovableAdd
+import ActorAdd
import Item
import qualified Keys as K
View
111 src/MovableKind.hs
@@ -1,111 +0,0 @@
-module MovableKind where
-
-import Data.Binary
-import Control.Monad
-
-import Geometry
-import Random
-import qualified Color
-
--- | Monster properties that are changing rarely and permanently.
-data MovableKind = MovableKind
- { nhpMin :: !Int, -- ^ minimal initial hp
- nhpMax :: !Int, -- ^ maximal possible and initial hp
- nspeed :: !Time, -- ^ natural speed
- nsymbol :: !Char, -- ^ map symbol
- ncolor :: !Color.Color, -- ^ 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)
-
-instance Binary MovableKind where
- put (MovableKind 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
- nhpMin <- get
- nhpMax <- get
- nsp <- get
- nsym <- get
- ncol <- get
- nnm <- get
- nsi <- get
- nsm <- get
- niq <- get
- nreg <- get
- nfreq <- get
- return (MovableKind nhpMin nhpMax nsp nsym ncol nnm nsi nsm niq nreg nfreq)
-
--- | The list of kinds of monsters that appear randomly throughout the dungeon.
-dungeonMonsters :: [MovableKind]
-dungeonMonsters = [eye, fastEye, nose]
-
-hero, eye, fastEye, nose :: MovableKind
-hero = MovableKind
- { nhpMin = 50,
- nhpMax = 50,
- nspeed = 10,
- nsymbol = '@',
- nname = "you",
- ncolor = Color.BrWhite, -- Heroes white, monsters colorful.
- nsight = True,
- nsmell = False,
- niq = 13, -- Can see secret doors under alien control.
- nregen = 1500,
- nfreq = 0
- }
-
-eye = MovableKind
- { nhpMin = 1, -- falls in 1--4 unarmed rounds
- nhpMax = 12,
- nspeed = 10,
- nsymbol = 'e',
- ncolor = Color.BrRed,
- nname = "the reducible eye",
- nsight = True,
- nsmell = False,
- niq = 8,
- nregen = 1500,
- nfreq = 6
- }
-fastEye = MovableKind
- { nhpMin = 1, -- falls in 1--2 unarmed rounds
- nhpMax = 6,
- nspeed = 4,
- nsymbol = 'e',
- ncolor = Color.BrBlue,
- nname = "the super-fast eye",
- nsight = True,
- nsmell = False,
- niq = 12,
- nregen = 1500,
- nfreq = 1
- }
-nose = MovableKind
- { nhpMin = 6, -- 2--5 and in 1 round of the strongest sword
- nhpMax = 13,
- nspeed = 11,
- nsymbol = 'n',
- ncolor = Color.Green,
- nname = "the point-free nose",
- nsight = False,
- nsmell = True,
- niq = 0,
- nregen = 1500,
- nfreq = 2
- }
View
12 src/Perception.hs
@@ -9,9 +9,9 @@ import Control.Monad
import Geometry
import State
import Level
-import Movable
-import MovableState
-import qualified MovableKind
+import Actor
+import ActorState
+import qualified ActorKind
import FOV
import qualified Config
@@ -67,7 +67,7 @@ perception_ state@(State { splayer = pl,
ssensory = sensory }) =
let mode = Config.get config "engine" "fovMode"
radius = Config.get config "engine" "fovRadius"
- fovMode m = if not $ MovableKind.nsight (mkind m) then Blind else
+ fovMode m = if not $ ActorKind.bsight (akind m) then Blind else
-- terrible, temporary hack
case sensory of
Vision 3 -> Digital radius
@@ -84,9 +84,9 @@ perception_ state@(State { splayer = pl,
-- Perception for a player-controlled monster on the current level.
pper = if isAMonster pl && memActor pl state
then let m = getPlayerBody state
- in Just $ perception (fovMode m) (mloc m) lmap
+ in Just $ perception (fovMode m) (aloc m) lmap
else Nothing
- pers = IM.map (\ h -> perception (fovMode h) (mloc h) lmap) hs
+ pers = IM.map (\ h -> perception (fovMode h) (aloc h) lmap) hs
lpers = maybeToList pper ++ IM.elems pers
reachable = S.unions (L.map preachable lpers)
visible = S.unions (L.map pvisible lpers)
View
4 src/State.hs
@@ -7,7 +7,7 @@ import Control.Monad
import Data.Binary
import qualified Config
-import Movable
+import Actor
import Geometry
import Level
import Dungeon
@@ -21,7 +21,7 @@ import qualified ItemKind
-- TODO: consider changing slevel to LevelName, removing the lname field
-- and not removing the current level from the dungeon.
data State = State
- { splayer :: ActorId, -- ^ represents the player-controlled movable
+ { splayer :: ActorId, -- ^ represents the player-controlled actor
scursor :: Cursor, -- ^ cursor location and level to return to
shistory :: [Message],
ssensory :: SensoryMode,
View
48 src/StrategyState.hs
@@ -11,9 +11,9 @@ import Control.Exception (assert)
import Geometry
import Level
-import Movable
-import MovableState
-import MovableKind
+import Actor
+import ActorState
+import ActorKind
import Random
import Perception
import Strategy
@@ -39,28 +39,28 @@ strategy actor
-- trace (show time ++ ": " ++ show actor) $
strategy
where
- Movable { mkind = mk, mloc = me, mdir = mdir,
- mtarget = tgt, mitems = items } =
+ Actor { akind = mk, aloc = me, adir = adir,
+ atarget = tgt, aitems = items } =
getActor actor oldState
delState = deleteActor actor oldState
enemyVisible a l =
-- We assume monster sight is infravision, so light has no significance.
- nsight mk && actorReachesActor a actor l me per Nothing ||
+ bsight mk && actorReachesActor a actor l me per Nothing ||
-- Any enemy is visible if adjacent (e. g., a monster player).
memActor a delState && adjacent me l
-- If no heroes on the level, monsters go at each other. TODO: let them
-- earn XP by killing each other to make this dangerous to the player.
- hs = L.map (\ (i, m) -> (AHero i, mloc m)) $
+ hs = L.map (\ (i, m) -> (AHero i, aloc m)) $
IM.assocs $ lheroes $ slevel delState
- ms = L.map (\ (i, m) -> (AMonster i, mloc m)) $
+ ms = L.map (\ (i, m) -> (AMonster i, aloc m)) $
IM.assocs $ lmonsters $ slevel delState
-- Below, "foe" is the hero (or a monster, or loc) chased by the actor.
(newTgt, floc) =
case tgt of
TEnemy a ll | focusedMonster ->
case findActorAnyLevel a delState of
Just (_, m) ->
- let l = mloc m
+ let l = aloc m
in if enemyVisible a l
then (TEnemy a l, Just l)
else if isJust (snd closest) || me == ll
@@ -73,7 +73,7 @@ strategy actor
_ -> closest
closest =
let hsAndTraitor = if isAMonster pl
- then (pl, mloc $ getPlayerBody delState) : hs
+ then (pl, aloc $ getPlayerBody delState) : hs
else hs
foes = if L.null hsAndTraitor then ms else hsAndTraitor
-- We assume monster sight is infravision, so light has no effect.
@@ -93,20 +93,20 @@ strategy actor
onlyLoot = onlyMoves lootHere me
exitHere = (\ x -> let t = lmap `at` x in open t && reflects t)
onlyExit = onlyMoves exitHere me
- onlyKeepsDir k = only (\ x -> maybe True (\ d -> distance (d, x) <= k) mdir)
- onlyKeepsDir_9 = only (\ x -> maybe True (\ d -> neg x /= d) mdir)
+ onlyKeepsDir k = only (\ x -> maybe True (\ d -> distance (d, x) <= k) adir)
+ onlyKeepsDir_9 = only (\ x -> maybe True (\ d -> neg x /= d) adir)
onlyNoMs = onlyMoves (unoccupied (levelMonsterList delState)) me
-- Monsters don't see doors more secret than that. Enforced when actually
-- opening doors, too, so that monsters don't cheat. TODO: remove the code
-- duplication, though.
openPower = case strongestItem items "ring" of
- Just i -> niq mk + ipower i
- Nothing -> niq mk
+ Just i -> biq mk + ipower i
+ Nothing -> biq mk
openableHere = openable openPower lmap
onlyOpenable = onlyMoves openableHere me
accessibleHere = accessible lmap me
onlySensible = onlyMoves (\ l -> accessibleHere l || openableHere l) me
- focusedMonster = niq mk > 10
+ focusedMonster = biq mk > 10
smells =
L.map fst $
L.sortBy (\ (_, s1) (_, s2) -> compare s2 s1) $
@@ -130,10 +130,10 @@ strategy actor
let benefit =
(1 + ipower i) * Effect.effectToBenefit (ItemKind.jeffect ik),
benefit > 0,
- nsight mk || not (ItemKind.jname ik == "scroll")]
+ bsight mk || not (ItemKind.jname ik == "scroll")]
actionApply groupName item =
applyGroupItem actor (applyToVerb groupName) item
- throwFreq is multi = if not $ nsight mk then mzero else Frequency
+ throwFreq is multi = if not $ bsight mk then mzero else Frequency
[ (benefit * multi, actionThrow (ItemKind.jname ik) i)
| i <- is,
let ik = ItemKind.getIK (ikind i),
@@ -146,29 +146,29 @@ strategy actor
zapGroupItem actor (fromJust floc) (zapToVerb groupName) item
towardsFreq =
let freqs = runStrategy $ fromDir False moveTowards
- in if nsight mk && not (L.null freqs)
+ in if bsight mk && not (L.null freqs)
then scale 30 $ head freqs
else mzero
moveTowards = onlySensible $ onlyNoMs (towardsFoe moveFreely)
moveAround =
onlySensible $
- (if nsight mk then onlyNoMs else id) $
- nsmell mk .=> L.foldr (.|) reject (L.map return smells)
+ (if bsight mk then onlyNoMs else id) $
+ bsmell mk .=> L.foldr (.|) reject (L.map return smells)
.| onlyOpenable moveFreely
.| moveFreely
moveFreely = onlyLoot moveRandomly
.| onlyExit (onlyKeepsDir 2 moveRandomly)
- .| niq mk > 15 .=> onlyKeepsDir 0 moveRandomly
- .| niq mk > 10 .=> onlyKeepsDir 1 moveRandomly
- .| niq mk > 5 .=> onlyKeepsDir 2 moveRandomly
+ .| biq mk > 15 .=> onlyKeepsDir 0 moveRandomly
+ .| biq mk > 10 .=> onlyKeepsDir 1 moveRandomly
+ .| biq mk > 5 .=> onlyKeepsDir 2 moveRandomly
.| onlyKeepsDir_9 moveRandomly
.| moveRandomly
dirToAction :: ActorId -> Target -> Bool -> Dir -> Action ()
dirToAction actor tgt allowAttacks dir =
assert (dir /= (0,0)) $ do
-- set new direction
- updateAnyActor actor $ \ m -> m { mdir = Just dir, mtarget = tgt }
+ updateAnyActor actor $ \ m -> m { adir = Just dir, atarget = tgt }
-- perform action
tryWith (advanceTime actor) $
-- if the following action aborts, we just advance the time and continue
View
16 src/Turn.hs
@@ -18,8 +18,8 @@ import EffectAction
import Keybindings
import qualified Keys as K
import Level
-import Movable
-import MovableState
+import Actor
+import ActorState
import Random
import State
import Strategy
@@ -65,7 +65,7 @@ handle =
debug "handle"
state <- get
pl <- gets splayer
- let ptime = mtime (getPlayerBody state) -- time of player's next move
+ let ptime = atime (getPlayerBody state) -- time of player's next move
let time = stime state -- current game time
debug $ "handle: time check. ptime = " ++ show ptime ++ ", time = " ++ show time
if ptime > time
@@ -94,10 +94,10 @@ handleMonsters =
pl <- gets splayer
if IM.null ms
then nextMove
- else let order = Ord.comparing (mtime . snd)
+ else let order = Ord.comparing (atime . snd)
(i, m) = L.minimumBy order (IM.assocs ms)
actor = AMonster i
- in if mtime m > time || actor == pl
+ in if atime m > time || actor == pl
then nextMove -- no monster is ready for another move
else handleMonster actor
@@ -138,17 +138,17 @@ handlePlayer =
remember -- the hero perceives his (potentially new) surroundings
-- determine perception before running player command, in case monsters
-- have opened doors ...
- oldPlayerTime <- gets (mtime . getPlayerBody)
+ oldPlayerTime <- gets (atime . getPlayerBody)
withPerception playerCommand -- get and process a player command
-- at this point, the command was successful and possibly took some time
- newPlayerTime <- gets (mtime . getPlayerBody)
+ newPlayerTime <- gets (atime . getPlayerBody)
if newPlayerTime == oldPlayerTime
then withPerception handlePlayer -- no time taken, repeat
else do
state <- get
pl <- gets splayer
let time = stime state
- ploc = mloc (getPlayerBody state)
+ ploc = aloc (getPlayerBody state)
sTimeout = Config.get (sconfig state) "monsters" "smellTimeout"
-- update smell
when (isAHero pl) $ -- only humans leave strong scent

0 comments on commit 22d6553

Please sign in to comment.