Rethink selection lists as intmaps

src/Dodge/Render/HUD.hs

@@ -3,6 +3,8 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
+import Dodge.Default.SelectionList
+import Dodge.Combine
 import Dodge.Creature.Info
 import Control.Lens
 import qualified Data.Map.Strict as M
@@ -10,15 +12,15 @@ import Data.Maybe
 import qualified Data.Vector as V
 import Dodge.Base
 import Dodge.Clock
-import Dodge.Combine
+--import Dodge.Combine
 import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.Inventory
-import Dodge.Inventory.ItemSpace
+--import Dodge.Inventory.ItemSpace
 import Dodge.Inventory.SelectionList
-import Dodge.Item.Display
+--import Dodge.Item.Display
 import Dodge.Item.Info
 import Dodge.Render.Connectors
 import Dodge.Render.List
@@ -59,16 +61,6 @@ defaultListDisplayParams =
         , _ldpWidth = FixedSelectionWidth 15
         }
 
-defaultSubInvSelectionList :: SelectionList a
-defaultSubInvSelectionList =
-    SelectionList
-        { _slItems = []
-        , _slSelPos = Nothing
-        , _slLength = 15
-        , _slRegex = ""
-        , _slRegexInput = False
-        }
-
 invDisplayParams :: World -> ListDisplayParams
 invDisplayParams w =
     defaultListDisplayParams
@@ -92,11 +84,12 @@ drawSubInventory subinv cfig w = case subinv of
     NoSubInventory -> drawNoSubInventory cfig w
     ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
     DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
-    CombineInventory mi regex x ->
-        titledSub
+    CombineInventory sl -> 
+        let mi = _smSelPos sl
+        in titledSub'
             cfig
             ("COMBINE")
-            (combineListSelection w mi regex x)
+            sl
             <> combineInventoryExtra mi cfig w
 
 titledSub :: Configuration -> String -> SelectionList a -> Picture
@@ -104,12 +97,17 @@ titledSub cfig subtitle subitems =
     invHead cfig subtitle
         <> drawSelectionList secondColumnParams cfig subitems
 
+titledSub' :: Configuration -> String -> SelectionIntMap a -> Picture
+titledSub' cfig subtitle subitems =
+    invHead cfig subtitle
+        <> drawSelectionMap secondColumnParams cfig subitems
+
 drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
 drawExamineInventory cfig mtweaki w =
     titledSub
         cfig
         "EXAMINE"
-        (defaultSubInvSelectionList & slItems .~ ammoTweakSelectionItems itm 
+        (defaultSelectionList & slItems .~ ammoTweakSelectionItems itm 
             ++ map f (makeParagraph 60 $ yourAugmentedItem itemInfo (yourInfo (you w)) (closeObjectInfo (crNumFreeSlots (you w)) ) w))
         <> examineInventoryExtra mtweaki itm cfig
   where
@@ -240,7 +238,10 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
             ]
   where
     toselitm (str, col) = SelectionItem [str] 1 True (length str) col 0 ()
-    thesellist tm = SelectionList (thelist tm) Nothing (length (thelist tm)) "" False
+    thesellist tm = defaultSelectionList 
+        { _slItems = thelist tm
+        , _slLength = length (thelist tm)
+        }
     thelist tm =
         map toselitm . displayTermInput tm
             . reverse
@@ -336,23 +337,6 @@ determineInvSelCursorWidth w = case _rbOptions w of
         Just NoSubInventory -> True
         _ -> False
 
-combineListSelection :: World -> Maybe Int -> String -> Bool -> SelectionList ()
-combineListSelection w mi regex x =
-    defaultSubInvSelectionList
-        & slItems .~ combineListSelectionItems w
-        & slSelPos .~ mi
-        & slRegex .~ regex
-        & slRegexInput .~ x
-
-combineListSelectionItems :: World -> [SelectionItem ()]
-combineListSelectionItems w = case combineListSelectionItems' w of
-    [] -> [SelectionItem [thetext] 1 False (length thetext) white 0 ()]
-    xs -> xs
-  where
-    thetext = "NO POSSIBLE COMBINATIONS"
-
-combineListSelectionItems' :: World -> [SelectionItem ()]
-combineListSelectionItems' = map (picsToSelectable 15 . itemText . snd) . combineItemListYou
 
 ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
 ammoTweakSelectionItems = textSelItems . ammoTweakStrings
@@ -456,29 +440,9 @@ drawMapWall cfig thehud wl = color c . polygon $ map (cartePosToScreen cfig theh
 mainListCursor :: Color -> Int -> Configuration -> Picture
 mainListCursor c = openCursorAt 120 c 5 0
 
-picsToSelectable :: Int -> [String] -> SelectionItem ()
-picsToSelectable wdth pics =
-    SelectionItem
-        { _siPictures = pics
-        , _siHeight = length pics
-        , _siIsSelectable = True
-        , _siWidth = wdth
-        , _siColor = white
-        , _siOffX = 0
-        , _siPayload = ()
-        }
-
 textSelItems :: [String] -> [SelectionItem ()]
 textSelItems = map (picsToSelectable 15 . (: []))
 
-itemText :: Item -> [String]
-{-# INLINE itemText #-}
-itemText it = f $ case _itCurseStatus it of
-    UndroppableIdentified -> itemDisplay it
-    _ -> itemDisplay it
-  where
-    f = take (itSlotsTaken it) . (++ replicate 10 "*")
-
 openCursorAt ::
     -- | Width
     Float ->

src/Dodge/Render/List.hs

@@ -1,5 +1,6 @@
 module Dodge.Render.List where
 
+import qualified Data.IntMap.Strict as IM
 --import Data.Foldable
 import Dodge.SelectionList
 import Data.Maybe
@@ -25,11 +26,28 @@ drawSelectionList ldps cfig sl =
         (makeSelectionListPictures sl)
         <> drawSelectionCursor ldps cfig sl
 
+drawSelectionMap :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture
+drawSelectionMap ldps cfig sl =
+    listPicturesAtScaleOff
+        (_ldpVerticalGap ldps)
+        (_ldpScale ldps)
+        (_ldpPosX ldps)
+        (_ldpPosY ldps)
+        cfig
+        0 --(_slOffset sl)
+        (makeSelectionMapPictures sl)
+        <> drawSelectionMapCursor ldps cfig sl
+
 makeSelectionListPictures :: SelectionList a -> [Picture]
 makeSelectionListPictures sl = concatMap f $ getShownItems sl
   where
     f si = map (color (_siColor si) . text) $ _siPictures si
 
+makeSelectionMapPictures :: SelectionIntMap a -> [Picture]
+makeSelectionMapPictures sl = foldMap f $ _smShownItems sl
+  where
+    f si = map (color (_siColor si) . text) $ _siPictures si
+
 drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
 drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
     i <- mi
@@ -45,6 +63,9 @@ drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
         FixedSelectionWidth x -> x
         _ -> 1
 
+drawSelectionMapCursor :: ListDisplayParams -> Configuration -> SelectionIntMap a -> Picture
+drawSelectionMapCursor ldps cfig sl = drawCursorAt ldps cfig (sl ^. smSelPos) (IM.elems $ _smShownItems sl)
+
 drawSelectionCursor :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
 drawSelectionCursor ldps cfig sl = drawCursorAt ldps cfig (f $ sl ^. slSelPos) (getShownItems sl)
   where