Allow for scrolling in combine regex

src/Dodge/Combine.hs

@@ -114,6 +114,6 @@ enterCombineInv w = w & hud . hudElement . subInventory .~ CombineInventory sm
     sm = initialSelPos $ SelectionIntMap
         { _smItems = combineList w
         , _smSelPos = Nothing
-        , _smRegex = NoSMRegex
+        , _smRegex = Nothing
         , _smShownItems = IM.fromAscList $ zip [0..] (combineList w)
         }

src/Dodge/Data/SelectionList.hs

@@ -71,7 +71,7 @@ data SMRegex = NoSMRegex
 data SelectionIntMap a = SelectionIntMap
     { _smItems :: [SelectionItem a]
     , _smSelPos :: Maybe Int
-    , _smRegex  :: SMRegex
+    , _smRegex  :: Maybe String
     , _smShownItems :: IntMap (SelectionItem a)
     }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -87,7 +87,6 @@ data SelectionItem a = SelectionItem
     { _siPictures :: [String]
     , _siHeight :: Int
     , _siIsSelectable :: Bool
-    --, _siWidth  :: Int
     , _siColor  :: Color
     , _siOffX   :: Int
     , _siPayload :: a
@@ -96,7 +95,13 @@ data SelectionItem a = SelectionItem
     { _siPictures :: [String]
     , _siHeight :: Int
     , _siIsSelectable :: Bool
-    --, _siWidth  :: Int
+    , _siColor  :: Color
+    , _siOffX   :: Int
+    }
+    | SelectionRegex
+    { _siPictures :: [String]
+    , _siHeight :: Int
+    , _siIsSelectable :: Bool
     , _siColor  :: Color
     , _siOffX   :: Int
     }

src/Dodge/InputFocus.hs

@@ -16,5 +16,12 @@ inTermFocus w = fromMaybe False $ do
     return $ hasfocus && connectionstatus == TerminalReady
 
 inputFocus :: World -> Bool
-inputFocus w = inTermFocus w 
+inputFocus w = inTermFocus w || inregexfocus
-    || (w ^? hud . hudElement . subInventory . subInvMap . smRegex . smrInput) == Just True
+  where
+    inregexfocus = fromMaybe False $ do
+        sm <- w ^? hud . hudElement . subInventory . subInvMap
+        i <- sm ^? smSelPos . _Just
+        si <- sm ^? smShownItems . ix i
+        case si of
+            SelectionRegex {} -> return True
+            _ -> return False

src/Dodge/Inventory/SelectionList.hs

@@ -20,11 +20,6 @@ import LensHelp
 --    & slSelPos .~ inventoryCursorPos w
 --
 --
---inventoryCursorPos :: World -> Maybe Int
---inventoryCursorPos w = case w ^? hud . hudElement . subInventory of
---    Just CombineInventory{} -> Nothing
---    _ -> Just $ yourInvSel w
---
 invSelectionItem' :: Creature ->  Int -> Item -> SelectionItem ()
 invSelectionItem' cr i it = SelectionItem
     { _siPictures = pics

src/Dodge/TestString.hs

@@ -8,7 +8,7 @@ import Dodge.Data.Universe
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
 testStringInit u = 
-    [ show $ u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex
+    [ show $ u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just
     ]
 
 showTimeFlow :: TimeFlowStatus -> String

src/Dodge/Update.hs

@@ -143,10 +143,16 @@ 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 SelectionIntMap {_smRegex=smr})
+        Just (CombineInventory sm)
-            | smr ^? smrInput == Just True -> doSubInvRegexInput u
+            | inregex sm -> doSubInvRegexInput u
         _ -> M.foldlWithKey' updateKeyInGame u pkeys
   where
+    inregex sm = fromMaybe False $ do
+        i <- sm ^? smSelPos . _Just
+        si <- sm ^? smShownItems . ix i
+        case si of
+            SelectionRegex {} -> return True
+            _ -> return False
     pkeys = u ^. uvWorld . input . pressedKeys
 
 optionScreenUpdate ::

src/Dodge/Update/Input.hs

@@ -47,20 +47,19 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
 doSubInvRegexInput :: Universe -> Universe
 doSubInvRegexInput u
     | backspacetonothing
-            = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ const NoSMRegex
+            = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex .~ Nothing
                 & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
                 & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
     | endkeys || endmouse
-            = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . smrInput %~ const False
+            = u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
-                & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
+    | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
-    | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex. smrString)
         & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
   where
     endkeys = any 
         ( (== Just InitialPress) . (`M.lookup` pkeys)) 
         [ScancodeReturn,ScancodeEscape,ScancodeSlash]
     endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
-    backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . smrString == Just ""
+    backspacetonothing = u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just == Just ""
       && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
     pkeys = u ^. uvWorld . input . pressedKeys
 
@@ -106,16 +105,18 @@ updateKeyInGame uv sc InitialPress = case sc of
     ScancodeSlash -> uv
         & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enterregex
         & uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0 
+        & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
     ScancodeBackspace -> uv
         & uvWorld . hud . hudElement . subInventory . subInvMap . smRegex %~ enternonzeroregex
         & uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0 
+        & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
         
     -- in fact the whole logic should probably be rethought, oh well
     _ -> uv
   where
-    enterregex NoSMRegex = SMRegex "" True
+    enterregex Nothing = Just ""
-    enterregex (SMRegex str _) = SMRegex str True
+    enterregex (Just str)  = Just str
-    enternonzeroregex (SMRegex (x:xs) _) = SMRegex (init (x:xs)) True
+    enternonzeroregex (Just (x:xs)) = Just (init (x:xs))
     enternonzeroregex smr = smr
 updateKeyInGame uv sc LongPress = case sc of
     ScancodeF -> over uvWorld youDropItem uv

src/Dodge/Update/Scroll.hs

@@ -38,12 +38,10 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
         | rbDown -> w & changeTweakParam mi yi
         | otherwise -> w & moveTweakSel yi
-    DisplayInventory {_subInventory = CombineInventory sm} 
+    DisplayInventory {_subInventory = CombineInventory {}} -> w & moveCombineSel yi
-        | regexnotinput $ _smRegex sm -> w & moveCombineSel yi
     DisplayInventory {_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
     _ -> w
   where
-    regexnotinput smr = not $ smr ^? smrInput == Just True
     y = fromIntegral yi
     numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
     rbDown = ButtonRight `M.member` _mouseButtons (_input w)

src/Dodge/Update/UsingInput.hs

@@ -30,11 +30,8 @@ updateUsingInput w = case w ^. hud . hudElement of
 pressedMBEffects :: SubInventory -> M.Map MouseButton Bool -> World -> World
 pressedMBEffects subinv pkeys w = case subinv of
     NoSubInventory -> pressedMBEffectsNoInventory pkeys w
-    CombineInventory SelectionIntMap{_smSelPos = mi, _smRegex = smr}
+    CombineInventory SelectionIntMap{_smSelPos = mi}
-        | lbinitialpress && regexnotinput smr -> maybeexitcombine (maybe id doCombine mi w)
+        | lbinitialpress -> maybeexitcombine (maybe id doCombine mi w)
-    CombineInventory SelectionIntMap{}
-        | lbinitialpress -> w & hud . hudElement . subInventory . subInvMap . smRegex. smrInput 
-            %~ const False
     DisplayTerminal tmid
         | lbinitialpress && inTermFocus w ->
             doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w
@@ -42,7 +39,6 @@ pressedMBEffects subinv pkeys w = case subinv of
             w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
     _ -> w
   where
-    regexnotinput smr = not $ smr ^? smrInput == Just True
     lbinitialpress = pkeys ^? ix ButtonLeft == Just False
     maybeexitcombine w'
         | ButtonRight `M.member` _mouseButtons (_input w) =

src/SelectionIntMap.hs

@@ -10,16 +10,15 @@ import LensHelp
 
 setShownIntMap :: SelectionIntMap a -> SelectionIntMap a
 setShownIntMap sm = case sm ^. smRegex of
-    NoSMRegex -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms)
+    Nothing -> sm & smShownItems .~ IM.fromAscList (zip [0..] allitms)
-    SMRegex str _ -> sm & smShownItems 
+    Just str -> sm & smShownItems 
         .~ IM.fromAscList (zip [0..] (f str : filter (regexList str . _siPictures) allitms))
   where
     allitms = sm ^. smItems
-    f str = SelectionInfo
+    f str = SelectionRegex
         { _siPictures = ["FILTER: " ++ str]
         , _siHeight = 1
-        , _siIsSelectable = False
+        , _siIsSelectable = True
-        --, _siWidth = length ("FILTER: " ++ str)
         , _siColor = white
         , _siOffX = 0
         }
@@ -27,7 +26,9 @@ setShownIntMap sm = case sm ^. smRegex of
 initialSelPos :: SelectionIntMap a -> SelectionIntMap a
 initialSelPos sm = sm & smSelPos .~ mi
   where
-    mi = fst <$> ifind (const _siIsSelectable) (sm ^. smShownItems)
+    mi = fst <$> ifind t (sm ^. smShownItems)
+    t _ SelectionRegex{} = False
+    t _ si = _siIsSelectable si
 
 -- assumes that at least one item is selectable!
 -- also assumes that the integer is 1 or -1