Rethink selection lists as intmaps

src/Dodge/Combine.hs

@@ -6,8 +6,14 @@ module Dodge.Combine (
     combineListInfo,
     toggleCombineInv,
     enterCombineInv,
+    combineListSelection,
+    picsToSelectable,
 ) where
 
+import Dodge.Data.Combine
+import Dodge.Item.Display
+import Color
+import Dodge.Data.SelectionList
 import qualified Data.IntSet as IS
 import Control.Lens
 import Control.Monad
@@ -44,6 +50,19 @@ combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
   where
     g (amount, i) = replicate (_getItAmount amount) i
 
+combineList :: World -> [SelectionItem CombinableItem]
+combineList = map f . combineListInfo
+  where
+    f (is,(strs,itm)) = SelectionItem
+        { _siPictures = itemDisplay itm 
+        , _siHeight = length (itemDisplay itm)
+        , _siIsSelectable = True
+        , _siWidth = maximum (map length (itemDisplay itm))
+        , _siColor = _itInvColor itm
+        , _siOffX = 0
+        , _siPayload = CombinableItem is itm strs
+        }
+
 combineListInfo :: World -> [([Int], ([String], Item))]
 combineListInfo w = filter f . map (cmm inv) $ combineItemListYouX w
   where
@@ -93,10 +112,7 @@ toggleCombineInv w = case w ^. hud . hudElement of
 
 enterCombineInv :: World -> World
 enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory 
-    { _subInvSel = mi
+    (combineListSelection w mi "" False)
-    , _subInvRegex = ""
-    , _subInvRegexInput = False
-    }
   where
     mi = 0 <$ listToMaybe (combineItemListYou w)
 
@@ -105,3 +121,55 @@ combineSizes = map (itSlotsTaken . snd) . combineItemListYou
 
 combinePoss :: World -> [Int]
 combinePoss = scanl' (+) 0 . combineSizes
+
+combineListSelection :: World -> Maybe Int -> String -> Bool -> SelectionIntMap CombinableItem
+combineListSelection w mi regex x = SelectionIntMap
+    { _smItems = combineList w
+    , _smSelPos = mi
+    , _smLength = length (combineList w)
+    , _smRegex = regex
+    , _smRegexInput = x
+    , _smShownItems = IM.fromAscList $ zip [0..] (combineList w)
+    }
+
+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
+
+combineToSelectionItem :: Int -> [String] -> SelectionItem ()
+combineToSelectionItem wdth pics =
+    SelectionItem
+        { _siPictures = pics
+        , _siHeight = length pics
+        , _siIsSelectable = True
+        , _siWidth = wdth
+        , _siColor = white
+        , _siOffX = 0
+        , _siPayload = ()
+        }
+
+picsToSelectable :: Int -> [String] -> SelectionItem ()
+picsToSelectable wdth pics =
+    SelectionItem
+        { _siPictures = pics
+        , _siHeight = length pics
+        , _siIsSelectable = True
+        , _siWidth = wdth
+        , _siColor = white
+        , _siOffX = 0
+        , _siPayload = ()
+        }
+
+itemText :: Item -> [String]
+{-# INLINE itemText #-}
+itemText it = f $ case _itCurseStatus it of
+    UndroppableIdentified -> itemDisplay it
+    _ -> itemDisplay it
+  where
+    f = take (itSlotsTaken it) . (++ replicate 10 "*")

src/Dodge/Combine/List.hs

@@ -0,0 +1,3 @@
+module Dodge.Combine.List where
+
+

src/Dodge/Data/Combine.hs

@@ -0,0 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Dodge.Data.Combine where
+import Control.Lens
+import Dodge.Data.Item
+data CombinableItem = CombinableItem
+    { _ciInvIDs :: [Int]
+    , _ciItem :: Item
+    , _ciInfo :: [String]
+    }
+makeLenses ''CombinableItem

src/Dodge/Data/HUD.hs

@@ -5,7 +5,8 @@
 
 module Dodge.Data.HUD where
 
---import Dodge.Data.SelectionList
+import Dodge.Data.Combine
+import Dodge.Data.SelectionList
 import Dodge.Data.Button
 import Dodge.Data.FloorItem
 import Control.Lens
@@ -20,9 +21,8 @@ data HUDElement
 
 data SubInventory
     = NoSubInventory
-    | ExamineInventory {_subInvSel :: Maybe Int}
+    | ExamineInventory {_subInvMSel :: Maybe Int}
-    | CombineInventory {_subInvSel :: Maybe Int, _subInvRegex :: String
+    | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem}
-        , _subInvRegexInput :: Bool}
     | LockedInventory
     | DisplayTerminal {_termID :: Int}
 --    deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/SelectionList.hs

