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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -12,11 +12,11 @@ import SDL (MouseButton, Scancode)
 import Data.Aeson
 import Data.Aeson.TH
 
-data PressType
+--data PressType
-    = InitialPress
+--    = InitialPress Int
-    | ShortPress
+--    | ShortPress Int
-    | LongPress
+--    | LongPress Int
-    deriving (Eq, Show)
+--    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

@@ -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

@@ -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 ->
+    Pressed | keyboardEventRepeat kev -> addTermSignal scode
-        (pressedKeys . at scode ?~ val)
+    Pressed | not (keyboardEventRepeat kev) ->
+        (pressedKeys . at scode ?~ 0)
             . addTermSignal scode
   where
-    val
+--    val
-        | keyboardEventRepeat kev = LongPress
+--        | keyboardEventRepeat kev = LongPress 0
-        | otherwise = InitialPress
+--        | otherwise = InitialPress 0
     scode = (keysymScancode . keyboardEventKeysym) kev
 
 addTermSignal :: Scancode -> Input -> Input

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 ->

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

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

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
+testStringInit u = map show (M.elems $ u ^. uvWorld . input . pressedKeys)
-            . 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)
         --return . foldMap (prettyLDT (show . (^. _1 . itType))) . invLDT $ _crInv cr
 --  where
 --    idp = invDisplayParams $ u ^. uvWorld

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

src/Dodge/Update/Input/InGame.hs

@@ -361,8 +361,8 @@ updateFunctionKeys u =
         u
         (u ^. uvWorld . input . pressedKeys)
 
-updateFunctionKey :: Universe -> Scancode -> PressType -> Universe
+updateFunctionKey :: Universe -> Scancode -> Int -> Universe
-updateFunctionKey uv sc InitialPress = case sc of
+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
+    0 -> updateInitialPressInGame uv sc
-    LongPress -> updateLongPressInGame 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

@@ -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

@@ -24,8 +24,8 @@ doTextInputOver u p x =
 
 backspaceInputted :: Input -> Bool
 backspaceInputted u = case u ^. pressedKeys . at ScancodeBackspace of
-    Just InitialPress -> True
+    Just 0 -> True
-    Just LongPress -> True
+    Just x | x >= 30 -> True
     _ -> False
 
 doBackspace :: String -> String