Keep inventory as intmap, start to allow items of different sizes

src/Dodge/Data.hs

@@ -341,7 +341,7 @@ data Item
         , _itID         :: Maybe Int
         , _itEffect     :: ItEffect
         , _itInvSize    :: Int
-        , _itInvDisplay :: Item -> String
+        , _itInvDisplay :: Item -> [String]
         , _itInvColor   :: Color
         , _itTargeting :: Maybe (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture)
         , _itDimension  :: ItemDimension
@@ -358,7 +358,7 @@ data Item
         , _itEquipPict :: Creature -> Int -> SPic
         , _itIdentity :: ItemIdentity
         , _itID :: Maybe Int
-        , _itInvDisplay :: Item -> String
+        , _itInvDisplay :: Item -> [String]
         , _itInvColor :: Color
         , _itEffect :: ItEffect
         , _itCurseStatus :: CurseStatus
@@ -372,7 +372,7 @@ data Item
         , _itEquipPict :: Creature -> Int -> SPic
         , _itIdentity :: ItemIdentity
         , _itID :: Maybe Int
-        , _itInvDisplay :: Item -> String
+        , _itInvDisplay :: Item -> [String]
         , _itInvColor :: Color
         , _itCurseStatus :: CurseStatus
         , _itDimension  :: ItemDimension
@@ -385,7 +385,7 @@ data Item
         , _itEffect :: ItEffect
         , _itID :: Maybe Int
         , _itZoom :: ItZoom
-        , _itInvDisplay :: Item -> String
+        , _itInvDisplay :: Item -> [String]
         , _itInvColor :: Color
         , _itCurseStatus :: CurseStatus
         , _itDimension  :: ItemDimension
@@ -403,7 +403,7 @@ data Item
         , _itIdentity   :: ItemIdentity
         , _itID         :: Maybe Int
         , _itAttachment :: ItAttachment
-        , _itInvDisplay :: Item -> String
+        , _itInvDisplay :: Item -> [String]
         , _itInvColor   :: Color
         , _itEffect     :: ItEffect
         , _itScroll     :: Float -> Creature -> Item -> Item

src/Dodge/Default.hs

@@ -140,7 +140,7 @@ defaultEquipment = Equipment
     , _itID = Nothing
     , _itZoom    = defaultItZoom
     , _itInvColor = yellow
-    , _itInvDisplay = _itName
+    , _itInvDisplay = \it -> [_itName it]
     , _itDimension = defaultItemDimension
     }
 defaultItZoom :: ItZoom
@@ -157,7 +157,7 @@ defaultConsumable = Consumable
     , _itEquipPict = \_ _ -> (,) emptySH blank
     , _itID = Nothing
     , _itInvColor = blue
-    , _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it)
+    , _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount it)]
     , _itEffect = NoItEffect
     , _itDimension = defaultItemDimension
     }
@@ -204,7 +204,7 @@ defaultIt = Consumable
     , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ square 3
     , _itEquipPict = \_ _ -> (,) emptySH blank
     , _itID = Nothing
-    , _itInvDisplay = _itName
+    , _itInvDisplay = (:[]) . _itName
     , _itInvColor = blue
     , _itEffect = NoItEffect
     }

src/Dodge/Item.hs

@@ -20,7 +20,7 @@ keyToken n = defaultEquipment
     , _itID = Nothing
 --    , _itZoom = defaultItZoom
     , _itInvColor = yellow
-    , _itInvDisplay = _itName
+    , _itInvDisplay = (:[]) . _itName
     }
 keyPic :: Picture
 keyPic = color green $
@@ -41,7 +41,6 @@ latchkey n = defaultEquipment
     , _itID = Nothing
 --    , _itZoom = defaultItZoom
     , _itInvColor = yellow
-    , _itInvDisplay = _itName
     }
 latchkeyPic :: Picture
 latchkeyPic = color yellow $

src/Dodge/Item/Craftable.hs

@@ -17,6 +17,6 @@ pipe = Craftable
         $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
     , _itEquipPict = \_ _ -> mempty
     , _itID = Nothing