@@ -6,6 +6,7 @@ module Dodge.Data.SelectionList where
 import Color
 import Control.Lens
 import Dodge.Data.CardinalPoint
+import Data.IntMap.Strict (IntMap)
 --import Data.Aeson
 --import Data.Aeson.TH
 
@@ -25,6 +26,17 @@ data SelectionList a = SelectionList
     , _slLength :: Int
     , _slRegex  :: String
     , _slRegexInput :: Bool
+    , _slRegexList :: [(SelectionItem a, Maybe Int)]
+    }
+    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+data SelectionIntMap a = SelectionIntMap
+    { _smItems :: [SelectionItem a]
+    , _smSelPos :: Maybe Int
+    , _smLength :: Int
+    , _smRegex  :: String
+    , _smRegexInput :: Bool
+    , _smShownItems :: IntMap (SelectionItem a)
     }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
@@ -44,7 +56,7 @@ data SelectionItem a = SelectionItem
     , _siOffX   :: Int
     , _siPayload :: a
     }
-    | SelectionFilter
+    | SelectionInfo
     { _siPictures :: [String]
     , _siHeight :: Int
     , _siIsSelectable :: Bool
@@ -57,5 +69,6 @@ data SelectionItem a = SelectionItem
 makeLenses ''ListDisplayParams
 makeLenses ''SelectionList
 makeLenses ''SelectionItem
+makeLenses ''SelectionIntMap
 --deriveJSON defaultOptions ''SelectionItem
 --deriveJSON defaultOptions ''SelectionList

src/Dodge/Default/SelectionList.hs

@@ -0,0 +1,13 @@
+module Dodge.Default.SelectionList where
+
+import Dodge.Data.SelectionList
+
+defaultSelectionList :: SelectionList a
+defaultSelectionList = SelectionList
+    {_slItems = []
+    , _slSelPos = Nothing
+    , _slLength = 0
+    , _slRegex = ""
+    , _slRegexInput = False
+    , _slRegexList = []
+    }

src/Dodge/Inventory/SelectionList.hs

@@ -1,12 +1,12 @@
 module Dodge.Inventory.SelectionList where
 
+import Dodge.Default.SelectionList
 import Dodge.Inventory.Color
 import Dodge.Item.Display
 import Dodge.Inventory.ItemSpace
 import Picture.Base
 import Dodge.Inventory.CheckSlots
 import Dodge.Base.You
-import Dodge.SelectionList
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import qualified Data.IntMap.Strict as IM

src/Dodge/Menu/Loading.hs

@@ -1,5 +1,6 @@
 module Dodge.Menu.Loading where
 
+import Dodge.Default.SelectionList
 import Dodge.Menu.Option
 import Dodge.Data.Universe
 
@@ -10,7 +11,7 @@ loadingScreen str = OptionScreen
     , _scOffset = 0
     , _scPositionedMenuOption = NoPositionedMenuOption
     , _scOptionFlag = LoadingScreen
-    , _scSelectionList = SelectionList [] Nothing 0 "" False
+    , _scSelectionList = defaultSelectionList
     , _scAvailableLines = 0
     , _scListDisplayParams = optionListDisplayParams
     }

src/Dodge/Menu/Option.hs

@@ -1,6 +1,7 @@
 module Dodge.Menu.Option where
 
 --import Dodge.ScodeToChar
+import Dodge.Default.SelectionList
 import Data.Maybe
 --import Dodge.WindowLayout
 
@@ -62,12 +63,10 @@ makeOptionsSelectionList ::
     PositionedMenuOption ->
     SelectionList (Universe -> Universe)
 makeOptionsSelectionList maxlines mselpos u mos pmo =
