split Item in two, the half containing item definitions is ItemKind

LambdaHack.cabal

@@ -28,7 +28,7 @@ executable LambdaHack
                  Display, Dungeon, DungeonState, File,
                  FOV, FOV.Common, FOV.Digital, FOV.Permissive, FOV.Shadow,
                  Frequency, Geometry, GeometryRnd, Grammar,
-                 HighScores, Item, ItemState,
+                 HighScores, Item, ItemKind, ItemState,
                  Keys, Keybindings, LambdaHack, Level, LevelState,
                  Message, MovableAdd, MovableKind, Movable, MovableState,
                  Multiline, Perception, Random,

src/Actions.hs

@@ -17,6 +17,7 @@ import Geometry
 import Grammar
 import qualified HighScores as H
 import Item
+import ItemKind
 import ItemState
 import qualified Keys as K
 import Level

src/Dungeon.hs

@@ -16,6 +16,7 @@ import Level
 import Item
 import Random
 import Terrain
+import qualified ItemKind
 
 -- | The complete dungeon is a map from level names to levels.
 -- We usually store all but the current level in this data structure.
@@ -306,9 +307,9 @@ rollItems cfg lvl ploc =
     nri <- nrItems cfg
     replicateM nri $
       do
-        t <- newItem (depth cfg) itemFrequency
+        t <- newItem (depth cfg) ItemKind.itemFrequency
         l <- case ikind t of
-               Sword _ ->
+               ItemKind.Sword _ ->
                  -- swords generated close to monsters; MUAHAHAHA
                  findLocTry 200 lvl
                    (const floor)

src/Grammar.hs

@@ -7,6 +7,8 @@ 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
@@ -26,19 +28,6 @@ subjectMovableVerb x v = subjectMovable x ++ " " ++ verbMovable x v
 compoundVerbMovable :: MovableKind -> String -> String -> String
 compoundVerbMovable m v p = verbMovable m v ++ " " ++ p
 
--- TODO: move the item names to Item.hs and make the code below
--- independent on what item kinds are defined
-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"
-
 subjectVerbIObject :: State -> Movable -> String -> Item -> String -> String
 subjectVerbIObject state m v o add =
   subjectMovable (mkind m) ++ " " ++
@@ -57,3 +46,25 @@ subjectCompoundVerbIObject state m v p o add =
   subjectMovable (mkind m) ++ " " ++
   compoundVerbMovable (mkind m) v p ++ " " ++
   objectItem state (icount o) (ikind o) ++ add ++ "."
+
+makeObject :: Int -> (String -> String) -> String -> String
+makeObject 1 adj obj = let b = adj obj
+                       in  case b of
+                             (c:_) | c `elem` "aeio" -> "an " ++ b
+                             _                       -> "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"

src/Item.hs

@@ -1,49 +1,22 @@
 module Item where
 
 import Data.Binary
-import qualified Data.Binary.Put as Put
-import qualified Data.Binary.Get as Get
-import Data.Map as M
 import Data.Set as S
 import Data.List as L
 import Data.Maybe
 import Data.Char
 import Data.Function
 import Control.Monad
 
-import qualified Attr
-import Geometry
 import Random
+import ItemKind
 
 data Item = Item
              { icount  :: Int,
                ikind   :: ItemKind,
                iletter :: Maybe Char }  -- inventory identifier
   deriving Show
 
-data ItemKind =
-   Ring
- | Scroll
- | Potion PotionKind
- | Wand
- | Amulet
- | Gem
- | Gold
- | Sword Int
- | Dart
- deriving (Eq, Ord, Show)
-
-data PotionKind =
-    PotionWater
-  | PotionHealing
-  deriving (Show, Eq, Ord, Enum, Bounded)
-
-data Appearance =
-    Clear
-  | White
-  deriving (Show, Eq, Ord, Enum, Bounded)
-
-type Assocs = M.Map ItemKind Appearance
 type Discoveries = S.Set ItemKind
 
 equalItemKind :: Item -> Item -> Bool
@@ -52,81 +25,10 @@ equalItemKind = (==) `on` ikind
 equalItemLetter :: Item -> Item -> Bool
 equalItemLetter = (==) `on` iletter
 
-potionKind :: PotionKind -> String -> String
-potionKind PotionWater   s = s ++ " of water"
-potionKind PotionHealing s = s ++ " of healing"
-
-appearance :: Appearance -> String -> String
-appearance Clear s = "clear " ++ s
-appearance White s = "white " ++ s
-
 instance Binary Item where
   put (Item icount ikind iletter) = put icount >> put ikind >> put iletter
   get = liftM3 Item get get get
 
