Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

reindent and comment ItemAction.hs before extending it

  • Loading branch information...
commit c529e07f68d26484f27f9ebc8512ccdab0755093 1 parent 6a8b25f
Mikolaj Konarski Mikolaj authored
5 src/EffectAction.hs
View
@@ -84,7 +84,7 @@ effectToAction (Effect.Wound nDm) source target power msg = do
updateAnyActor target $ \ m -> m { mhp = newHP } -- Damage the target.
when killed $ do
-- Place the actor's possessions on the map.
- dropItemsAt (mitems tm) (mloc tm)
+ modify (updateLevel (dropItemsAt (mitems tm) (mloc tm)))
-- Clean bodies up.
pl <- gets splayer
if target == pl
@@ -237,9 +237,6 @@ calculateTotal :: State -> Int
calculateTotal s =
L.sum $ L.map itemPrice $ L.concatMap mitems (levelHeroList s)
-dropItemsAt :: [Item] -> Loc -> Action ()
-dropItemsAt is loc = modify (updateLevel (scatterItems is loc))
-
-- | 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
-- information about the nature of the items.
4 src/Grammar.hs
View
@@ -52,9 +52,9 @@ subjectVerbMObject m v o add =
verbMovable (mkind m) v ++ " " ++
objectMovable (mkind o) ++ add ++ "."
-subjectCompoundVerbIObject :: State -> Movable -> String -> String ->
+subjCompoundVerbIObj :: State -> Movable -> String -> String ->
Item -> String -> String
-subjectCompoundVerbIObject state m v p o add =
+subjCompoundVerbIObj state m v p o add =
subjectMovable (mkind m) ++ " " ++
compoundVerbMovable (mkind m) v p ++ " " ++
objectItem state o ++ add ++ "."
2  src/Item.hs
View
@@ -135,6 +135,8 @@ letterLabel (Just c) = c : " - "
-- | Adds an item to a list of items, joining equal items.
-- Also returns the joined item.
+-- TODO: the resulting list can contain items with the same letter.
+-- TODO: name [Item] Inventory and have some invariants, e.g. no equal letters.
joinItem :: Item -> [Item] -> (Item, [Item])
joinItem i is =
case findItem (equalItemIdentity i) is of
194 src/ItemAction.hs
View
@@ -41,15 +41,14 @@ import EffectAction
-- | Display inventory
inventory :: Action a
-inventory =
- do
- items <- gets (mitems . getPlayerBody)
- if L.null items
- then abortWith "You are not carrying anything"
- else do
- displayItems "This is what you are carrying:" True items
- session getConfirm
- abortWith ""
+inventory = do
+ items <- gets (mitems . getPlayerBody)
+ if L.null items
+ then abortWith "You are not carrying anything"
+ else do
+ displayItems "This is what you are carrying:" True items
+ session getConfirm
+ abortWith ""
-- | Let the player choose any item with a given group name.
-- Note that this does not guarantee an item from the group to be chosen,
@@ -75,7 +74,7 @@ applyGroupItem groupName verb = do
then abortWith "You are not carrying anything."
else do
iOpt <- getGroupItem is groupName
- ("What to " ++ verb ++ "?") "in your inventory"
+ ("What to " ++ verb ++ "?") "in your inventory"
case iOpt of
Just item@(Item { ikind = ik }) -> do
-- only one item consumed, even if several in inventory
@@ -85,7 +84,7 @@ applyGroupItem groupName verb = do
consumed = item { icount = 1 }
message (subjectVerbIObject state pbody v consumed "")
pl <- gets splayer
- b <- itemEffectAction consumed pl pl
+ b <- itemEffectAction consumed pl pl
when b $ removeFromInventory consumed
Nothing -> neverMind True
playerAdvanceTime
@@ -104,7 +103,7 @@ zapGroupItem groupName verb = do
then abortWith "You are not carrying anything."
else do
iOpt <- getGroupItem is groupName
- ("What to " ++ verb ++ "?") "in your inventory"
+ ("What to " ++ verb ++ "?") "in your inventory"
case iOpt of
Just item@(Item { ikind = ik }) -> do
-- only one item consumed, even if several in inventory
@@ -122,10 +121,10 @@ zapGroupItem groupName verb = do
Just ta -> do
b <- itemEffectAction consumed pl ta
when (not b) $
- modify (updateLevel (scatterItems [consumed] loc))
+ modify (updateLevel (dropItemsAt [consumed] loc))
Nothing -> do
message (subjectVerbIObject state pbody verb consumed "")
- modify (updateLevel (scatterItems [consumed] loc))
+ modify (updateLevel (dropItemsAt [consumed] loc))
else abortWith "target not reachable"
Nothing -> neverMind True
playerAdvanceTime
@@ -143,24 +142,22 @@ throwItem :: Action ()
throwItem = zapGroupItem "dart" "throw"
dropItem :: Action ()
-dropItem =
- do
- state <- get
- pbody <- gets getPlayerBody
- ploc <- gets (mloc . getPlayerBody)
- items <- gets (mitems . getPlayerBody)
- if L.null items
- then abortWith "You are not carrying anything."
- else do
- i <- getAnyItem "What to drop?" items "inventory"
- case i of
- Just i' ->
- do
- removeFromInventory i'
- message (subjectVerbIObject state pbody "drop" i' "")
- dropItemsAt [i'] ploc
- Nothing -> neverMind True
- playerAdvanceTime
+dropItem = do
+ state <- get
+ pbody <- gets getPlayerBody
+ ploc <- gets (mloc . getPlayerBody)
+ items <- gets (mitems . getPlayerBody)
+ if L.null items
+ then abortWith "You are not carrying anything."
+ else do
+ iOpt <- getAnyItem "What to drop?" items "inventory"
+ case iOpt of
+ Just i -> do
+ removeFromInventory i
+ message (subjectVerbIObject state pbody "drop" i "")
+ modify (updateLevel (dropItemsAt [i] ploc))
+ Nothing -> neverMind True
+ playerAdvanceTime
-- | Remove given item from the hero's inventory.
removeFromInventory :: Item -> Action ()
@@ -171,58 +168,63 @@ removeFromInventory i =
removeFromLoc :: Item -> Loc -> Action ()
removeFromLoc i loc =
modify (updateLevel (updateLMap adj))
- where
- adj = M.adjust (\ (t, rt) -> (remove t, rt)) loc
- remove t = t { titems = removeItemByIdentity i (titems t) }
+ where
+ adj = M.adjust (\ (t, rt) -> (remove t, rt)) loc
+ remove t = t { titems = removeItemByIdentity i (titems t) }
actorPickupItem :: Actor -> Action ()
-actorPickupItem actor =
- do
- state <- get
- pl <- gets splayer
- per <- currentPerception
- lmap <- gets (lmap . slevel)
- movable <- gets (getActor actor)
- let loc = mloc movable
- let t = lmap `at` loc -- the map tile in question
- let perceived = loc `S.member` ptvisible per
- let 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 movable) (mitems movable) of
- Just l ->
- do
- let (ni, nitems) = joinItem (i { iletter = Just l }) (mitems movable)
- -- message is dependent on who picks up and if the hero can perceive it
- if isPlayer
- then message (letterLabel (iletter ni) ++ objectItem state ni)
- else when perceived $
- message $ subjectCompoundVerbIObject state movable "pick" "up" i ""
- removeFromLoc i loc
- -- add item to actor's inventory:
- updateAnyActor actor $ \ m ->
- m { mitems = nitems, mletter = maxLetter l (mletter movable) }
- Nothing -> abortIfWith isPlayer "you cannot carry any more"
- advanceTime actor
+actorPickupItem actor = do
+ state <- get
+ pl <- gets splayer
+ per <- currentPerception
+ lmap <- gets (lmap . slevel)
+ body <- gets (getActor actor)
+ let loc = mloc 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
+ Just l -> do
+ let (ni, nitems) = joinItem (i { iletter = Just l }) (mitems body)
+ -- message depends on who picks up and if a hero can perceive it
+ if isPlayer
+ then message (letterLabel (iletter ni) ++ objectItem state ni)
+ else when perceived $
+ message $ subjCompoundVerbIObj state body "pick" "up" i ""
+ removeFromLoc i loc
+ -- add item to actor's inventory:
+ updateAnyActor actor $ \ m ->
+ m { mitems = nitems, mletter = maxLetter l (mletter body) }
+ Nothing -> abortIfWith isPlayer "you cannot carry any more"
+ advanceTime actor
pickupItem :: Action ()
pickupItem = do
pl <- gets splayer
actorPickupItem pl
--- TODO: I think that player handlers should be wrappers around more general actor handlers, but
--- the actor handlers should be performing specific actions, i.e., already specify the item to be
--- picked up. It doesn't make sense to invoke dialogues for arbitrary actors, and most likely the
--- decision for a monster is based on perceiving a particular item to be present, so it's already
--- known. In actor handlers we should make sure that messages are printed to the player only if the
+-- TODO: I think that player handlers should be wrappers
+-- around more general actor handlers, but
+-- the actor handlers should be performing
+-- specific actions, i.e., already specify the item to be
+-- picked up. It doesn't make sense to invoke dialogues
+-- for arbitrary actors, and most likely the
+-- decision for a monster is based on perceiving
+-- a particular item to be present, so it's already
+-- known. In actor handlers we should make sure
+-- that messages are printed to the player only if the
-- hero can perceive the action.
+-- Perhaps this means half of this code should be split and moved
+-- to ItemState, to be independent of any IO code from Action/Display.
-- | Let the player choose any item from a list of items.
getAnyItem :: String -> -- prompt
[Item] -> -- all objects in question
- String -> -- how to refer to the collection of objects, e.g. "in your inventory"
+ String -> -- how to refer to the collection of objects
Action (Maybe Item)
getAnyItem prompt is isn = getItem prompt (const True) "Objects" is isn
@@ -231,29 +233,33 @@ getItem :: String -> -- prompt message
(Item -> Bool) -> -- which items to consider suitable
String -> -- how to describe suitable objects
[Item] -> -- all objects in question
- String -> -- how to refer to the collection of objects, e.g. "in your inventory"
+ String -> -- how to refer to the collection of objects
Action (Maybe Item)
getItem prompt p ptext is0 isn =
let is = L.filter p is0
- choice | L.null is = "[*, ESC]"
- | otherwise = "[" ++ letterRange (concatMap (maybeToList . iletter) is) ++ ", ?, *, RET, ESC]"
- r = do
- message (prompt ++ " " ++ choice)
- display
- let h = session nextCommand >>= h'
- h' e = case e of
- K.Char '?' -> do
- -- filter for supposedly suitable objects
- b <- displayItems (ptext ++ " " ++ isn) True is
- if b then session (getOptionalConfirm (const r) h')
- else r
- K.Char '*' -> do
- -- show all objects
- b <- displayItems ("Objects " ++ isn) True is0
- if b then session (getOptionalConfirm (const r) h')
- else r
- K.Char l -> return (find (\ i -> maybe False (== l) (iletter i)) is0)
- K.Return -> return (case is of [] -> Nothing ; i : _ -> Just i)
- _ -> return Nothing
- h
- in r
+ choice = if L.null is
+ then "[*, ESC]"
+ else let r = letterRange (concatMap (maybeToList . iletter) is)
+ in "[" ++ r ++ ", ?, *, RET, ESC]"
+ interact = do
+ message (prompt ++ " " ++ choice)
+ display
+ session nextCommand >>= perform
+ perform command =
+ case command of
+ K.Char '?' -> do
+ -- filter for supposedly suitable objects
+ b <- displayItems (ptext ++ " " ++ isn) True is
+ if b then session (getOptionalConfirm (const interact) perform)
+ else interact
+ K.Char '*' -> do
+ -- show all objects
+ b <- displayItems ("Objects " ++ isn) True is0
+ if b then session (getOptionalConfirm (const interact) perform)
+ else interact
+ K.Char l ->
+ return (find (\ i -> maybe False (== l) (iletter i)) is0)
+ K.Return -> -- TODO: i should be the first displayed (except $)
+ return (case is of [] -> Nothing ; i : _ -> Just i)
+ _ -> return Nothing
+ in interact
6 src/Level.hs
View
@@ -196,9 +196,9 @@ findLocTry k l@(Level { lsize = sz, lmap = lm }) p pTry =
then findLocTry (k - 1) l p pTry
else findLoc l p
--- Actually, do not scatter the items around, it's too much work for the player.
-scatterItems :: [Item] -> Loc -> Level -> Level
-scatterItems items loc lvl@(Level { lmap = lmap }) =
+-- Actually, do not scatter items around, it's too much work for the player.
+dropItemsAt :: [Item] -> Loc -> Level -> Level
+dropItemsAt items loc lvl@(Level { lmap = lmap }) =
let joinItems items = L.foldl' (\ acc i -> snd (joinItem i acc)) items
t = lmap `at` loc
nt = t { titems = joinItems items (titems t) }
Please sign in to comment.
Something went wrong with that request. Please try again.