Work towards unifying all in game input

2023-02-21 00:37:26 +00:00
parent 7b9b1d1799
commit dee7472d31
5 changed files with 127 additions and 37 deletions
@@ -1,13 +1,19 @@
-module Dodge.InputFocus 
-    ( inTermFocus
-    , inInvRegex
-    , inCloseRegex
-    , inSubInvRegex
-    , inputFocus
-    ) where
+module Dodge.InputFocus (
+    inTermFocus,
+    inInvRegex,
+    inCloseRegex,
+    inSubInvRegex,
+    inputFocus,
+    inInputFocus,
+    regexScope,
+    regexFocus,
+    --    , inputFocus'
+) where

-import Dodge.Data.SelectionList
+import Control.Monad
+import Data.IntMap.Strict (IntMap)
 import Data.Maybe
+import Dodge.Data.SelectionList
 import Dodge.Data.World
 import LensHelp

@@ -18,23 +24,105 @@ inTermFocus w = fromMaybe False $ do
    connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
    return $ hasfocus && connectionstatus == TerminalReady

-inInvRegex  :: World -> Bool
+regexScope ::
+    (Applicative f1, Applicative f2, Num c) =>
+    World ->
+    Maybe
+        ( ( IntMap (Maybe String) ->
+            f1 (IntMap (Maybe String))
+          ) ->
+          HUDElement ->
+          f1 HUDElement
+        , (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) ->
+          HUDElement ->
+          f2 HUDElement
+        , c
+        )
+regexScope w = case w ^? hud . hudElement . subInventory of
+    Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of
+        Just (-1, _) -> di (-1)
+        Just (0, _) -> di (-1)
+        Just (2, _) -> di 2
+        Just (3, _) -> di 2
+        _ -> Nothing
+    Just CombineInventory{} ->
+        Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1))
+    _ -> Nothing
+  where
+    di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x)
+    he = w ^. hud . hudElement
+
+regexFocus ::
+    (Applicative f1, Applicative f2, Num c) =>
+    World ->
+    Maybe
+        ( ( IntMap (Maybe String) ->
+            f1 (IntMap (Maybe String))
+          ) ->
+          HUDElement ->
+          f1 HUDElement
+        , (Maybe (Int, Int) -> f2 (Maybe (Int, Int))) ->
+          HUDElement ->
+          f2 HUDElement
+        , c
+        )
+regexFocus w = case w ^? hud . hudElement . subInventory of
+    Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of
+        Just (-1, _) -> di (-1)
+        Just (2, _) -> di 2
+        _ -> Nothing
+    Just CombineInventory{} ->
+        Just (subInventory . ciSections . fssFilters, subInventory . ciSections . fssSections . sssSelPos, (-1))
+    _ -> Nothing
+  where
+    di x = Just (diSections . fssFilters, diSections . fssSections . sssSelPos, x)
+    he = w ^. hud . hudElement
+
+inInputFocus :: World -> Bool
+inInputFocus = isJust . inputFocusI
+
+inputFocusI :: World -> Maybe ((String -> Identity String) -> World -> Identity World)
+inputFocusI = inputFocus
+
+inputFocus ::
+    Applicative f =>
+    World ->
+    Maybe ((String -> f String) -> World -> f World)
+inputFocus w = case w ^? hud . hudElement . subInventory of
+    Just NoSubInventory -> case he ^? diSections . fssSections . sssSelPos . _Just of
+        Just (-1, _) -> di (-1)
+        Just (2, _) -> di 2
+        _ -> Nothing
+    Just CombineInventory{} -> case he ^? subInventory . ciSections . fssSections . sssSelPos . _Just of
+        Just (-1, _) -> Just $ hud . hudElement . subInventory . ciSections . fssFilters . ix (-1) . _Just
+        _ -> Nothing
+    Just DisplayTerminal{_termID = tmid} -> do
+        hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus
+        connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
+        guard $ hasfocus && connectionstatus == TerminalReady
+        return $ cWorld . lWorld . terminals . ix tmid . tmInput . tiText
+    _ -> Nothing
+  where
+    di x = Just $ hud . hudElement . diSections . fssFilters . ix x . _Just
+    he = w ^. hud . hudElement
+
+inInvRegex :: World -> Bool
 inInvRegex w = fromMaybe False $ do
-        sss <- w ^? hud . hudElement . diSections . fssSections
-        i <- sss ^? sssSelPos . _Just . _1
-        return $ i == (-1)
+    sss <- w ^? hud . hudElement . diSections . fssSections
+    i <- sss ^? sssSelPos . _Just . _1
+    return $ i == (-1)

-inCloseRegex  :: World -> Bool
+inCloseRegex :: World -> Bool
 inCloseRegex w = fromMaybe False $ do
-        sss <- w ^? hud . hudElement . diSections . fssSections
-        i <- sss ^? sssSelPos . _Just . _1
-        return $ i == 2
+    sss <- w ^? hud . hudElement . diSections . fssSections
+    i <- sss ^? sssSelPos . _Just . _1
+    return $ i == 2

-inSubInvRegex  :: World -> Bool
+inSubInvRegex :: World -> Bool
 inSubInvRegex w = fromMaybe False $ do
-        sss <- w ^? hud . hudElement . subInventory . ciSections . fssSections
-        i <- sss ^? sssSelPos . _Just . _1
-        return $ i == (-1)
+    sss <- w ^? hud . hudElement . subInventory . ciSections . fssSections
+    i <- sss ^? sssSelPos . _Just . _1
+    return $ i == (-1)

-inputFocus :: World -> Bool
-inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w
+--inputFocus :: World -> Bool
+--inputFocus w = inTermFocus w || inSubInvRegex w || inInvRegex w || inCloseRegex w