From 9779b6fa39bf3c6c3ac8867adf463da38892c50c Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 30 Oct 2022 10:19:59 +0000 Subject: [PATCH] Move in game key press input reaction to universe update --- src/Dodge/Creature/YourControl.hs | 2 +- src/Dodge/Data/Input.hs | 8 +++- src/Dodge/Default/World.hs | 2 +- src/Dodge/Event/Keyboard.hs | 45 +++------------------ src/Dodge/TestString.hs | 7 ++-- src/Dodge/Update.hs | 12 +++++- src/Dodge/Update/Camera.hs | 5 +-- src/Dodge/Update/Input.hs | 67 +++++++++++++++++++++++++++++++ src/Dodge/Update/Scroll.hs | 3 +- 9 files changed, 97 insertions(+), 54 deletions(-) create mode 100644 src/Dodge/Update/Input.hs diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index bcfab86d3..a0e45fda0 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/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 diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 3caba152a..9862b7d25 100644 --- a/src/Dodge/Data/Input.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 812e23faa..825c8c78e 100644 --- a/src/Dodge/Default/World.hs +++ b/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 diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 05dbf1a35..6951471ac 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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] diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index ae4db473a..6865c1ab7 100644 --- a/src/Dodge/TestString.hs +++ b/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 - , show $ u ^. uvWorld . input . previousScrollAmount - , shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos - ] + [ shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos + ] ++ map show (M.toList (u ^. uvWorld . input . pressedKeys)) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 35e57feaa..e10f1e002 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 3637e186b..137fd9d56 100644 --- a/src/Dodge/Update/Camera.hs +++ b/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 - keyr = SDL.ScancodeE `Set.member` _keys (_input w) && notAtTerminal w + keyl = SDL.ScancodeQ `M.member` _pressedKeys (_input w) && notAtTerminal w + keyr = SDL.ScancodeE `M.member` _pressedKeys (_input w) && notAtTerminal w -- TODO check where/how this is used notAtTerminal :: World -> Bool diff --git a/src/Dodge/Update/Input.hs b/src/Dodge/Update/Input.hs new file mode 100644 index 000000000..11b2fda44 --- /dev/null +++ b/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 diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 085051400..703d1593a 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/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