Move in game key press input reaction to universe update

src/Dodge/Creature/YourControl.hs

@@ -73,7 +73,7 @@ wasdM scancode = case scancode of
     _ -> V2 0 0
 
 wasdDir :: World -> Point2
-wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . _keys . _input
+wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _input
 
 -- | Set posture according to mouse presses.
 mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature

src/Dodge/Data/Input.hs

@@ -5,15 +5,19 @@
 module Dodge.Data.Input where
 import Control.Lens
 import qualified Data.Map.Strict as M
-import qualified Data.Set as S
 import Dodge.Data.CWorld
 import Geometry.Data
 import SDL (MouseButton, Scancode)
 import qualified Data.Text as T
 
+data PressType = InitialPress
+    | ShortPress
+    | LongPress
+  deriving (Eq,Show)
+
 data Input = Input
     { _mousePos :: Point2
-    , _keys :: S.Set Scancode
+    , _pressedKeys :: M.Map Scancode PressType
     , _mouseButtons :: M.Map MouseButton Bool
     , _scrollAmount         :: Int
     , _previousScrollAmount :: Int

src/Dodge/Default/World.hs

@@ -13,7 +13,7 @@ defaultInput :: Input
 defaultInput = Input
         { _clickMousePos = V2 0 0
         , _textInput = RejectTextInput
-        , _keys = S.empty
+        , _pressedKeys = mempty
         , _mouseButtons = mempty
         , _mousePos = V2 0 0
         , _scrollAmount = 0

src/Dodge/Event/Keyboard.hs

@@ -6,7 +6,6 @@ module Dodge.Event.Keyboard (
 ) where
 
 import Data.Maybe
-import qualified Data.Set as S
 --import Data.Text (unpack)
 import qualified Data.Text as T
 import Dodge.Base
@@ -25,6 +24,7 @@ import Dodge.Terminal.LeftButton
 import Dodge.WorldPos
 import LensHelp
 import SDL
+--import qualified Data.Map.Strict as M
 
 -- annoyingly, the text input event doesn't register backspace, so deletion has to be
 -- dealt with using key presses (handlePressedKey)
@@ -58,13 +58,16 @@ see 'handlePressedKeyInGame'.
 -}
 handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe)
 handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of
-    Released -> return . Just $ u & uvWorld . input . keys %~ S.delete scode
+    Released -> return . Just $ u & uvWorld . input . pressedKeys . at scode .~ Nothing
     Pressed ->
         handlePressedKey
             (keyboardEventRepeat kev)
             scode
-            (u & uvWorld . input . keys %~ S.insert scode)
+            --(u & uvWorld . input . pressedKeys %~ M.insertWith f scode val)
+            (u & uvWorld . input . pressedKeys . at scode ?~ val)
   where
+    val | keyboardEventRepeat kev = LongPress
+        | otherwise = InitialPress
     scode = (keysymScancode . keyboardEventKeysym) kev
 
 handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe)
@@ -89,19 +92,7 @@ handlePressedKey _ scode u = case scode of
 
 handlePressedKeyInGame :: Scancode -> Universe -> Universe
 handlePressedKeyInGame scode uv = case scode of
-    ScancodeEscape -> pauseGame $ over uvWorld escapeMap uv
-    ScancodeSpace -> over uvWorld spaceAction uv
-    ScancodeP -> pauseGame $ over uvWorld escapeMap uv
-    ScancodeF -> over uvWorld youDropItem uv
-    ScancodeM -> over uvWorld toggleMap uv
-    ScancodeR -> over uvWorld (crToggleReloading (you w)) uv
-    ScancodeT -> over uvWorld testEvent uv
-    ScancodeX -> uv & uvWorld %~ toggleTweakInv
-    ScancodeC -> over uvWorld toggleCombineInv uv
-    ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv
     _ -> uv
-  where
-    w = _uvWorld uv
 
 handlePressedKeyTerminal :: Int -> Scancode -> World -> World
 handlePressedKeyTerminal tmid scode w = case scode of