-    , _itInvDisplay = _itName
+    , _itInvDisplay = (:[]) . _itName
     , _itInvColor = green
     }

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -257,6 +257,7 @@ miniGun = defaultAutoGun
     , _itEquipPict = pictureWeaponAim miniGunPictItem
     , _itTweaks = defaultBulletSelTweak
     , _itInvSize = 2
+    , _itInvDisplay = \it -> basicWeaponDisplay it ++ ["    COLD"]
     } & itDimension . muzzleLength .~ 15
   where
     recoilAmount = 5

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -11,8 +11,8 @@ import Data.Maybe
 import Data.Sequence
 import Control.Lens
 {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
-basicWeaponDisplay :: Item -> String
+basicWeaponDisplay :: Item -> [String]
-basicWeaponDisplay it = midPadL 10 ' ' thename (' ' : thenumber) ++ theparam
+basicWeaponDisplay it = [midPadL 10 ' ' thename (' ' : thenumber) ++ theparam]
   where 
     thename  = _itName it
     thenumber = case it ^? itConsumption of

src/Dodge/Render/HUD.hs

@@ -38,24 +38,37 @@ drawInventory cfig w = subInventoryDisplay cfig w `appendPic` displayInv 0 cfig
 
 subInventoryDisplay :: Configuration -> World -> Picture
 subInventoryDisplay cfig w = case _inventoryMode w of
-    LockedInventory -> topInvCursor col iPos cfig w
+    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
     TopInventory -> pictures
         [ closeObjectTexts cfig w
-        , topInvCursor col iPos cfig w
+--        , topInvCursor col cursPos cfig w
         ]
     TweakInventory -> pictures
         [ mCurs it cfig w
-        , cursorAt 120 col 5 0 iPos cfig
+        , cursorAt 120 col 5 0 cursPos cfig
-        , cursorsZ cfig iPos it
+        , cursorsZ cfig cursPos it
         , displayMidList cfig (ammoTweakStrings it) "TWEAK"
         ]
     CombineInventory -> invHead cfig "COMBINE"
     InspectInventory -> invHead cfig "INSPECT"
   where 
     itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
-    iPos = _crInvSel $ _creatures w IM.! _yourID w
+    cr = you w
     it = yourItem w
     col = itCol it
+    cursPos = crInvSelPos cr
+
+crInvSelSize :: Creature -> Int
+crInvSelSize cr = theitinvsize $ _crInv cr IM.! _crInvSel cr
+  where
+    theitinvsize NoItem = 1       -- this should be removable later
+    theitinvsize x = _itInvSize x
+
+crInvSelPos :: Creature -> Int
+crInvSelPos cr = sum . fmap theitinvsize . fst $ IM.split (_crInvSel cr) (_crInv cr)
+  where
+    theitinvsize NoItem = 1       -- this should be removable later
+    theitinvsize x = _itInvSize x
 
 cursorsZ :: Configuration -> Int -> Item -> Picture
 cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of
@@ -67,13 +80,6 @@ cursorsZ cfig ipos it = case it ^? itTweaks . tweakSel of
     hw = halfWidth  cfig
     sp = V2 (125 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
 
-topInvCursor :: Color -> Int -> Configuration -> World -> Picture
-topInvCursor col iPos cfig w 
-    | ButtonRight `S.member` _mouseButtons w = 
-        cursorAt 100 col 5 0 iPos cfig
-        `appendPic` openCursorAt 20 col 105 0 iPos cfig
-    | otherwise = mainListCursor col iPos cfig
-
 ammoTweakStrings :: Item -> [String]
 ammoTweakStrings it = case it ^? itTweaks . tweakParams of
     Just l -> map tweakString $ IM.elems l
@@ -107,17 +113,22 @@ invHead cfig s = winScale cfig
     . scale 0.4 0.4
     $ text s
 
-renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
+--renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
-{-# INLINE renderItemMapAt #-}
+--{-# INLINE renderItemMapAt #-}
-renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
+--renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
+
 
 displayInv :: Int -> Configuration -> World -> Picture
-displayInv n cfig w = renderItemMapAt 0 0 cfig (_crInv cr)
+displayInv n cfig w = listTextPicturesAt 0 0 cfig (concatMap itemToTextPictures $ IM.elems $ _crInv cr)
     <> equipcursor
+    <> listCursorAt 0 0 cfig curpos white curx cury
   where
+    curpos = crInvSelPos $ you w
+    curx   = 10
+    cury   = crInvSelSize $ you w
     equipcursor = case _crLeftInvSel cr of
         Nothing -> mempty
-        Just invid -> openCursorAt 20 yellow 105 0 invid cfig
+        Just invid -> openCursorAt 20 yellow 0 0 invid cfig
     cr = _creatures w IM.! n
 
 drawLocations :: Configuration -> World -> Picture
@@ -186,32 +197,19 @@ closeObjectTexts cfig w = pictures $
 mainListCursor :: Color -> Int -> Configuration -> Picture
 mainListCursor c = openCursorAt 120 c 5 0
 
-listItemAt
+itemToTextPictures :: Item -> [Picture]
-    :: Float    -- ^ x offset
+itemToTextPictures it = itemText it
-    -> Float    -- ^ y offset
-    -> Configuration 
-    -> Int      -- ^ y offset (discrete)
-    -> Item   -- ^ The item
-    -> Picture
-{-# INLINE listItemAt #-}
-listItemAt xoff yoff w yint
-    = winScale w 
-    . translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
-    . scale 0.1 0.1
-    . itemText
-  where
-    hw = halfWidth w
-    hh = halfHeight w
 
-itemText :: Item -> Picture
+
+itemText :: Item -> [Picture]
 {-# INLINE itemText #-}
 --itemText NoItem = dShadCol (greyN 0.5) $ text "----"
 --itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
-itemText NoItem = text "----"
+itemText NoItem = [text "----"]
 itemText it = case _itCurseStatus it of
-    UndroppableIdentified -> color black (text (_itInvDisplay it it)) 
+    UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it)
-        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
+--        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
-    _ -> color thecolor $ text (_itInvDisplay it it)
+    _ -> map (color thecolor . text) (_itInvDisplay it it)
   where
     thecolor = _itInvColor it
     

src/Dodge/Render/List.hs

@@ -1,13 +1,45 @@
-module Dodge.Render.List
+module Dodge.Render.List where
-    ( renderListAt
-    , dShadCol
-    , winScale
-    )
-    where
 import Dodge.Data
 import Dodge.Base.Window
 import Dodge.WinScale
 import Picture
+import Geometry
+
+-- given a list of pictures that are each the size of a "text" call, displays them as
+-- a list on the screen
+listTextPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
+listTextPicturesAt tx ty cfig = mconcat . zipWith (listTextPictureAt tx ty cfig) [0..]
+
+-- displays a cursor that should match up to list text pictures
+-- the width of a character appears to be 9(?!)
+listCursorAt :: Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture
+listCursorAt xoff yoff cfig yint col cursxsize cursysize = winScale cfig
+    . translate (10.5+xoff-halfWidth cfig) (halfHeight cfig - (20* fromIntegral yint + yoff) - 20)
+    $  lineCol 
+        [(V2  0   12.5  , col)
+        ,(V2  wth 12.5  ,col)
+        ] <>
+        lineCol
+        [(V2  0   (12.5 - hgt),col)
+        ,(V2  wth (12.5 - hgt),col)
+        ]
+        --[(V2  wth 12.5  ,withAlpha 0 col)
+        --,(V2  0   12.5  ,col)
+        --,(V2  0   (12.5 - hgt),col)
+        --,(V2  wth (12.5 - hgt),withAlpha 0 col)
+        --]
+  where
+    x = 9
+    wth =  x * fromIntegral cursxsize
+    hgt = 20 * fromIntegral cursysize
+
+listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
+listTextPictureAt xoff yoff cfig yint = winScale cfig
+    . translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
+    . scale 0.1 0.1
+  where
+    hw = halfWidth  cfig
+    hh = halfHeight cfig
 
 renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture
 renderListAt tx ty cfig =