-    SelectionList
+    defaultSelectionList
         { _slItems = optionsToSelections maxlines u mos pmo
         , _slSelPos = mselpos
         , _slLength = length $ optionsToSelections maxlines u mos pmo
-        , _slRegex = ""
-        , _slRegexInput = False
         }
 
 optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)]

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 ->
+    CombineInventory sl -> 
-        titledSub
+        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

src/Dodge/SelectionList.hs

@@ -16,25 +16,34 @@ getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
     dToBot = cfig ^. windowY - (ldps ^. ldpPosY + dFromScreenBot)
     dFromScreenBot = 5 -- fromMaybe 0 $ sl ^? slSizeRestriction . ssrType . ssrFromScreenBottom
 
-defaultSelectionList :: SelectionList a
-defaultSelectionList = SelectionList
-    {_slItems = []
-    , _slSelPos = Nothing
-    , _slLength = 0
-    , _slRegex = ""
-    , _slRegexInput = False
-    }
-
 getShownItems :: SelectionList a -> [SelectionItem a]
-getShownItems sl = case sl ^. slRegex of
+getShownItems sl = case sl ^. slRegexList of
-        "" | not (sl ^. slRegexInput) -> _slItems sl
+    [] -> sl ^. slItems
-        str ->  SelectionFilter 
+    xs -> map fst xs
+
+makeRegexList :: SelectionList a -> [(SelectionItem a, Maybe Int)]
+makeRegexList sl = case sl ^. slRegex of
+        "" | not (sl ^. slRegexInput) -> []
+        str ->  (SelectionInfo 
             { _siPictures = ["FILTER: "++str] 
             , _siHeight = 1
             , _siIsSelectable = False
             , _siWidth = length $ "FILTER: "++str
             , _siColor = white
             , _siOffX = 0
-            }: filter (doregex str) (_slItems sl)
+            }, Nothing) : filter (doregex str) (zip (_slItems sl) $ fmap Just [0..])
   where
-    doregex str = regexList str . _siPictures
+    doregex str = regexList str . _siPictures . fst
+
+setShownItems :: SelectionList a -> SelectionList a
+setShownItems sl = sl & slRegexList .~ makeRegexList sl
+
+moveSelectionListSelection :: Int -> SelectionList a -> SelectionList a
+moveSelectionListSelection yi sl = sl & slSelPos %~ f
+  where
+    f x | maxsel == 0 = Nothing
+        | x == Nothing = Just 0
+        | otherwise = fmap ((`mod` maxsel) . subtract yi) x
+    maxsel = case _slRegex sl of
+        "" -> length (_slItems sl)
+        _ -> length (_slRegexList sl)

src/Dodge/Update.hs

@@ -138,7 +138,7 @@ updateUseInput u = case u ^? uvScreenLayers . _head of
         optionScreenUpdate screen mop flag ldps sellist u
     _ -> case u ^? uvWorld . hud . hudElement . subInventory of
         Just (DisplayTerminal tmid) | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
-        Just (CombineInventory _ _ True) -> doSubInvRegexInput u
+        Just (CombineInventory SelectionIntMap {_smRegexInput=True}) -> doSubInvRegexInput u
         _ -> M.foldlWithKey' updateKeyInGame u pkeys
   where
     pkeys = u ^. uvWorld . input . pressedKeys

src/Dodge/Update/Input.hs

@@ -5,6 +5,7 @@ module Dodge.Update.Input (
     doSubInvRegexInput,
 ) where
 
+import SelectionIntMap
 import qualified Data.Map.Strict as M
 import Data.Char
 import Dodge.Base.You
@@ -45,8 +46,12 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
 doSubInvRegexInput :: Universe -> Universe
 doSubInvRegexInput u
     | any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash] 
-            = u & uvWorld . hud . hudElement . subInventory . subInvRegexInput .~ False
+            = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
-    | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvRegex)
+    | ScancodeBackspace `M.member` pkeys 
+        && u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex == Just ""
+            = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
+    | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex)
+        & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
   where
     pkeys = u ^. uvWorld . input . pressedKeys
 
@@ -89,7 +94,7 @@ updateKeyInGame uv sc InitialPress = case sc of
     ScancodeC -> over uvWorld toggleCombineInv uv
     -- the following should be put in a more sensible place
     --ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
-    ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvRegexInput) True uv
+    ScancodeSlash -> set (uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput) True uv
     -- in fact the whole logic should probably be rethought, oh well
     _ -> uv
 updateKeyInGame uv sc LongPress = case sc of