@@ -117,36 +108,12 @@ handlePressedKeyTerminal tmid scode w = case scode of
         Nothing -> t
         Just (t', _) -> t'
 
-toggleTweakInv :: World -> World
-toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
-    DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
-    _ -> w & thepointer .~ DisplayInventory (TweakInventory mi)
-  where
-    thepointer = cWorld . lWorld . hud . hudElement
-    mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
-
-toggleInspectInv :: HUDElement -> HUDElement
-toggleInspectInv he = case he of
-    DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
-    _ -> DisplayInventory InspectInventory
 
 gotoTerminal :: Universe -> Universe
 gotoTerminal w = case _uvScreenLayers w of
     (InputScreen{} : _) -> w
     _ -> w & uvScreenLayers .:~ InputScreen T.empty "Enter command"
 
-spaceAction :: World -> World
-spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of
-    DisplayCarte -> w & cWorld . lWorld . hud . carteCenter .~ theLoc
-    DisplayInventory NoSubInventory -> case selectedCloseObject w of
-        Just (_, Left flit) -> pickUpItem 0 flit w
-        Just (_, Right but) -> doButtonEvent (_btEvent but) but w
-        _ -> w
-    DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
-    _ -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
-  where
-    --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
-    theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
 
 pauseGame :: Universe -> Universe
 pauseGame = uvScreenLayers .~ [pauseMenu]

src/Dodge/TestString.hs

@@ -4,10 +4,9 @@ import Control.Lens
 import Dodge.Data.Universe
 --import Data.Maybe
 import ShortShow
+import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
 testStringInit u =
-    [ show $ u ^. uvWorld . input . scrollAmount
+    [  shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
-    , show $ u ^. uvWorld . input . previousScrollAmount
+    ] ++ map show (M.toList (u ^. uvWorld . input . pressedKeys))
-    , shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
-    ]

src/Dodge/Update.hs

@@ -7,8 +7,7 @@ Description : Simulation update
 module Dodge.Update (updateUniverse) where
 
 import Color
---import Dodge.Zone
+import Dodge.Update.Input
-
 import Dodge.Update.Scroll
 import Control.Applicative
 import Data.List
@@ -65,14 +64,23 @@ import StrictHelp
 
 updateUniverse :: Universe -> Universe
 updateUniverse u = updateUniverseLast . updateUniverseMid
+        . updateUseInput
         . over uvWorld (updateCamera cfig)
         . over (uvWorld . cWorld . cClock) ( + 1)
         $ updateBounds u -- where should this go? next to update camera?
   where
     cfig = u ^. uvConfig
 
+updateUseInput :: Universe -> Universe
+updateUseInput u = M.foldlWithKey' updateKeyInGame u (u ^. uvWorld . input . pressedKeys)
+
+
 updateUniverseLast :: Universe -> Universe
 updateUniverseLast = over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held
+    . over uvWorld (input . pressedKeys . each %~ f)
+  where
+    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/Camera.hs

@@ -14,7 +14,6 @@ import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
-import qualified Data.Set as Set
 import Dodge.Base
 import Dodge.Creature.Test
 import Dodge.Data.Config
@@ -193,8 +192,8 @@ rotateCamera cfig w
     | keyr = over cWorld (rotateCameraBy (-0.025)) w
     | otherwise = ifConfigWallRotate cfig w
   where
-    keyl = SDL.ScancodeQ `Set.member` _keys (_input w) && notAtTerminal w
+    keyl = SDL.ScancodeQ `M.member` _pressedKeys (_input w) && notAtTerminal w
-    keyr = SDL.ScancodeE `Set.member` _keys (_input w) && notAtTerminal w
+    keyr = SDL.ScancodeE `M.member` _pressedKeys (_input w) && notAtTerminal w
 
 -- TODO check where/how this is used
 notAtTerminal :: World -> Bool

src/Dodge/Update/Input.hs

@@ -0,0 +1,67 @@
+module Dodge.Update.Input 
+    ( updateKeyInGame
+    ) where
+
+import Dodge.WorldPos
+import Dodge.Button.Event
+import Dodge.Inventory
+import Dodge.Combine
+import Dodge.Event.Test
+import Dodge.Base.You
+import Dodge.Reloading
+import Dodge.Creature.Action
+import Dodge.Menu
+import Dodge.Data.Universe
+import SDL
+import LensHelp
+
+updateKeyInGame :: Universe -> Scancode -> PressType -> Universe
+updateKeyInGame  uv sc InitialPress = case sc of
+    ScancodeEscape -> pauseGame uv
+    ScancodeSpace -> over uvWorld spaceAction uv
+    ScancodeP -> pauseGame uv
+    ScancodeF -> over uvWorld youDropItem uv
+    ScancodeM -> over uvWorld toggleMap uv
+    ScancodeR -> over uvWorld (crToggleReloading (you w)) uv
+    ScancodeT -> over uvWorld testEvent uv
+    ScancodeX -> uv & uvWorld %~ toggleTweakInv
+    ScancodeC -> over uvWorld toggleCombineInv uv
+    ScancodeI -> uv & uvWorld . cWorld . lWorld . hud . hudElement %~ toggleInspectInv
+    _ -> uv
+  where
+    w = _uvWorld uv
+updateKeyInGame  uv _ _ = uv
+
+pauseGame :: Universe -> Universe
+pauseGame = uvScreenLayers .~ [pauseMenu]
+
+spaceAction :: World -> World
+spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of
+    DisplayCarte -> w & cWorld . lWorld . hud . carteCenter .~ theLoc
+    DisplayInventory NoSubInventory -> case selectedCloseObject w of
+        Just (_, Left flit) -> pickUpItem 0 flit w
+        Just (_, Right but) -> doButtonEvent (_btEvent but) but w
+        _ -> w
+    DisplayInventory DisplayTerminal{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
+    _ -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
+  where
+    --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w
+    theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w
+
+toggleMap :: World -> World
+toggleMap w = case w ^?! cWorld . lWorld . hud . hudElement of
+    DisplayCarte -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
+    _ -> w & cWorld . lWorld . hud . hudElement .~ DisplayCarte
+
+toggleTweakInv :: World -> World
+toggleTweakInv w = case w ^. cWorld . lWorld . hud . hudElement of
+    DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
+    _ -> w & thepointer .~ DisplayInventory (TweakInventory mi)
+  where
+    thepointer = cWorld . lWorld . hud . hudElement
+    mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
+
+toggleInspectInv :: HUDElement -> HUDElement
+toggleInspectInv he = case he of
+    DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
+    _ -> DisplayInventory InspectInventory

src/Dodge/Update/Scroll.hs

@@ -2,7 +2,6 @@ module Dodge.Update.Scroll where
 
 import qualified Data.Map.Strict as M
 import Data.Maybe
-import qualified Data.Set as S
 import qualified Data.Text as T
 import Dodge.Base
 import Dodge.Combine
@@ -74,7 +73,7 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of
     numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
     rbDown = ButtonRight `M.member` _mouseButtons (_input w)
     lbDown = ButtonLeft `M.member` _mouseButtons (_input w)
-    invKeyDown = ScancodeCapsLock `S.member` _keys (_input w)
+    invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)
 
 scrollRBOption :: Float -> World -> World
 scrollRBOption y w