From 81f88c32e9527e28e617c56edf04bd01119c6ff4 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 28 Jul 2025 23:16:05 +0100 Subject: [PATCH] Unify key press and mouse button press timings Both now use Ints for presses. Still no release timer for keyboard events. --- src/Dodge/Creature/Impulse/UseItem.hs | 14 +++++++------- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Creature/YourControl.hs | 7 ++----- src/Dodge/Data/ComposedItem.hs | 1 + src/Dodge/Data/Input.hs | 14 +++++++------- src/Dodge/Data/WorldEffect.hs | 2 +- src/Dodge/Event/Input.hs | 11 ++++++----- src/Dodge/HeldUse.hs | 16 ++++++++-------- src/Dodge/Item/Grammar.hs | 3 ++- src/Dodge/Item/InventoryColor.hs | 3 ++- src/Dodge/TestString.hs | 7 +------ src/Dodge/Update.hs | 6 ++---- src/Dodge/Update/Input/InGame.hs | 18 +++++++++--------- src/Dodge/Update/Input/ScreenLayer.hs | 2 +- src/Dodge/Update/Input/Text.hs | 4 ++-- 15 files changed, 52 insertions(+), 58 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index b3bc2f035..17363a889 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -15,13 +15,13 @@ import Dodge.Item.Grammar import Dodge.Item.Location import qualified IntMapHelp as IM -useItem :: Int -> PressType -> World -> Maybe World +useItem :: Int -> Int -> World -> Maybe World useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do cr <- w ^? cWorld . lWorld . creatures . ix 0 itmloc <- invIndents (_crInv cr) ^? ix invid . _2 useItemLoc cr itmloc pt w -useItemLoc :: Creature -> LocationDT OItem -> PressType -> World -> Maybe World +useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World useItemLoc cr loc pt w | aimuse , fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached @@ -30,19 +30,19 @@ useItemLoc cr loc pt w | GadgetPlatformSF <- sf = return $ gadgetEffect pt loc cr w | RemoteDetonatorSF <- sf - , pt == InitialPress = + , pt == 0 = return $ activateDetonator ldt w | ITEMSCAN <- itm ^. itType - , pt == InitialPress = + , pt == 0 = return $ toggleExamineInv w | MAPPER <- itm ^. itType - , pt == InitialPress = + , pt == 0 = return $ toggleMapperInv itm w | Just b <- itm ^? itUse . useToggle - , pt == InitialPress = + , pt == 0 = return $ w & pointerToItem itm . itUse . useToggle .~ not b | isJust $ itm ^? itType . ibtEquip - , pt == InitialPress + , pt == 0 , Just invid' <- itm ^? itLocation . ilInvID = return $ toggleEquipmentAt invid' cr w | otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index ee25a2775..6eec2014b 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -228,7 +228,7 @@ tryUseParent :: LocationDT OItem -> World -> World tryUseParent loc w = fromMaybe w $ do t <- locUp' loc cr <- w ^? cWorld . lWorld . creatures . ix 0 - return $ gadgetEffect InitialPress t cr w + return $ gadgetEffect 0 t cr w tryDrawToCapacitor :: LocationDT OItem -> World -> World tryDrawToCapacitor loc w = fromMaybe w $ do diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index ddf405ec3..5837df7b8 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -67,7 +67,7 @@ handleHotkeys w thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys lw = w ^. cWorld . lWorld -useHotkey :: World -> (NewInt ItmInt, PressType) -> World +useHotkey :: World -> (NewInt ItmInt, Int) -> World useHotkey w (NInt itid, pt) = fromMaybe w $ do invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID useItem invid pt w @@ -228,8 +228,5 @@ tryClickUse pkeys w = fromMaybe w $ do . crManipulation . manObject . imSelectedItem of - Just invid -> useItem invid (f ltime) w + Just invid -> useItem invid ltime w Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w - where - f 0 = InitialPress - f _ = ShortPress diff --git a/src/Dodge/Data/ComposedItem.hs b/src/Dodge/Data/ComposedItem.hs index 4104169dc..9fc31b9b3 100644 --- a/src/Dodge/Data/ComposedItem.hs +++ b/src/Dodge/Data/ComposedItem.hs @@ -42,6 +42,7 @@ data ItemSF -- Structural Function | CapacitorSF | TransformerSF | PulseBallSF + | TorchSF deriving (Eq, Ord, Show, Read) type CItem = (Item, ItemSF) diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 857e0ebfe..6efd99a5b 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -12,11 +12,11 @@ import SDL (MouseButton, Scancode) import Data.Aeson import Data.Aeson.TH -data PressType - = InitialPress - | ShortPress - | LongPress - deriving (Eq, Show) +--data PressType +-- = InitialPress Int +-- | ShortPress Int +-- | LongPress Int +-- deriving (Eq, Show) data MouseContext = NoMouseContext @@ -45,7 +45,7 @@ data Input = Input { _mousePos :: Point2 -- in pixels, from the center of the screen , _mouseContext :: MouseContext , _mouseMoving :: Bool - , _pressedKeys :: M.Map Scancode PressType + , _pressedKeys :: M.Map Scancode Int , _mouseButtons :: M.Map MouseButton Int -- counts number of frames held down , _mouseButtonsReleased :: M.Map MouseButton Int -- counts number of frames released , _scrollAmount :: Int @@ -72,4 +72,4 @@ data TermSignal makeLenses ''Input makeLenses ''MouseContext -deriveJSON defaultOptions ''PressType +--deriveJSON defaultOptions ''PressType diff --git a/src/Dodge/Data/WorldEffect.hs b/src/Dodge/Data/WorldEffect.hs index 9e2c5aee0..a39c438a1 100644 --- a/src/Dodge/Data/WorldEffect.hs +++ b/src/Dodge/Data/WorldEffect.hs @@ -31,7 +31,7 @@ data WdWd | WdWdNegateTrig Int -- | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd | MakeTempLight LSParam Int - | UseInvItem Int PressType + | UseInvItem Int Int -- invid presstime | WdWdBurstFireRepetition Int Int --deriving (Eq, Show, Read) --, Generic) --h--deriving (Eq, Show, Read) --Generic, Flat) diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index 3ee97af8b..d1d2fcdf2 100644 --- a/src/Dodge/Event/Input.hs +++ b/src/Dodge/Event/Input.hs @@ -22,13 +22,14 @@ handleTextInput text = textInput %~ (++ map Right text) handleKeyboardEvent :: KeyboardEventData -> Input -> Input handleKeyboardEvent kev = case keyboardEventKeyMotion kev of Released -> pressedKeys . at scode .~ Nothing - Pressed -> - (pressedKeys . at scode ?~ val) + Pressed | keyboardEventRepeat kev -> addTermSignal scode + Pressed | not (keyboardEventRepeat kev) -> + (pressedKeys . at scode ?~ 0) . addTermSignal scode where - val - | keyboardEventRepeat kev = LongPress - | otherwise = InitialPress +-- val +-- | keyboardEventRepeat kev = LongPress 0 +-- | otherwise = InitialPress 0 scode = (keysymScancode . keyboardEventKeysym) kev addTermSignal :: Scancode -> Input -> Input diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index a571fd71a..5d9757cb3 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -43,14 +43,14 @@ import RandomHelp import qualified SDL import Sound.Data -gadgetEffect :: PressType -> LocationDT OItem -> Creature -> World -> World +gadgetEffect :: Int -> LocationDT OItem -> Creature -> World -> World gadgetEffect pt loc | UseHeld{} <- loc ^. locDT . dtValue . _1 . itUse = heldEffect pt loc | PulseBallSF <- loc ^. locDT . dtValue . _2 = heldEffect pt loc -- hammerCheck (\a b c -> creatureShootPulseBall a b cmuz c) pt loc | DROPPER x <- loc ^. locDT . dtValue . _1 . itType , Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt - , pt == InitialPress = + , pt == 0 = dropInventoryPath i x loc | CLICKER x <- loc ^. locDT . dtValue . _1 . itType , Just i <- loc ^? locDT . dtValue . _1 . itUse . uInt = @@ -58,12 +58,12 @@ gadgetEffect pt loc | otherwise = const id -heldEffect :: PressType -> LocationDT OItem -> Creature -> World -> World +heldEffect :: Int -> LocationDT OItem -> Creature -> World -> World heldEffect = hammerCheck heldEffectMuzzles hammerCheck :: (LocationDT OItem -> Creature -> World -> World) -> - PressType -> + Int -> LocationDT OItem -> Creature -> World -> @@ -96,11 +96,11 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of WarmUpCoolDown{} -> w & setwarming BurstTrigger is t | w ^. cWorld . lWorld . lClock - t > timelastused - , pt == InitialPress -> + , pt == 0 -> w & f loc cr & cWorld . lWorld . delayedEvents .++~ map g is VolleyGunTrigger i t | w ^. cWorld . lWorld . lClock - t > timelastused - , pt == InitialPress -> + , pt == 0 -> let (is, gen) = getVolleyBurst i (w ^. randGen) in w & f loc cr & cWorld . lWorld . delayedEvents .++~ map g is @@ -108,7 +108,7 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of HammerTrigger t | w ^. cWorld . lWorld . lClock - t > timelastused , isNothing $ find ((== MakeAutoSF) . (^. dtValue . _2)) (loc ^. locDT . dtRight) - , pt == InitialPress -> + , pt == 0 -> f loc cr w AutoTrigger t | w ^. cWorld . lWorld . lClock - t > timelastused -> f loc cr w @@ -1460,7 +1460,7 @@ warmupSound = \case _ -> crankSlowS useInventoryPath :: - PressType -> + Int -> Int -> InventoryPathing -> LocationDT OItem -> diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index 06b6d6a3f..a4bfac283 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -36,7 +36,7 @@ tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine itemAboveAttachables :: CItem -> [ItemSF] itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of (_, HeldPlatformSF) -> - [WeaponTargetingSF, WeaponScopeSF] + [WeaponTargetingSF, WeaponScopeSF,TorchSF] <> getAutoSpringLinks itm <> extraWeaponLinks itm (DETECTOR {}, _) -> [ARHUDSF,TriggerSF,MapperSF] @@ -110,6 +110,7 @@ itemToFunction itm = case itm ^. itType of ITEMSCAN -> ToggleSF INTROSCAN {} -> IntroScanSF HELD LASER -> WeaponTargetingSF + HELD TORCH -> TorchSF HELD{} -> case itUseCondition itm of UseableWhenAimed -> HeldPlatformSF _ -> GadgetPlatformSF diff --git a/src/Dodge/Item/InventoryColor.hs b/src/Dodge/Item/InventoryColor.hs index 7148d71ee..e13adc8ca 100644 --- a/src/Dodge/Item/InventoryColor.hs +++ b/src/Dodge/Item/InventoryColor.hs @@ -39,10 +39,11 @@ sfInvColor = \case UnderBarrelPlatformSF -> white UnderBarrelSlotSF -> white LaserWeaponSF -> white - PulseLaserSF -> orange + PulseLaserSF -> white CapacitorSF -> yellow PulseBallSF -> white TransformerSF -> yellow + TorchSF{} -> green --ammoTypeColor :: AmmoType -> Color --ammoTypeColor = \case diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index e4ff4a6ad..2060fec7c 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -26,12 +26,7 @@ import qualified IntMapHelp as IM import qualified Data.Map.Strict as M testStringInit :: Universe -> [String] -testStringInit u = prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv - . ix 0 . itLocation . ilIsRoot) - <> prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv - . ix 0 . itLocation . ilIsSelected) - <> prettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInv - . ix 0 . itLocation . ilIsAttached) +testStringInit u = map show (M.elems $ u ^. uvWorld . input . pressedKeys) --return . foldMap (prettyLDT (show . (^. _1 . itType))) . invLDT $ _crInv cr -- where -- idp = invDisplayParams $ u ^. uvWorld diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 9af2a8b9d..663fa2005 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -129,7 +129,7 @@ updateWorldEventFlag wef = case wef of maybeOpenConsole :: Universe -> Universe maybeOpenConsole u = case u ^. uvWorld . input . pressedKeys . at ScancodeSemicolon of - Just InitialPress -> u & uvScreenLayers %~ openConsole + Just 0 -> u & uvScreenLayers %~ openConsole _ -> u openConsole :: [ScreenLayer] -> [ScreenLayer] @@ -144,7 +144,7 @@ updateUniverseLast u = & maybeOpenConsole & advanceScrollAmount & updateWorldEventFlags - & uvWorld . input . pressedKeys . each %~ f + & uvWorld . input . pressedKeys . each +~ 1 & uvWorld . input . mouseMoving .~ False & uvWorld . input . mouseButtons . each +~ 1 & uvWorld . input . mouseButtonsReleased . each +~ 1 @@ -155,8 +155,6 @@ updateUniverseLast u = where mp = u ^. uvWorld . input . mousePos mwp = screenToWorldPos (u ^. uvWorld . wCam) mp - f LongPress = LongPress - f _ = ShortPress {- For most menus the only way to change the world is using event handling. -} updateUniverseMid :: Universe -> Universe diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index ad898779c..9fd96cbd7 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -361,8 +361,8 @@ updateFunctionKeys u = u (u ^. uvWorld . input . pressedKeys) -updateFunctionKey :: Universe -> Scancode -> PressType -> Universe -updateFunctionKey uv sc InitialPress = case sc of +updateFunctionKey :: Universe -> Scancode -> Int -> Universe +updateFunctionKey uv sc 0 = case sc of ScancodeF1 -> useNormalCamera uv ScancodeF2 -> pauseAndFloatCam uv ScancodeF5 -> doQuicksave uv @@ -387,14 +387,14 @@ updateKeysInTerminal tmid u = & checkEndStatus where checkEndStatus - | u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just InitialPress = + | u ^. uvWorld . input . pressedKeys . at ScancodeReturn == Just 0 = uvWorld %~ terminalReturnEffect tmid | otherwise = id -updateKeyInGame :: Universe -> Scancode -> PressType -> Universe +updateKeyInGame :: Universe -> Scancode -> Int -> Universe updateKeyInGame uv sc pt = case pt of - InitialPress -> updateInitialPressInGame uv sc - LongPress -> updateLongPressInGame uv sc + 0 -> updateInitialPressInGame uv sc + x | x >= 30 -> updateLongPressInGame uv sc _ -> uv updateInitialPressInGame :: Universe -> Scancode -> Universe @@ -440,14 +440,14 @@ doRegexInput inp i sss msel filts j = fromMaybe 0 $ do itms <- sss ^? ix (i + 1) . ssItems fst <$> IM.lookupMin itms - escapekey = ScancodeEscape `M.lookup` pkeys == Just InitialPress + escapekey = ScancodeEscape `M.lookup` pkeys == Just 0 endkeys = any - ((== Just InitialPress) . (`M.lookup` pkeys)) + ((== Just 0) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash] backspacetonothing = filts == Just "" - && ScancodeBackspace `M.lookup` pkeys == Just InitialPress + && ScancodeBackspace `M.lookup` pkeys == Just 0 pkeys = inp ^. pressedKeys updateBackspaceRegex :: World -> World diff --git a/src/Dodge/Update/Input/ScreenLayer.hs b/src/Dodge/Update/Input/ScreenLayer.hs index 15b773964..a38034e57 100644 --- a/src/Dodge/Update/Input/ScreenLayer.hs +++ b/src/Dodge/Update/Input/ScreenLayer.hs @@ -53,7 +53,7 @@ optionScreenDefaultEffect :: Universe -> Universe optionScreenDefaultEffect u = fromMaybe u $ do f <- u ^? uvScreenLayers . ix 0 . scPositionedMenuOption ptype <- u ^. uvWorld . input . pressedKeys . at ScancodeEscape - guard $ ptype == InitialPress + guard $ ptype == 0 (f ^? emoMenuOption . moEff) <*> return u -- ouch this is not good diff --git a/src/Dodge/Update/Input/Text.hs b/src/Dodge/Update/Input/Text.hs index da6f4f4a2..a44b2ebb6 100644 --- a/src/Dodge/Update/Input/Text.hs +++ b/src/Dodge/Update/Input/Text.hs @@ -24,8 +24,8 @@ doTextInputOver u p x = backspaceInputted :: Input -> Bool backspaceInputted u = case u ^. pressedKeys . at ScancodeBackspace of - Just InitialPress -> True - Just LongPress -> True + Just 0 -> True + Just x | x >= 30 -> True _ -> False doBackspace :: String -> String