src/Dodge/Update/Scroll.hs

@@ -2,10 +2,11 @@ module Dodge.Update.Scroll (
     updateWheelEvent,
 ) where
 
+import SelectionIntMap
+import Dodge.SelectionList
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base
-import Dodge.Combine
 import Dodge.Data.Universe
 import Dodge.HeldScroll
 import Dodge.InputFocus
@@ -49,11 +50,11 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
     invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
 
 moveCombineSel :: Int -> World -> World
-moveCombineSel yi w = moveSubSel yi (length $ combineItemListYou w) w
+moveCombineSel yi = hud . hudElement . subInventory . subInvMap %~ moveSelectionMapSelection yi
 
 moveSubSel :: Int -> Int -> World -> World
 moveSubSel yi maxyi =
-    hud . hudElement . subInventory . subInvSel . _Just
+    hud . hudElement . subInventory . subInvMSel . _Just
         %~ ((`mod` maxyi) . subtract yi)
 
 guardDisconnectedID :: Int -> World -> World -> World

src/Dodge/Update/UsingInput.hs

@@ -3,6 +3,7 @@ module Dodge.Update.UsingInput (
     updateUsingInput,
 ) where
 
+import Dodge.Data.SelectionList
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Dodge.Base.You
@@ -30,11 +31,12 @@ pressedMBEffects subinv pkeys w = case subinv of
         | ButtonLeft `M.member` pkeys && w ^?! input . hammers . ix SubInvHam /= HammerUp ->
             w & input . hammers . ix SubInvHam .~ HammerDown
         | otherwise -> pressedMBEffectsNoInventory pkeys w
-    CombineInventory mi _ False
+    CombineInventory SelectionIntMap {_smSelPos = mi, _smRegexInput = False}
         | pkeys ^? ix ButtonLeft == Just False ->
             maybeexitcombine (maybe id doCombine mi w) & input . hammers . ix SubInvHam .~ HammerDown
-    CombineInventory _ _ True | pkeys ^? ix ButtonLeft == Just False 
+    CombineInventory SelectionIntMap {_smRegexInput = True} 
-        -> w & hud . hudElement . subInventory . subInvRegexInput .~ False
+        | pkeys ^? ix ButtonLeft == Just False 
+        -> w & hud . hudElement . subInventory . subInvMap . smRegexInput .~ False
     DisplayTerminal tmid
         | pkeys ^? ix ButtonLeft == Just False && inTermFocus w ->
             doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w

src/SelectionIntMap.hs

@@ -0,0 +1,43 @@
+module SelectionIntMap where
+
+import Data.Foldable
+import Data.Maybe
+import Color
+import Regex
+import qualified Data.IntMap.Strict as IM
+import Dodge.Data.SelectionList
+import LensHelp
+
+setShownIntMap :: SelectionIntMap a -> SelectionIntMap a
+setShownIntMap sm = case sm ^. smRegex of
+    "" | not (sm ^. smRegexInput) -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms)
+    str -> sm & smShownItems 
+        .~ IM.fromAscList (zip [0..] (f str : filter (regexList str . _siPictures) allitms))
+  where
+    allitms = sm ^. smItems
+    f str = SelectionInfo
+        { _siPictures = ["FILTER: " ++ str]
+        , _siHeight = 1
+        , _siIsSelectable = False
+        , _siWidth = length ("FILTER: " ++ str)
+        , _siColor = white
+        , _siOffX = 0
+        }
+
+-- assumes that at least one item is selectable!
+-- also assumes that the integer is 1 or -1
+moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a
+moveSelectionMapStep x sm = fromMaybe sm $ do
+    i <- _smSelPos sm
+    (n,_) <- IM.lookupMax (sm ^. smShownItems)
+    let j = (i + x) `mod` (n + 1)
+    case sm ^? smShownItems . ix j . siIsSelectable of
+        Just True -> Just $ sm & smSelPos ?~ j
+        _ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j)
+
+moveSelectionMapSelection :: Int -> SelectionIntMap a -> SelectionIntMap a
+moveSelectionMapSelection i sm = foldl' 
+    (&) 
+    sm 
+    (replicate (abs i) (moveSelectionMapStep (signum i)))
+