Start unifying regex parts of selection sections

src/Dodge/Update/Input.hs

@@ -2,6 +2,7 @@ module Dodge.Update.Input (
     updateUseInput,
 ) where
 
+--import Control.Monad
 import Data.List (sort)
 import Dodge.Inventory.Add
 import Dodge.Data.Combine
@@ -16,7 +17,7 @@ import Data.Char
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import Data.Maybe
-import Data.Monoid (First)
+--import Data.Monoid (First)
 import Dodge.Base.You
 import Dodge.Button.Event
 import Dodge.Combine
@@ -48,18 +49,18 @@ updateUseInputOnScreen sl = case sl of
 updateUseInputInGame :: HUDElement -> Universe -> Universe
 updateUseInputInGame h u = case h of
     DisplayCarte -> over uvWorld updatePressedButtonsCarte u
-    DisplayInventory si _ _ _ -> case si of
+    DisplayInventory {_subInventory = si} -> case si of
         DisplayTerminal tmid 
             | lbinitialpress && inTermFocus w ->
                 over uvWorld (doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid)) u
             | inTermFocus (_uvWorld u) -> updateKeysInTerminal tmid u
             | lbinitialpress ->
                 u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
-        CombineInventory _ _ sss
-            | inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u
+        CombineInventory {_ciSections = FilterableSections {_fssSections = sss}}
+            | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1)
             | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u
-        _ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u
-        _ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u
+        _ | inInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1) 
+        _ | inCloseRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . diSections %~ doRegexInput u 2
         _ -> M.foldlWithKey' updateKeyInGame u pkeys
   where
     w = u ^. uvWorld
@@ -80,11 +81,21 @@ maybeExitCombine u
     | otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
 
 doTextInputOver :: ASetter' Universe String -> Universe -> Universe
-doTextInputOver p u =
-    u & p %~ (++ map toUpper thetext)
+doTextInputOver p u = doTextInputOver' u p u
+--    u & p %~ (++ map toUpper thetext)
+--        & checkBackspace
+--  where
+--    thetext = u ^. uvWorld . input . textInput
+--    checkBackspace
+--        | backspaceInputted u = p %~ doBackspace
+--        | otherwise = id
+
+doTextInputOver' :: Universe -> ASetter' a String -> a -> a
+doTextInputOver' u p x =
+    x & p %~ (++ map toUpper str)
         & checkBackspace
   where
-    thetext = u ^. uvWorld . input . textInput
+    str = u ^. uvWorld . input . textInput
     checkBackspace
         | backspaceInputted u = p %~ doBackspace
         | otherwise = id
@@ -99,68 +110,22 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks
     Just LongPress -> True
     _ -> False
 
-doSubInvRegexInput :: Universe -> Universe
-doSubInvRegexInput u
-    | backspacetonothing =
-        u & uvWorld . hud . hudElement . subInventory . ciRegex .~ Nothing
---            & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
---            & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
-    | endkeys || endmouse = u
---        u & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos
-    | otherwise =
-        u & doTextInputOver (uvWorld . hud . hudElement . subInventory . ciRegex . _Just)
---            & uvWorld . hud . hudElement . subInventory . subInvMap %~ setShownIntMap
+doRegexInput :: Universe -> Int -> FilterableSections a -> FilterableSections a
+doRegexInput u i fss
+    | backspacetonothing || escapekey = endregex i 0
+    | endkeys || endmouse = endregex (i + 1) (j -1)
+    | otherwise = fss & doTextInputOver' u (fssFilters . ix i . _Just)
   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 . ciRegex . _Just == Just ""
-            && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
-    pkeys = u ^. uvWorld . input . pressedKeys
-
---doRegexInput ::
---    Int ->
---    ( (Maybe String -> Identity (Maybe String)) ->
---      Manipulation ->
---      Identity Manipulation
---    ) ->
---    ( ( Maybe String ->
---        Const (First String) (Maybe String)
---      ) ->
---      Manipulation ->
---      Const (First String) Manipulation
---    ) ->
---    Universe ->
---    Universe
-doRegexInput :: Int
-                -> ((Maybe String -> Identity (Maybe String))
-                    -> HUDElement -> Identity HUDElement)
-                -> ((Maybe String
-                     -> Const (Data.Monoid.First String) (Maybe String))
-                    -> HUDElement -> Const (Data.Monoid.First String) HUDElement)
-                -> Universe
-                -> Universe
-doRegexInput i crregex crregex' u
-    | backspacetonothing || escapekey = closeregex i 0
-    | endkeys || endmouse = closeregex (i + 1) (j -1)
-    | otherwise =
-        u
-            & doTextInputOver
-                (uvWorld . hud . hudElement . crregex . _Just)
-  where
-    closeregex a b =
-        u
-            & uvWorld . hud . hudElement . crregex .~ Nothing
-            & uvWorld . hud . hudElement . diSections
+    endregex a b =
+        fss
+            & fssFilters . ix i .~ Nothing
+            & fssSections
                 %~ ( ssSetCursor (ssLookupDown a b)
-                        . overSection (ssItems . at i .~ Nothing)
+                        . (sssSections . ix i . ssItems .~ mempty)
                    )
-            & uvWorld %~ setInvPosFromSS
+--            & uvWorld %~ setInvPosFromSS
     j = fromMaybe 0 $ do
