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

src/Actions.hs

@@ -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
 

src/Dungeon.hs

@@ -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)

src/Grammar.hs

@@ -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)

src/Item.hs

@@ -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