From dee7472d31351ebc9bd55d243f964b18d8c94a7f Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 21 Feb 2023 00:37:26 +0000 Subject: [PATCH] Work towards unifying all in game input --- src/Dodge/Creature/YourControl.hs | 2 +- src/Dodge/Data/SelectionList.hs | 5 ++ src/Dodge/InputFocus.hs | 132 +++++++++++++++++++++++++----- src/Dodge/Update/Camera.hs | 2 +- src/Dodge/Update/Input.hs | 23 +++--- 5 files changed, 127 insertions(+), 37 deletions(-) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 09d7edc74..b71e8d032 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -19,7 +19,7 @@ import qualified SDL -- | The AI equivalent for your control. yourControl :: Creature -> World -> World yourControl cr w - | inputFocus w = w + | inInputFocus w = w | not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr) %~ wasdWithAiming w (_mvSpeed $ _crMvType cr) | otherwise = diff --git a/src/Dodge/Data/SelectionList.hs b/src/Dodge/Data/SelectionList.hs index 6aeecb580..f9157d1b1 100644 --- a/src/Dodge/Data/SelectionList.hs +++ b/src/Dodge/Data/SelectionList.hs @@ -43,6 +43,11 @@ data SelectionSections a = SelectionSections , _sssSelPos :: Maybe (Int,Int) } +--data SSSExtra :: SSSExtra +-- { _sssSelPos :: Maybe (Int,Int) +-- , _sssFilters :: IntMap (Maybe String +-- } + data SectionCursor = SectionCursor { _scurPos :: Int , _scurSize :: Int diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index f52c14815..7b6ff5f8e 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 7584b2bdc..f80a35bc8 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -194,7 +194,7 @@ rotateCamera cfig w | keydown SDL.ScancodeE = over cWorld (rotateCameraBy (-0.025)) w | otherwise = ifConfigWallRotate cfig w where - keydown scode = scode `M.member` _pressedKeys (_input w) && not (inputFocus w) + keydown scode = scode `M.member` _pressedKeys (_input w) && not (inInputFocus w) zoomFromItem :: ItZoom -> diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index 7467375a2..0f0b22da1 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -59,6 +59,9 @@ updateUseInputInGame h u = case h of CombineInventory {_ciSections = FilterableSections {_fssSections = sss}} | inSubInvRegex (u ^. uvWorld) -> u & uvWorld . hud . hudElement . subInventory . ciSections %~ doRegexInput u (-1) | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u +-- _ -> case regexFocus w of +-- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys +-- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput _ | 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 @@ -82,13 +85,6 @@ maybeExitCombine u doTextInputOver :: ASetter' Universe String -> Universe -> Universe 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 = @@ -219,21 +215,22 @@ updateEnterRegex w = case w ^? hud . hudElement . subInventory of | secfocus (-1) 0 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InInventory SortInventory - & hud . hudElement . diSections . fssFilters . ix (-1) %~ enterregex + & hud . hudElement . diSections %~ enterregex (-1) Just NoSubInventory | secfocus 2 3 -> w & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ InNearby SortNearby - & hud . hudElement . diSections . fssFilters . ix 2 %~ enterregex - Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections . fssFilters . ix (-1) - %~ enterregex + & hud . hudElement . diSections %~ enterregex 2 + Just CombineInventory{} -> w & hud . hudElement . subInventory . ciSections %~ enterregex (-1) _ -> w where di = w ^. hud . hudElement secfocus a b = fromMaybe False $ do i <- di ^? diSections . fssSections . sssSelPos . _Just . _1 return $ i == a || i == b - enterregex Nothing = Just "" - enterregex x = x + enterregex x fss = fss & fssFilters . ix x %~ f + & fssSections . sssSelPos ?~ (x,0) + f Nothing = Just "" + f x = x --overSection :: (SelectionSection a -> SelectionSection a) -> SelectionSections a -> SelectionSections a --overSection f sss = fromMaybe sss $ do