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

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
-        , cursorsZ cfig iPos it
+        , cursorAt 120 col 5 0 cursPos cfig
+        , 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
-{-# INLINE renderItemMapAt #-}
-renderItemMapAt tx ty cfig = concatMapPic (uncurry $ listItemAt tx ty cfig) . IM.toList
+--renderItemMapAt :: Float -> Float -> Configuration -> IM.IntMap Item -> Picture
+--{-# INLINE renderItemMapAt #-}
+--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
-    :: Float    -- ^ x offset
-    -> 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
+itemToTextPictures :: Item -> [Picture]
+itemToTextPictures it = itemText it
 
-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)) 
-        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
-    _ -> color thecolor $ text (_itInvDisplay it it)
+    UndroppableIdentified -> map (color yellow . text) (_itInvDisplay it it)
+--        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
+    _ -> map (color thecolor . text) (_itInvDisplay it it)
   where
     thecolor = _itInvColor it