-instance Binary ItemKind where
-  put Ring       = Put.putWord16le 0
-  put Scroll     = Put.putWord16le 1
-  put (Potion t) = Put.putWord16le 2 >> put t
-  put Wand       = Put.putWord16le 3
-  put Amulet     = Put.putWord16le 4
-  put Gem        = Put.putWord16le 5
-  put Gold       = Put.putWord16le 6
-  put (Sword i)  = Put.putWord16le 7 >> put i
-  put Dart       = Put.putWord16le 8
-  get = do
-          tag <- Get.getWord16le
-          case tag of
-            0 -> return Ring
-            1 -> return Scroll
-            2 -> liftM Potion get
-            3 -> return Wand
-            4 -> return Amulet
-            5 -> return Gem
-            6 -> return Gold
-            7 -> liftM Sword get
-            8 -> return Dart
-
-instance Binary PotionKind where
-  put = putWord8 . fromIntegral . fromEnum
-  get = liftM (toEnum . fromIntegral) getWord8
-
-instance Binary Appearance where
-  put = putWord8 . fromIntegral . fromEnum
-  get = liftM (toEnum . fromIntegral) getWord8
-
-itemFrequency :: Frequency ItemKind
-itemFrequency =
-  Frequency
-  [
-    (80, Gold),
-    (70,  Sword (-1)),
-    (40,  Dart),
-    (20,  Gem),
-    (10,  Ring),
-    (10,  Scroll),
-    (30,  Wand),
-    (10,  Amulet),
-    (30,  Potion PotionWater),
-    (20,  Potion PotionHealing)
-  ]
-
-itemQuantity :: Int -> ItemKind -> Rnd Int
-itemQuantity n Gold = (2 * n) *~ d 8
-itemQuantity _ Dart = 3 *~ d 3
-itemQuantity _ _    = return 1
-
-itemStrength :: Int -> ItemKind -> Rnd ItemKind
-itemStrength n (Sword _) =
-  do
-    r <- d (2 + n `div` 2)
-    return $ Sword $ (n + 1) `div` 3 + r
-itemStrength _ tp        = return tp
-
-itemLetter :: ItemKind -> Maybe Char
-itemLetter Gold = Just '$'
-itemLetter _    = Nothing
-
 -- | Generate an item.
 newItem :: Int -> Frequency ItemKind -> Rnd Item
 newItem n ftp =
@@ -191,23 +93,6 @@ letterLabel :: Maybe Char -> String
 letterLabel Nothing  = "    "
 letterLabel (Just c) = c : " - "
 
-viewItem :: ItemKind -> Assocs -> (Char, Attr.Color)
-viewItem i a = viewItem' i (M.lookup i a)
-  where
-    def = Attr.defFG
-    viewItem' (Sword {})  _            = (')', def)
-    viewItem' Dart        _            = (')', def)
-    viewItem' Ring        _            = ('=', def)
-    viewItem' Scroll      _            = ('?', def)
-    viewItem' (Potion {}) (Just Clear) = ('!', Attr.BrBlue)
-    viewItem' (Potion {}) (Just White) = ('!', Attr.BrCyan)
-    viewItem' (Potion {}) _            = ('!', def)
-    viewItem' Wand        _            = ('/', def)
-    viewItem' Gold        _            = ('$', Attr.BrYellow)
-    viewItem' Gem         _            = ('*', Attr.BrMagenta)
-    viewItem' Amulet      _            = ('"', def)
-    viewItem' _           _            = ('~', def)
-
 -- | Adds an item to a list of items, joining equal items.
 -- Also returns the joined item.
 joinItem :: Item -> [Item] -> (Item,[Item])
@@ -245,10 +130,3 @@ strongestSword l =
   let aux acc (Item { ikind = Sword i }) = max acc i
       aux acc _ = acc
   in  foldl' aux 0 l
-
-makeObject :: Int -> (String -> String) -> String -> String
-makeObject 1 adj obj = let b = adj obj
-                       in  case b of
-                             (c:_) | c `elem` "aeio" -> "an " ++ b
-                             _                       -> "a " ++ b
-makeObject n adj obj = show n ++ " " ++ adj (obj ++ "s")

src/ItemKind.hs

