Move in game key press input reaction to universe update

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]