From 43e3c1fe4c24e7440f8faff0cdc5a494b0ffafa5 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 16 Jan 2023 00:57:55 +0000 Subject: [PATCH] Tweak combine filtering --- src/Dodge/Creature/YourControl.hs | 3 ++- src/Dodge/Data/Input.hs | 2 +- src/Dodge/InputFocus.hs | 5 +++++ src/Dodge/Update/Input.hs | 20 +++++++++++++++----- src/Dodge/Update/Scroll.hs | 2 +- src/SelectionIntMap.hs | 15 +++++++++++---- 6 files changed, 35 insertions(+), 12 deletions(-) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 1e116277d..fbe1d71a1 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -19,7 +19,8 @@ import qualified SDL -- | The AI equivalent for your control. yourControl :: Creature -> World -> World yourControl cr w - | inTermFocus w = w & updateUsingInput + | inTermFocus w = w & updateUsingInput -- do we really want to do this? + | inputFocus w = w | otherwise = w & cWorld . lWorld . creatures . ix (_crID cr) diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 698a44602..ef51efb76 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -25,7 +25,7 @@ data Input = Input { _mousePos :: Point2 , _mouseMoving :: Bool , _pressedKeys :: M.Map Scancode PressType - , _mouseButtons :: M.Map MouseButton Bool + , _mouseButtons :: M.Map MouseButton Bool -- shortpress False, repeatpress True , _scrollAmount :: Int , _previousScrollAmount :: Int , _hammers :: M.Map WorldHammer HammerPosition diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index b75985af0..1f7897f38 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -1,5 +1,6 @@ module Dodge.InputFocus where +import Dodge.Data.SelectionList import Data.Maybe import Dodge.Data.World import LensHelp @@ -10,3 +11,7 @@ inTermFocus w = fromMaybe False $ do hasfocus <- w ^? cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus return $ hasfocus && connectionstatus == TerminalReady + +inputFocus :: World -> Bool +inputFocus w = inTermFocus w + || (w ^? hud . hudElement . subInventory . subInvMap . smRegexInput) == Just True diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs index afe906ea9..1927ba6a1 100644 --- a/src/Dodge/Update/Input.hs +++ b/src/Dodge/Update/Input.hs @@ -45,14 +45,18 @@ backspaceInputted u = case u ^. uvWorld . input . pressedKeys . at ScancodeBacks doSubInvRegexInput :: Universe -> Universe doSubInvRegexInput u - | any ( (== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn,ScancodeEscape,ScancodeSlash] - = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False - | ScancodeBackspace `M.member` pkeys - && u ^? uvWorld . hud . hudElement . subInventory . subInvMap . smRegex == Just "" + | endkeys || backspacetonothing || endmouse = u & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ False + & uvWorld . hud . hudElement . subInventory . subInvMap %~ initialSelPos | otherwise = u & doTextInputOver (uvWorld . hud . hudElement . subInventory . subInvMap . smRegex) & 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 "" + && ScancodeBackspace `M.lookup` pkeys == Just InitialPress pkeys = u ^. uvWorld . input . pressedKeys doInputScreenInput :: String -> Universe -> Universe @@ -94,7 +98,13 @@ updateKeyInGame uv sc InitialPress = case sc of 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 -> set (uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput) True uv + ScancodeSlash -> uv + & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True + & uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0 + ScancodeBackspace -> uv + & uvWorld . hud . hudElement . subInventory . subInvMap . smRegexInput .~ True + & uvWorld . hud . hudElement . subInventory . subInvMap . smSelPos ?~ 0 + -- in fact the whole logic should probably be rethought, oh well _ -> uv updateKeyInGame uv sc LongPress = case sc of diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 555e1f597..70fc8df04 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -38,7 +38,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w | rbDown -> w & changeTweakParam mi yi | otherwise -> w & moveTweakSel yi - DisplayInventory CombineInventory{} -> w & moveCombineSel yi + DisplayInventory (CombineInventory SelectionIntMap {_smRegexInput = False}) -> w & moveCombineSel yi DisplayInventory (DisplayTerminal tmid) -> terminalWheelEvent yi tmid w _ -> w where diff --git a/src/SelectionIntMap.hs b/src/SelectionIntMap.hs index 874e97181..bbe87cb5c 100644 --- a/src/SelectionIntMap.hs +++ b/src/SelectionIntMap.hs @@ -24,6 +24,11 @@ setShownIntMap sm = case sm ^. smRegex of , _siOffX = 0 } +initialSelPos :: SelectionIntMap a -> SelectionIntMap a +initialSelPos sm = sm & smSelPos .~ mi + where + mi = fst <$> ifind (const _siIsSelectable) (sm ^. smShownItems) + -- assumes that at least one item is selectable! -- also assumes that the integer is 1 or -1 moveSelectionMapStep :: Int -> SelectionIntMap a -> SelectionIntMap a @@ -36,10 +41,12 @@ moveSelectionMapStep x sm = fromMaybe sm $ do _ -> Just $ moveSelectionMapStep x (sm & smSelPos ?~ j) moveSelectionMapSelection :: Int -> SelectionIntMap a -> SelectionIntMap a -moveSelectionMapSelection i sm = foldl' - (&) - sm - (replicate (abs i) (moveSelectionMapStep (signum i))) +moveSelectionMapSelection i sm + | any _siIsSelectable (sm ^. smShownItems) = foldl' + (&) + sm + (replicate (abs i) (moveSelectionMapStep (signum i))) + | otherwise = sm & smSelPos .~ Nothing getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm