justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Unify key press and mouse button press timings

Browse Source 
Both now use Ints for presses.
Still no release timer for keyboard events.
This commit is contained in:
justin
2025-07-28 23:16:05 +01:00
parent ea35753744
commit 81f88c32e9
15 changed files with 52 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+7 -7
View File
@@ -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
src/Dodge/Creature/State.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/YourControl.hs
+2 -5
View File
@@ -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
src/Dodge/Data/ComposedItem.hs
+1
View File
@@ -42,6 +42,7 @@ data ItemSF -- Structural Function
| CapacitorSF
| TransformerSF
| PulseBallSF
| TorchSF
deriving (Eq, Ord, Show, Read)
type CItem = (Item, ItemSF)
src/Dodge/Data/Input.hs
+7 -7
View File
@@ -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
src/Dodge/Data/WorldEffect.hs
+1 -1
View File
@@ -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)
src/Dodge/Event/Input.hs
+6 -5
View File
@@ -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
src/Dodge/HeldUse.hs
+8 -8
View File
@@ -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 ->
src/Dodge/Item/Grammar.hs
+2 -1
View File
@@ -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
src/Dodge/Item/InventoryColor.hs
+2 -1
View File
@@ -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
src/Dodge/TestString.hs
+1 -6
View File
@@ -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
src/Dodge/Update.hs
+2 -4
View File
@@ -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
src/Dodge/Update/Input/InGame.hs
+9 -9
View File
@@ -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
src/Dodge/Update/Input/ScreenLayer.hs
+1 -1
View File
@@ -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
src/Dodge/Update/Input/Text.hs
+2 -2
View File
@@ -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