-        itms <- u ^? uvWorld . hud . hudElement . diSections . sssSections . ix (i + 1) . ssItems
+        itms <- fss ^? fssSections . sssSections . ix (i + 1) . ssItems
         fst <$> IM.lookupMin itms
     escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress
     endkeys =
@@ -169,7 +134,7 @@ doRegexInput i crregex crregex' u
             [ScancodeReturn, ScancodeSlash]
     endmouse = Just True == (u ^? uvWorld . input . mouseButtons . ix ButtonLeft)
     backspacetonothing =
-        u ^? uvWorld . hud . hudElement . crregex' . _Just == Just ""
+        fss ^? fssFilters . ix i . _Just == Just ""
             && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
     pkeys = u ^. uvWorld . input . pressedKeys
 
@@ -228,34 +193,24 @@ updateLongPressInGame uv sc = case sc of
     ScancodeSpace -> over uvWorld spaceAction uv
     _ -> uv
 
--- doesn't seem to set cursor positioning
 updateBackspaceRegex :: World -> World
 updateBackspaceRegex w = case di ^? subInventory of
-    Just NoSubInventory | secfocus (-1) 0 -> w & trybackspace
-    Just NoSubInventory | secfocus 2 3 -> w & trybackspaceclose
-    Just CombineInventory{} -> w & hud . hudElement . subInventory %~ trybackspacecomb
+    Just NoSubInventory | secfocus (-1) 0 -> w & hud . hudElement . diSections %~ trybackspace (-1)
+    Just NoSubInventory | secfocus 2 3 -> w & hud . hudElement . diSections %~ trybackspace 2
+    Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ trybackspace (-1)
     _ -> w
   where
     secfocus a b = fromMaybe False $ do
-        i <- di ^? diSections . sssSelPos . _Just . _1
+        i <- di ^? diSections . fssSections . sssSelPos . _Just . _1
         return $ i == a || i == b
-    trybackspacecomb ci = case ci ^? ciRegex . _Just of
-        Just (_ : _) ->
-            ci & ciRegex . _Just %~ init
-        Just [] -> ci & ciRegex .~ Nothing
-        Nothing -> ci
-    trybackspace w' = case w' ^? hud . hudElement . invRegex . _Just of
-        Just (_ : _) ->
-            w' & hud . hudElement . invRegex . _Just %~ init
-                & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InInventory SortInventory
-        Just [] -> w' & hud . hudElement . invRegex .~ Nothing
-        Nothing -> w'
-    trybackspaceclose w' = case w' ^? hud . hudElement . closeRegex . _Just of
-        Just (_ : _) ->
-            w' & hud . hudElement . closeRegex . _Just %~ init
-                & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
-        Just [] -> w' & hud . hudElement . closeRegex .~ Nothing
-        Nothing -> w'
+    trybackspace x fss = fromMaybe fss $ do
+--        i <- fss ^? fssSections . sssSelPos . _Just . _1
+--        guard (i == x || i == x+1)
+        str <- fss ^? fssFilters . ix x . _Just
+        return $ case str of
+            (_ : _) -> fss & fssFilters . ix x . _Just %~ init
+                & fssSections . sssSelPos ?~ (x,0)
+            [] -> fss & fssFilters . ix x .~ Nothing
     di = w ^. hud . hudElement
 
 updateEnterRegex :: World -> World
@@ -264,26 +219,26 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of
         | secfocus (-1) 0 ->
             w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject 
                     .~ InInventory SortInventory
-                & hud . hudElement . invRegex %~ enterregex
+                & hud . hudElement . diSections . fssFilters . ix (-1) %~ enterregex
     Just NoSubInventory
         | secfocus 2 3 ->
             w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby
-                & hud . hudElement .  closeRegex %~ enterregex
-    Just CombineInventory{} -> w & hud . hudElement . subInventory
-                %~ ( ciRegex %~ enterregex )
+                & hud . hudElement .  diSections . fssFilters . ix 2 %~ enterregex
+    Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections . fssFilters . ix (-1)
+                %~ enterregex
     _ -> w
   where
     di = w ^. hud . hudElement
     secfocus a b = fromMaybe False $ do
-        i <- di ^? diSections . sssSelPos . _Just . _1
+        i <- di ^? diSections . fssSections . sssSelPos . _Just . _1
         return $ i == a || i == b
     enterregex Nothing = Just ""
     enterregex x = x
 
-overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
-overSection f sss = fromMaybe sss $ do
-    i <- sss ^? sssSelPos . _Just . _1
-    return $ sss & sssSections . ix i %~ f
+--overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
+--overSection f sss = fromMaybe sss $ do
+--    i <- sss ^? sssSelPos . _Just . _1
+--    return $ sss & sssSections . ix i %~ f
 
 pauseGame :: Universe -> Universe
 pauseGame u = u & uvScreenLayers .~ [pauseMenu u]
@@ -306,8 +261,7 @@ spaceAction w = case w ^?! hud . hudElement of
 toggleMap :: Universe -> Universe
 toggleMap u = case u ^?! uvWorld . hud . hudElement of
     DisplayCarte -> u & uvWorld . hud . hudElement 
-        .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultInvSections
-            , _invRegex = Nothing, _closeRegex = Nothing}
+        .~ DisplayInventory{_subInventory = NoSubInventory, _diSections = defaultFiltInv}
     _ -> u & uvWorld . hud . hudElement .~ DisplayCarte
 
 toggleTweakInv :: World -> World