Move towards selection section inventory management

src/Dodge/Update/Input.hs

@@ -3,8 +3,11 @@ module Dodge.Update.Input (
     updateKeysInTerminal,
     doInputScreenInput,
     doSubInvRegexInput,
+    doInvRegexInput,
 ) where
 
+import Color
+import Data.Maybe
 import Dodge.DisplayInventory
 import SelectionIntMap
 import qualified Data.Map.Strict as M
@@ -25,6 +28,15 @@ import Dodge.WorldPos
 import LensHelp
 import SDL
 
+doTextInputOver' :: Universe -> ASetter' a String -> a -> a
+doTextInputOver' u p x = x & p %~ (++ map toUpper thetext)
+    & checkBackspace
+  where
+    thetext = u ^. uvWorld . input . textInput
+    checkBackspace 
+        | backspaceInputted u = p %~ doBackspace
+        | otherwise = id
+
 doTextInputOver :: ASetter' Universe String -> Universe -> Universe
 doTextInputOver p u = u & p %~ (++ map toUpper thetext)
     & checkBackspace
@@ -63,6 +75,28 @@ doSubInvRegexInput u
       && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
     pkeys = u ^. uvWorld . input . pressedKeys
 
+doInvRegexInput :: Universe -> Universe
+doInvRegexInput u
+    | backspacetonothing
+            = u & uvWorld . hud . hudElement . diSections %~ overSection
+                ( ssRegex .~ EmptyRegex )
+--                . initialSelPos )
+--                & uvWorld . hud . hudElement . diSections %~ setShownIntMap
+    | endkeys || endmouse = u
+--            = u & uvWorld . hud . hudElement . diSections %~ initialSelPos
+    | otherwise = u & uvWorld . hud . hudElement . diSections %~ 
+        overSection (doTextInputOver' u (ssRegex . regexString))
+--    | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex . _Just)
+--        & 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 . _Just == Just ""
+      && ScancodeBackspace `M.lookup` pkeys == Just InitialPress
+    pkeys = u ^. uvWorld . input . pressedKeys
+
 doInputScreenInput :: String -> Universe -> Universe
 doInputScreenInput s u =
     u & doTextInputOver (uvScreenLayers . _head . scInput)
@@ -101,29 +135,53 @@ updateKeyInGame uv sc InitialPress = case sc of
     ScancodeX -> uv & uvWorld %~ toggleTweakInv
     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 -> 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
+    ScancodeSlash -> uv & uvWorld . hud . hudElement %~ updateEnterRegex
+    ScancodeBackspace -> uv & uvWorld . hud . hudElement %~ updateBackspaceRegex
         
     -- in fact the whole logic should probably be rethought, oh well
     _ -> uv
-  where
-    enterregex Nothing = Just ""
-    enterregex (Just str)  = Just str
-    enternonzeroregex (Just (x:xs)) = Just (init (x:xs))
-    enternonzeroregex smr = smr
 updateKeyInGame uv sc LongPress = case sc of
     ScancodeF -> over uvWorld youDropItem uv
     ScancodeSpace -> over uvWorld spaceAction uv
     _ -> uv
 updateKeyInGame uv _ _ = uv
 
+updateBackspaceRegex :: HUDElement -> HUDElement
+updateBackspaceRegex di = case di ^?  subInventory of
+    Just NoSubInventory -> di & diSections %~ overSection 
+            ( (ssRegex %~ backssregex)
+            . (ssCursor .~ Just (SectionCursor (-1) 0 1 white))
+            )
+    Just CombineInventory {} -> di
+        & subInventory . subInvMap . smRegex %~ enternonzeroregex
+        & subInventory . subInvMap . smSelPos ?~ 0 
+        & subInventory . subInvMap %~ setShownIntMap
+    _ -> di
+  where
+    enternonzeroregex (Just (x:xs)) = Just (init (x:xs))
+    enternonzeroregex smr = smr
+    backssregex (Regex (x:xs)) = Regex (init (x:xs))
+    backssregex x = x
+
+updateEnterRegex :: HUDElement -> HUDElement
+updateEnterRegex di = case di ^?  subInventory of
+    Just NoSubInventory -> di & diSections %~ overSection (ssRegex %~ enterssregex)
+    Just CombineInventory {} -> di
+        & subInventory . subInvMap . smRegex %~ enterregex
+        & subInventory . subInvMap . smSelPos ?~ 0 
+        & subInventory . subInvMap %~ setShownIntMap
+    _ -> di
+  where
+    enterssregex EmptyRegex = Regex ""
+    enterssregex x = x
+    enterregex Nothing = Just ""
+    enterregex (Just str)  = Just str
+
+overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a
+overSection f sss = fromMaybe sss $ do
+    i <- sss ^? sssSelPos . _Just
+    return $ sss & sssSections . ix i %~ f
+
 pauseGame :: Universe -> Universe
 pauseGame u = u & uvScreenLayers .~ [pauseMenu u]