@@ -0,0 +1,122 @@
+module ItemKind where
+
+import Data.Binary
+import qualified Data.Binary.Put as Put
+import qualified Data.Binary.Get as Get
+import Data.Map as M
+import Control.Monad
+
+import qualified Attr
+import Random
+
+data ItemKind =
+   Ring
+ | Scroll
+ | Potion PotionKind
+ | Wand
+ | Amulet
+ | Gem
+ | Gold
+ | Sword Int
+ | Dart
+ deriving (Eq, Ord, Show)
+
+data PotionKind =
+    PotionWater
+  | PotionHealing
+  deriving (Show, Eq, Ord, Enum, Bounded)
+
+data Appearance =
+    Clear
+  | White
+  deriving (Show, Eq, Ord, Enum, Bounded)
+
+type Assocs = M.Map ItemKind Appearance
+
+instance Binary ItemKind where
+  put Ring       = Put.putWord16le 0
+  put Scroll     = Put.putWord16le 1
+  put (Potion t) = Put.putWord16le 2 >> put t
+  put Wand       = Put.putWord16le 3
+  put Amulet     = Put.putWord16le 4
+  put Gem        = Put.putWord16le 5
+  put Gold       = Put.putWord16le 6
+  put (Sword i)  = Put.putWord16le 7 >> put i
+  put Dart       = Put.putWord16le 8
+  get = do
+          tag <- Get.getWord16le
+          case tag of
+            0 -> return Ring
+            1 -> return Scroll
+            2 -> liftM Potion get
+            3 -> return Wand
+            4 -> return Amulet
+            5 -> return Gem
+            6 -> return Gold
+            7 -> liftM Sword get
+            8 -> return Dart
+
+instance Binary PotionKind where
+  put = putWord8 . fromIntegral . fromEnum
+  get = liftM (toEnum . fromIntegral) getWord8
+
+instance Binary Appearance where
+  put = putWord8 . fromIntegral . fromEnum
+  get = liftM (toEnum . fromIntegral) getWord8
+
+potionKind :: PotionKind -> String -> String
+potionKind PotionWater   s = s ++ " of water"
+potionKind PotionHealing s = s ++ " of healing"
+
+appearance :: Appearance -> String -> String
+appearance Clear s = "clear " ++ s
+appearance White s = "white " ++ s
+
+itemFrequency :: Frequency ItemKind
+itemFrequency =
+  Frequency
+  [
+    (80, Gold),
+    (70,  Sword (-1)),
+    (40,  Dart),
+    (20,  Gem),
+    (10,  Ring),
+    (10,  Scroll),
+    (30,  Wand),
+    (10,  Amulet),
+    (30,  Potion PotionWater),
+    (20,  Potion PotionHealing)
+  ]
+
+itemQuantity :: Int -> ItemKind -> Rnd Int
+itemQuantity n Gold = (2 * n) *~ d 8
+itemQuantity _ Dart = 3 *~ d 3
+itemQuantity _ _    = return 1
+
+itemStrength :: Int -> ItemKind -> Rnd ItemKind
+itemStrength n (Sword _) =
+  do
+    r <- d (2 + n `div` 2)
+    return $ Sword $ (n + 1) `div` 3 + r
+itemStrength _ tp        = return tp
+
+itemLetter :: ItemKind -> Maybe Char
+itemLetter Gold = Just '$'
+itemLetter _    = Nothing
+
+viewItem :: ItemKind -> Assocs -> (Char, Attr.Color)
+viewItem i a = viewItem' i (M.lookup i a)
+  where
+    def = Attr.defFG
+    viewItem' (Sword {})  _            = (')', def)
+    viewItem' Dart        _            = (')', def)
+    viewItem' Ring        _            = ('=', def)
+    viewItem' Scroll      _            = ('?', def)
+    viewItem' (Potion {}) (Just Clear) = ('!', Attr.BrBlue)
+    viewItem' (Potion {}) (Just White) = ('!', Attr.BrCyan)
+    viewItem' (Potion {}) _            = ('!', def)
+    viewItem' Wand        _            = ('/', def)
+    viewItem' Gold        _            = ('$', Attr.BrYellow)
+    viewItem' Gem         _            = ('*', Attr.BrMagenta)
+    viewItem' Amulet      _            = ('"', def)
+    viewItem' _           _            = ('~', def)

src/ItemState.hs

@@ -5,6 +5,7 @@ import Data.Map as M
 import Data.List as L
 
 import Item
+import ItemKind
 import State
 import Movable
 import MovableState

src/LambdaHack.hs

@@ -13,6 +13,7 @@ import Turn
 import qualified Config
 import MovableAdd
 import Item
+import ItemKind
 
 main :: IO ()
 main = Display.startup start