Permalink
Browse files

gather all properties of an item in its definition; close #11 (almost)

  • Loading branch information...
1 parent 4e344cc commit f618512daad54a5cabb4793a0fd035b98ced2e63 @Mikolaj Mikolaj committed Mar 26, 2011
Showing with 342 additions and 252 deletions.
  1. +18 −18 src/Actions.hs
  2. +3 −3 src/Dungeon.hs
  3. +20 −17 src/Grammar.hs
  4. +103 −41 src/Item.hs
  5. +157 −119 src/ItemKind.hs
  6. +0 −10 src/ItemState.hs
  7. +3 −7 src/LambdaHack.hs
  8. +4 −6 src/LevelState.hs
  9. +12 −9 src/Movable.hs
  10. +1 −1 src/MovableAdd.hs
  11. +15 −14 src/MovableKind.hs
  12. +3 −2 src/State.hs
  13. +3 −5 src/Terrain.hs
View
@@ -17,7 +17,7 @@ import Geometry
import Grammar
import qualified HighScores as H
import Item
-import ItemKind
+import qualified ItemKind
import ItemState
import qualified Keys as K
import Level
@@ -628,23 +628,22 @@ drinkPotion =
else do
i <- getPotion "What to drink?" items "inventory"
case i of
- Just i'@(Item { ikind = Potion pkind }) ->
+ Just i'@(Item { ikind = ik })
+ | ItemKind.jname (ItemKind.getIK ik) == "potion" ->
do
-- only one potion is consumed even if several
-- are joined in the inventory
let consumed = i' { icount = 1 }
- baseHP = Config.get (sconfig state) "heroes" "baseHP"
removeFromInventory consumed
message (subjectVerbIObject state pbody "drink" consumed "")
-- the potion is identified after drinking
discover i'
- case pkind of
- PotionWater -> messageAdd "Tastes like water."
- PotionHealing -> do
+ case ItemKind.jeffect (ItemKind.getIK (ikind i')) of -- TODO: redo
+ (ItemKind.AffectHP n) -> do
messageAdd "You feel better."
- let php p =
- min (nhpMax (mkind p)) (mhp p + baseHP `div` 4)
+ let php p = min (nhpMax (mkind p)) (mhp p + n)
updatePlayerBody (\ p -> p { mhp = php p })
+ _ -> messageAdd "Tastes like water."
Just _ -> abortWith "you cannot drink that"
Nothing -> neverMind True
playerAdvanceTime
@@ -656,7 +655,7 @@ fireItem = do
pitems <- gets (mitems . getPlayerBody)
pl <- gets splayer
target <- gets (mtarget . getPlayerBody)
- case findItem (\ i -> ikind i == Dart) pitems of
+ case findItem (\ i -> ItemKind.jname (ItemKind.getIK (ikind i)) == "dart") pitems of
Just (dart, _) -> do
let fired = dart { icount = 1 }
removeFromInventory fired
@@ -677,7 +676,7 @@ applyItem = do
state <- get
per <- currentPerception
pitems <- gets (mitems . getPlayerBody)
- case findItem (\ i -> ikind i == Wand) pitems of
+ case findItem (\ i -> ItemKind.jname (ItemKind.getIK (ikind i)) == "wand") pitems of
Just (wand, _) -> do
let applied = wand { icount = 1 }
removeFromInventory applied
@@ -736,7 +735,7 @@ getPotion :: String -> -- prompt
-- e.g., "in your inventory"
Action (Maybe Item)
getPotion prompt is isn =
- let choice i = case ikind i of Potion {} -> True ; _ -> False
+ let choice i = ItemKind.jname (ItemKind.getIK (ikind i)) == "potion"
in getItem prompt choice "Potions" is isn
actorPickupItem :: Actor -> Action ()
@@ -761,7 +760,7 @@ actorPickupItem actor =
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 (icount ni) (ikind ni))
+ then message (letterLabel (iletter ni) ++ objectItem state ni)
else when perceived $
message $ subjectCompoundVerbIObject state movable "pick" "up" i ""
removeFromLoc i loc
@@ -833,8 +832,8 @@ displayItems :: Message -> Bool -> [Item] -> Action Bool
displayItems msg sorted is = do
state <- get
let inv = unlines $
- L.map (\ (Item { icount = c, iletter = l, ikind = t }) ->
- letterLabel l ++ objectItem state c t ++ " ")
+ L.map (\ i ->
+ letterLabel (iletter i) ++ objectItem state i ++ " ")
((if sorted then sortBy (cmpLetter' `on` iletter) else id) is)
let ovl = inv ++ more
message msg
@@ -896,11 +895,12 @@ actorAttackActor (AHero _) target@(AHero _) =
actorAttackActor source target = do
sm <- gets (getActor source)
let -- Determine the weapon used for the attack.
- sword = strongestSword (mitems sm)
- damage = 3 + sword
- weaponMsg = if sword == 0
+ weapon = strongestWeapon (mitems sm)
+ -- TODO: redo
+ damage = case weapon of Just (Item { ikind = ik, ipower = k }) -> (case ItemKind.jeffect (ItemKind.getIK ik) of ItemKind.AffectHP n -> - n + k; _ -> 3) ; _ -> 3
+ weaponMsg = if damage == 3
then ""
- else " with a (+" ++ show sword ++ ") sword" -- TODO: generate proper message
+ else " with a (+" ++ show (damage - 3) ++ ") sword" -- TODO: generate proper message
actorDamageActor source target damage weaponMsg
advanceTime source
View
@@ -307,9 +307,9 @@ rollItems cfg lvl ploc =
nri <- nrItems cfg
replicateM nri $
do
- t <- newItem (depth cfg) ItemKind.itemFrequency
- l <- case ikind t of
- ItemKind.Sword _ ->
+ t <- newItem (depth cfg)
+ l <- case ItemKind.jname (ItemKind.getIK (ikind t)) of
+ "sword" ->
-- swords generated close to monsters; MUAHAHAHA
findLocTry 200 lvl
(const floor)
View
@@ -1,14 +1,16 @@
module Grammar where
import Data.Char
+import Data.Set as S
+import Data.List as L
+import qualified Data.IntMap as IM
import Item
import Movable
import MovableKind
import State
import ItemState
import ItemKind
---import qualified ItemKind
-- | How to refer to a movable in object position of a sentence.
objectMovable :: MovableKind -> String
@@ -32,7 +34,7 @@ subjectVerbIObject :: State -> Movable -> String -> Item -> String -> String
subjectVerbIObject state m v o add =
subjectMovable (mkind m) ++ " " ++
verbMovable (mkind m) v ++ " " ++
- objectItem state (icount o) (ikind o) ++ add ++ "."
+ objectItem state o ++ add ++ "."
subjectVerbMObject :: State -> Movable -> String -> Movable -> String -> String
subjectVerbMObject state m v o add =
@@ -45,7 +47,7 @@ subjectCompoundVerbIObject :: State -> Movable -> String -> String ->
subjectCompoundVerbIObject state m v p o add =
subjectMovable (mkind m) ++ " " ++
compoundVerbMovable (mkind m) v p ++ " " ++
- objectItem state (icount o) (ikind o) ++ add ++ "."
+ objectItem state o ++ add ++ "."
makeObject :: Int -> (String -> String) -> String -> String
makeObject 1 adj obj = let b = adj obj
@@ -54,17 +56,18 @@ makeObject 1 adj obj = let b = adj obj
_ -> "a " ++ b
makeObject n adj obj = show n ++ " " ++ adj (obj ++ "s")
-
-
-
--- MOVE
-objectItem :: State -> Int -> ItemKind -> String
-objectItem _ n Ring = makeObject n id "ring"
-objectItem _ n Scroll = makeObject n id "scroll"
-objectItem s n (Potion t) = makeObject n (identified (sassocs s) (sdiscoveries s) (Potion t)) "potion"
-objectItem _ n Wand = makeObject n id "wand"
-objectItem _ n Amulet = makeObject n id "amulet"
-objectItem _ n Gem = makeObject n id "gem"
-objectItem _ n Gold = makeObject n id "gold piece"
-objectItem _ n (Sword i) = makeObject n id ("(+" ++ show i ++ ") sword")
-objectItem _ n Dart = makeObject n id "dart"
+objectItem :: State -> Item -> String
+objectItem state o =
+ let ik = ikind o
+ kind = ItemKind.getIK ik
+ identified = L.length (jflavour kind) == 1 ||
+ ik `S.member` sdiscoveries state
+ eff = effectToName (jeffect kind)
+ pwr = if ipower o == 0 then "" else " (+" ++ show (ipower o) ++ ")"
+ adj name = if identified
+ then name ++ if jsecret kind == ""
+ then if eff == "" then pwr else " " ++ eff ++ pwr
+ else " " ++ jsecret kind ++ pwr
+ else let flavour = getFlavour (sassocs state) ik
+ in flavourToName flavour ++ " " ++ name
+ in makeObject (icount o) adj (jname kind)
View
@@ -3,40 +3,88 @@ module Item where
import Data.Binary
import Data.Set as S
import Data.List as L
+import qualified Data.IntMap as IM
import Data.Maybe
import Data.Char
import Data.Function
import Control.Monad
import Random
import ItemKind
+import Attr
data Item = Item
- { icount :: Int,
- ikind :: ItemKind,
- iletter :: Maybe Char } -- inventory identifier
+ { ikind :: !Int,
+ ipower :: !Int, -- https://github.com/Mikolaj/LambdaHack/issues#issue/11
+ iletter :: Maybe Char, -- ^ inventory identifier
+ icount :: !Int }
deriving Show
-type Discoveries = S.Set ItemKind
-
-equalItemKind :: Item -> Item -> Bool
-equalItemKind = (==) `on` ikind
-
-equalItemLetter :: Item -> Item -> Bool
-equalItemLetter = (==) `on` iletter
-
instance Binary Item where
- put (Item icount ikind iletter) = put icount >> put ikind >> put iletter
- get = liftM3 Item get get get
+ put (Item ikind ipower iletter icount ) =
+ put ikind >> put ipower >> put iletter >> put icount
+ get = liftM4 Item get get get get
+
+type Assocs = IM.IntMap Flavour
+
+type Discoveries = S.Set Int
+
+-- | Assinges flavours to item kinds. Assures no flavor is repeated,
+-- except for items with only one permitted flavour.
+rollAssocs :: Int -> ItemKind ->
+ Rnd (IM.IntMap Flavour, S.Set Flavour) ->
+ Rnd (IM.IntMap Flavour, S.Set Flavour)
+rollAssocs key kind rnd =
+ if L.length (jflavour kind) == 1
+ then rnd
+ else do
+ (assocs, available) <- rnd
+ let proper = S.fromList (jflavour kind) `S.intersection` available
+ flavour <- oneOf (S.toList proper)
+ return (IM.insert key flavour assocs, S.delete flavour available)
+
+-- | Randomly chooses flavour for all item kinds for this game.
+dungeonAssocs :: Rnd Assocs
+dungeonAssocs =
+ liftM fst $
+ IM.foldWithKey rollAssocs (return (IM.empty, S.fromList stdFlav)) dungeonLoot
+
+getFlavour :: Assocs -> Int -> Flavour
+getFlavour assocs ik =
+ let kind = ItemKind.getIK ik
+ in if L.length (jflavour kind) == 1
+ then head (jflavour kind)
+ else assocs IM.! ik
+
+viewItem :: Int -> Assocs -> (Char, Attr.Color)
+viewItem ik assocs = (jsymbol (getIK ik), getFlavour assocs ik)
+
+-- Not really satisfactory. Should be configurable, not hardcoded.
+itemStrength :: Int -> ItemKind -> Rnd Int
+itemStrength n ik =
+ if jname ik /= "sword"
+ then return 0
+ else do
+ r <- d (2 + n `div` 2)
+ return $ (n + 1) `div` 3 + r
+
+itemLetter :: ItemKind -> Maybe Char
+itemLetter ik = if jsymbol ik == '$' then Just '$' else Nothing
-- | Generate an item.
-newItem :: Int -> Frequency ItemKind -> Rnd Item
-newItem n ftp =
- do
- tp <- frequency ftp
- item <- itemStrength n tp
- nr <- itemQuantity n tp
- return (Item nr item (itemLetter tp))
+newItem :: Int -> Rnd Item
+newItem lvl = do
+ let dLoot = IM.assocs dungeonLoot
+ fik = Frequency $ L.zip (L.map (jfreq . snd) dLoot) (L.map fst dLoot)
+ ikChosen <- frequency fik
+ let kind = getIK ikChosen
+ power <- itemStrength lvl kind
+ let (a', b', c', d') = jquant kind
+ (a, b, c, d) = (fromEnum a', fromEnum b', fromEnum c', fromEnum d')
+ -- a + b * lvl + roll(c + d * lvl)
+ roll <- randomR (0, c + d * lvl)
+ let quant = a + b * lvl + roll
+ return (Item ikChosen power (itemLetter kind) quant)
-- | Assigns a letter to an item, for inclusion
-- in the inventory of a hero. Takes a remembered
@@ -77,13 +125,12 @@ letterRange xs = sectionBy (sortBy cmpLetter xs) Nothing
where
succLetter c d = ord d - ord c == 1
- sectionBy [] Nothing = ""
- sectionBy [] (Just (c,d)) = finish (c,d)
- sectionBy (x:xs) Nothing = sectionBy xs (Just (x,x))
- sectionBy (x:xs) (Just (c,d)) | succLetter d x
- = sectionBy xs (Just (c,x))
- | otherwise
- = finish (c,d) ++ sectionBy xs (Just (x,x))
+ sectionBy [] Nothing = ""
+ sectionBy [] (Just (c,d)) = finish (c,d)
+ sectionBy (x:xs) Nothing = sectionBy xs (Just (x,x))
+ sectionBy (x:xs) (Just (c,d))
+ | succLetter d x = sectionBy xs (Just (c,x))
+ | otherwise = finish (c,d) ++ sectionBy xs (Just (x,x))
finish (c,d) | c == d = [c]
| succLetter c d = [c,d]
@@ -95,15 +142,16 @@ letterLabel (Just c) = c : " - "
-- | Adds an item to a list of items, joining equal items.
-- Also returns the joined item.
-joinItem :: Item -> [Item] -> (Item,[Item])
-joinItem i is = case findItem (equalItemKind i) is of
- Nothing -> (i, i : is)
- Just (j,js) -> let n = i { icount = icount i + icount j,
- iletter = mergeLetter (iletter j) (iletter i) }
- in (n, n : js)
-
--- | Removes an item from a list of items. Takes an equality function (i.e., by letter or
--- ny kind) as an argument.
+joinItem :: Item -> [Item] -> (Item, [Item])
+joinItem i is =
+ case findItem (equalItemKindAndPower i) is of
+ Nothing -> (i, i : is)
+ Just (j,js) -> let n = i { icount = icount i + icount j,
+ iletter = mergeLetter (iletter j) (iletter i) }
+ in (n, n : js)
+
+-- | Removes an item from a list of items.
+-- Takes an equality function (i.e., by letter or ny kind) as an argument.
removeItemBy :: (Item -> Item -> Bool) -> Item -> [Item] -> [Item]
removeItemBy eq i = concatMap $ \ x ->
if eq i x
@@ -113,9 +161,19 @@ removeItemBy eq i = concatMap $ \ x ->
else []
else [x]
-removeItemByLetter = removeItemBy equalItemLetter
+equalItemKindAndPower :: Item -> Item -> Bool
+equalItemKindAndPower i1 i2 = equalItemKind i1 i2 && ipower i1 == ipower i2
+
+equalItemKind :: Item -> Item -> Bool
+equalItemKind = (==) `on` (jname . getIK . ikind)
+
removeItemByKind = removeItemBy equalItemKind
+equalItemLetter :: Item -> Item -> Bool
+equalItemLetter = (==) `on` iletter
+
+removeItemByLetter = removeItemBy equalItemLetter
+
-- | Finds an item in a list of items.
findItem :: (Item -> Bool) -> [Item] -> Maybe (Item, [Item])
findItem p is = findItem' [] is
@@ -125,8 +183,12 @@ findItem p is = findItem' [] is
| p i = Just (i, reverse acc ++ is)
| otherwise = findItem' (i:acc) is
-strongestSword :: [Item] -> Int
-strongestSword l =
- let aux acc (Item { ikind = Sword i }) = max acc i
+strongestWeapon :: [Item] -> Maybe Item
+strongestWeapon l =
+ let strength (Item { ipower = n }) = n
+ aux Nothing item
+ | strength item > 0 = Just item
+ aux (Just max) item
+ | strength item > strength max = Just item
aux acc _ = acc
- in foldl' aux 0 l
+ in foldl' aux Nothing l
Oops, something went wrong.

0 comments on commit f618512

Please sign in to comment.