From af6cdff0637682bd70e9618aaf66f17b4dc6ccd4 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 29 Oct 2022 11:36:57 +0100 Subject: [PATCH] Separate out input datatype --- src/Dodge/Base/Coordinate.hs | 2 +- src/Dodge/Creature/Impulse/UseItem.hs | 2 +- src/Dodge/Creature/YourControl.hs | 8 +++--- src/Dodge/Data/Input.hs | 33 ++++++++++++++++++++++ src/Dodge/Data/World.hs | 24 ++-------------- src/Dodge/Default/Input.hs | 28 +++++++++++++++++++ src/Dodge/Default/World.hs | 23 +++++++++------ src/Dodge/Event.hs | 8 +++--- src/Dodge/Event/Keyboard.hs | 12 ++++---- src/Dodge/Item/Weapon/ExtraEffect.hs | 6 ++-- src/Dodge/Projectile/Update.hs | 4 +-- src/Dodge/Render/HUD.hs | 6 ++-- src/Dodge/Render/Picture.hs | 2 +- src/Dodge/Render/ShapePicture.hs | 12 ++++---- src/Dodge/TestString.hs | 4 +-- src/Dodge/Update.hs | 36 ++++++++++++------------ src/Dodge/Update/Camera.hs | 16 +++++------ src/Dodge/Update/Scroll.hs | 6 ++-- src/Dodge/Update/UsingInput.hs | 40 +++++++++++++-------------- 19 files changed, 160 insertions(+), 112 deletions(-) create mode 100644 src/Dodge/Data/Input.hs create mode 100644 src/Dodge/Default/Input.hs diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 0d668d5cf..2398f95da 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -45,7 +45,7 @@ cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate mouseWorldPos :: World -> Point2 mouseWorldPos w = (cam ^. camCenter) - +.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos w) + +.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos $ _input w) where cam = w ^. cWorld . lWorld . camPos diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 5321fc450..6d447c913 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -51,7 +51,7 @@ itemEffect cr it w = case it ^. itUse of tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World tryReload cr it w f - | _crID cr == 0 && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False = + | _crID cr == 0 && itNeedsLoading it && _mouseButtons (_input w) M.!? SDL.ButtonLeft == Just False = crToggleReloading cr | otherwise = (runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown))) diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index e197d21f2..b2e7debbd 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -22,7 +22,7 @@ yourControl cr w | otherwise = dimCreatureLight cr w & cWorld . lWorld . creatures . ix (_crID cr) - %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) + %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w))) & updateUsingInput dimCreatureLight :: Creature -> World -> World @@ -39,7 +39,7 @@ wasdWithAiming :: Creature wasdWithAiming w speed cr | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr - | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w = + | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr | otherwise = theMovement $ theTurn $ removeTwist cr where @@ -62,7 +62,7 @@ wasdWithAiming w speed cr isAiming = _posture (_crStance cr) == Aiming mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of Just _ -> argV $ mouseWorldPos w -.- _crPos cr - _ -> argV (_mousePos w) + (w ^. cWorld . lWorld . camPos . camRot) + _ -> argV (_mousePos (_input w)) + (w ^. cWorld . lWorld . camPos . camRot) wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of @@ -73,7 +73,7 @@ wasdM scancode = case scancode of _ -> V2 0 0 wasdDir :: World -> Point2 -wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . _keys +wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . _keys . _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 new file mode 100644 index 000000000..0cb2491b5 --- /dev/null +++ b/src/Dodge/Data/Input.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +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) + +data Input = Input + { _mousePos :: Point2 + , _keys :: S.Set Scancode + , _mouseButtons :: M.Map MouseButton Bool + , _scrollAmount :: Int + , _previousScrollAmount :: Int + , _hammers :: M.Map WorldHammer HammerPosition + , _lLine :: (Point2, Point2) + , _rLine :: (Point2, Point2) + , _lrLine :: (Point2, Point2) + , _lSelect :: Point2 + , _rSelect :: Point2 + , _clickMousePos :: Point2 + , _backspaceTimer :: Int + } +data WorldHammer + = SubInvHam + | DoubleMouseHam + deriving (Eq, Ord, Show, Read, Enum, Bounded) + +makeLenses ''Input diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index d1357a1dc..ada7dab25 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -10,18 +10,17 @@ module Dodge.Data.World ( module Dodge.Data.RightButtonOptions, module Dodge.Data.SoundOrigin, module Dodge.Data.Hammer, + module Dodge.Data.Input, ) where import Dodge.Data.SaveSlot import Control.Lens import qualified Data.Map.Strict as M -import qualified Data.Set as S import Dodge.Data.CWorld import Dodge.Data.Hammer +import Dodge.Data.Input import Dodge.Data.RightButtonOptions import Dodge.Data.SoundOrigin -import Geometry.Data -import SDL (MouseButton, Scancode) import Sound.Data import System.Random @@ -30,28 +29,11 @@ data World = World , _randGen :: StdGen , _toPlaySounds :: M.Map SoundOrigin Sound , _playingSounds :: M.Map SoundOrigin Sound - , _mousePos :: Point2 - , _keys :: S.Set Scancode - , _mouseButtons :: M.Map MouseButton Bool - , _scrollAmount :: Int - , _previousScrollAmount :: Int - , _hammers :: M.Map WorldHammer HammerPosition + , _input :: Input , _testFloat :: Float - , _lLine :: (Point2, Point2) - , _rLine :: (Point2, Point2) - , _lrLine :: (Point2, Point2) - , _lSelect :: Point2 - , _rSelect :: Point2 - , _clickMousePos :: Point2 - , _backspaceTimer :: Int , _rbOptions :: RightButtonOptions } -- deriving (Eq, Ord, Show, Read) --Generic, Flat) -data WorldHammer - = SubInvHam - | DoubleMouseHam - deriving (Eq, Ord, Show, Read, Enum, Bounded) - makeLenses ''World diff --git a/src/Dodge/Default/Input.hs b/src/Dodge/Default/Input.hs new file mode 100644 index 000000000..237ac2c00 --- /dev/null +++ b/src/Dodge/Default/Input.hs @@ -0,0 +1,28 @@ +module Dodge.Default.Input where + +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Dodge.Data.Hammer +import Dodge.Data.Input +import Geometry.Data + +defaultInput :: Input +defaultInput = + Input + { _clickMousePos = V2 0 0 + , _keys = mempty + , _mouseButtons = mempty + , _mousePos = V2 0 0 + , _scrollAmount = 0 + , _previousScrollAmount = 0 + , _hammers = defaultWorldHammers + , _lrLine = (0, 0) + , _lLine = (0, 0) + , _rLine = (0, 0) + , _lSelect = 0 + , _rSelect = 0 + , _backspaceTimer = 0 + } + +defaultWorldHammers :: M.Map WorldHammer HammerPosition +defaultWorldHammers = M.fromSet (const HammerUp) $ S.fromList [minBound .. maxBound] diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index fd65fda4d..906e9b638 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -9,27 +9,32 @@ import Geometry.Polygon import qualified IntMapHelp as IM import System.Random -defaultWorld :: World -defaultWorld = - World - { _cWorld = defaultCWorld - , _clickMousePos = V2 0 0 - , _toPlaySounds = M.empty - , _playingSounds = M.empty - , _randGen = mkStdGen 2 +defaultInput :: Input +defaultInput = Input + { _clickMousePos = V2 0 0 , _keys = S.empty , _mouseButtons = mempty , _mousePos = V2 0 0 , _scrollAmount = 0 , _previousScrollAmount = 0 , _hammers = defaultWorldHammers - , _testFloat = 0 , _lrLine = (0, 0) , _lLine = (0, 0) , _rLine = (0, 0) , _lSelect = 0 , _rSelect = 0 , _backspaceTimer = 0 + } + +defaultWorld :: World +defaultWorld = + World + { _cWorld = defaultCWorld + , _input = defaultInput + , _toPlaySounds = M.empty + , _playingSounds = M.empty + , _randGen = mkStdGen 2 + , _testFloat = 0 , _rbOptions = NoRightButtonOptions } diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index b2cd820ff..551b1f4ce 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -35,7 +35,7 @@ handleEvent e = case eventPayload e of handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe handleMouseMotionEvent mmev u = Just $ - u & uvWorld . mousePos + u & uvWorld . input . mousePos .~ V2 (fromIntegral x - 0.5 * _windowX cfig) (0.5 * _windowY cfig - fromIntegral y) @@ -45,8 +45,8 @@ handleMouseMotionEvent mmev u = handleMouseButtonEvent :: MouseButtonEventData -> World -> World handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of - Released -> mouseButtons . at thebutton .~ Nothing - Pressed -> mouseButtons . at thebutton ?~ False + Released -> input . mouseButtons . at thebutton .~ Nothing + Pressed -> input . mouseButtons . at thebutton ?~ False where thebutton = mouseButtonEventButton mbev @@ -80,5 +80,5 @@ handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe handleMouseWheelEvent mwev w = case _uvScreenLayers w of [] -> case mouseWheelEventPos mwev of V2 _ y -> Just $ w -- & uvWorld %~ wheelEvent (fromIntegral y) - & uvWorld . scrollAmount +~ fromIntegral y + & uvWorld . input . scrollAmount +~ fromIntegral y _ -> Just w diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index f41909769..1eb8d2b90 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -62,21 +62,21 @@ see 'handlePressedKeyInGame'. -} handleKeyboardEvent :: KeyboardEventData -> Universe -> IO (Maybe Universe) handleKeyboardEvent kev u = case keyboardEventKeyMotion kev of - Released -> return . Just $ u & uvWorld . keys %~ S.delete scode + Released -> return . Just $ u & uvWorld . input . keys %~ S.delete scode Pressed -> handlePressedKey (keyboardEventRepeat kev) scode - (u & uvWorld . keys %~ S.insert scode) + (u & uvWorld . input . keys %~ S.insert scode) where scode = (keysymScancode . keyboardEventKeysym) kev handlePressedKey :: Bool -> Scancode -> Universe -> IO (Maybe Universe) handlePressedKey True ScancodeBackspace u - | _backspaceTimer (_uvWorld u) <= 0 = + | _backspaceTimer (_input $ _uvWorld u) <= 0 = handlePressedKey False ScancodeBackspace u - <&> _Just . uvWorld . backspaceTimer .~ 0 - | otherwise = return $ Just $ u & uvWorld . backspaceTimer -~ 1 + <&> _Just . uvWorld . input . backspaceTimer .~ 0 + | otherwise = return $ Just $ u & uvWorld . input . backspaceTimer -~ 1 handlePressedKey True _ u = return $ Just u handlePressedKey _ scode u = case scode of -- ScancodeF1 -> Just <$> (writeSaveSlot (SaveSlotNum 1) u >> return u) @@ -114,7 +114,7 @@ handlePressedKeyTerminal tmid scode w = case scode of ScancodeBackspace -> w & cWorld . lWorld . terminals . ix tmid . tmInput . tiText %~ doBackspace - & backspaceTimer .~ 5 + & input . backspaceTimer .~ 5 _ -> w where doBackspace t = case T.unsnoc t of diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 7904d39d5..ddc9cf865 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -73,7 +73,7 @@ targetRBCreatureUp it cr w t & tgPos .~ Nothing & tgActive .~ False ) - | SDL.ButtonRight `M.member` _mouseButtons w && isJust (t ^? tgID . _Just) + | SDL.ButtonRight `M.member` _mouseButtons (_input w) && isJust (t ^? tgID . _Just) && canSeeTarget = (w, t & updatePos & tgActive .~ True) | otherwise = (w, t & tgID .~ fmap _crID newtarg & updatePos & tgActive .~ False) @@ -105,7 +105,7 @@ targetUpdateWith f it _ w t targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate w t - | SDL.ButtonRight `M.member` _mouseButtons w = + | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t & tgPos . _Just .~ mouseWorldPos w & tgActive .~ True @@ -115,7 +115,7 @@ targetCursorUpdate w t targetRBPressUpdate :: World -> Targeting -> Targeting targetRBPressUpdate w t - | SDL.ButtonRight `M.member` _mouseButtons w = + | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t & tgPos %~ maybe (Just $ mouseWorldPos w) Just & tgActive .~ True diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 54075a54f..55c932e6b 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -94,10 +94,10 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj) turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir --i = _prjID pj newdir - | SDL.ButtonRight `M.member` _mouseButtons w + | SDL.ButtonRight `M.member` _mouseButtons (_input w) && w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos == w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID - = (w ^. cWorld . lWorld . camPos . camRot) + argV (_mousePos w) + = (w ^. cWorld . lWorld . camPos . camRot) + argV (_mousePos (_input w)) | otherwise = _prjDir pj doThrust :: Proj -> World -> World diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 35978107c..876daf531 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -141,7 +141,7 @@ subInventoryDisplay subinv cfig w = case subinv of selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it selcursor = selcursor' selcursortype selcursortype - | ButtonRight `M.member` _mouseButtons w = listCursorNESW + | ButtonRight `M.member` _mouseButtons (_input w) = listCursorNESW | otherwise = listCursorNSW curpos = invSelPos w cury = fromMaybe 1 $ augmentedInvSizes w IM.!? crSel (you w) @@ -151,7 +151,7 @@ subInventoryDisplay subinv cfig w = case subinv of equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos rboptions = - if ButtonRight `M.member` _mouseButtons w + if ButtonRight `M.member` _mouseButtons (_input w) then drawRBOptions cfig w (_rbOptions w) else mempty @@ -277,7 +277,7 @@ determineInvSelCursorWidth :: World -> Int determineInvSelCursorWidth w = case _rbOptions w of NoRightButtonOptions -> topInvW EquipOptions{} -> - if ButtonRight `M.member` _mouseButtons w + if ButtonRight `M.member` _mouseButtons (_input w) then 47 else topInvW diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 3586283d9..91df5fa6b 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -46,6 +46,6 @@ drawConcurrentMessage u = case u ^. uvConcEffects of customMouseCursor :: Configuration -> World -> Picture customMouseCursor cfig w = winScale cfig - . uncurryV translate (_mousePos w) + . uncurryV translate (_mousePos (_input w)) . color white $ pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]] diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index a85a677a8..d7bba0bbf 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -194,7 +194,7 @@ drawCollisionTest cfig w = <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b) <> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b) where - (a, b) = _lrLine w + (a, b) = _lrLine (_input w) cam = w ^. cWorld . lWorld . camPos drawCreatureDisplayTexts :: World -> Picture @@ -210,8 +210,8 @@ drawPathBetween w = where nodepos = (`getNodePos` w) nodelist = makePathBetween sp ep w - sp = _lSelect w - ep = _rSelect w + sp = _lSelect (_input w) + ep = _rSelect (_input w) --drawNodesNearSelect :: World -> Picture --drawNodesNearSelect w = @@ -229,7 +229,7 @@ drawInspectWalls w = IM.elems $ w ^. cWorld . lWorld . walls ) where - (a, b) = _lLine w + (a, b) = _lLine (_input w) drawInspectWall :: World -> Wall -> Picture drawInspectWall w wl = @@ -262,8 +262,8 @@ drawWorldSelect w = color cyan (line [a, b]) <> color magenta (line [c, d]) where - (a, b) = _lLine w - (c, d) = _rLine w + (a, b) = _lLine (_input w) + (c, d) = _rLine (_input w) drawFarWallDetect :: World -> Picture drawFarWallDetect w = diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index b78ce607c..ae4db473a 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -7,7 +7,7 @@ import ShortShow testStringInit :: Universe -> [String] testStringInit u = - [ show $ u ^. uvWorld . scrollAmount - , show $ u ^. uvWorld . previousScrollAmount + [ show $ u ^. uvWorld . input . scrollAmount + , show $ u ^. uvWorld . input . previousScrollAmount , shortShow $ u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos ] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e9fefe170..25d0ece62 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -67,7 +67,7 @@ updateUniverse :: Universe -> Universe updateUniverse = updateUniverseLast . updateUniverseFirst updateUniverseLast :: Universe -> Universe -updateUniverseLast = over uvWorld (mouseButtons . each .~ True) -- to determine if the mouse button is held +updateUniverseLast = over uvWorld (input . mouseButtons . each .~ True) -- to determine if the mouse button is held {- For most menus the only way to change the world is using event handling. -} updateUniverseFirst :: Universe -> Universe @@ -100,12 +100,12 @@ functionalUpdate' u = case u ^. uvWorld . cWorld . timeFlow of _ -> u doTimeScroll :: Int -> World -> World -doTimeScroll smoothing w = case w ^? mouseButtons . ix ButtonLeft of +doTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of Just False -> w & cWorld . timeFlow .~ NormalTimeFlow _ -> doTimeScroll' smoothing w doTimeScroll' :: Int -> World -> World -doTimeScroll' smoothing w = case w ^. scrollAmount of +doTimeScroll' smoothing w = case w ^. input . scrollAmount of x | x > 1 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing .~ 20 x | x > 0 -> w & scrollTimeBack & cWorld . timeFlow . scrollSmoothing %~ max 0 x | x < (-1) -> w & scrollTimeForward & cWorld .timeFlow . scrollSmoothing .~ negate 20 @@ -207,21 +207,21 @@ functionalUpdate w = updateWheelEvents :: World -> World updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y))) where - y = w ^. scrollAmount + y = w ^. input . scrollAmount advanceScrollAmount :: Universe -> Universe advanceScrollAmount u = u - & uvWorld . previousScrollAmount .~ _scrollAmount (_uvWorld u) - & uvWorld . scrollAmount .~ 0 + & uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u) + & uvWorld . input . scrollAmount .~ 0 updatePastWorlds :: World -> World updatePastWorlds w = w & cWorld . pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :)) moveHammersUp :: Universe -> Universe --moveHammersUp = uvWorld . hammers .~ M.empty -moveHammersUp = uvWorld . hammers %~ M.map moveHammerUp +moveHammersUp = uvWorld . input . hammers %~ M.map moveHammerUp --moveHammersUp = uvWorld . hammers . each %~ (moveHammerUp $!) --moveHammersUp = uvWorld %~ ( (hammers . each %~ (moveHammerUp $!)) $!) @@ -250,27 +250,27 @@ zoneClouds w = updateWorldSelect :: World -> World -updateWorldSelect w = f . g $ case (w ^? mouseButtons . ix ButtonLeft, w ^? mouseButtons . ix ButtonRight) of +updateWorldSelect w = f . g $ case (w ^? input . mouseButtons . ix ButtonLeft, w ^? input . mouseButtons . ix ButtonRight) of (Just False, Nothing) -> - w & lLine . _1 .~ mwp - & lrLine . _1 .~ mwp + w & input . lLine . _1 .~ mwp + & input . lrLine . _1 .~ mwp (Just True, Nothing) -> - w & lLine . _2 .~ mwp - & lrLine . _1 .~ mwp + w & input . lLine . _2 .~ mwp + & input . lrLine . _1 .~ mwp (Nothing, Just False) -> - w & rLine . _1 .~ mwp - & lrLine . _2 .~ mwp + w & input . rLine . _1 .~ mwp + & input . lrLine . _2 .~ mwp (Nothing, Just True) -> - w & rLine . _2 .~ mwp - & lrLine . _2 .~ mwp + w & input . rLine . _2 .~ mwp + & input . lrLine . _2 .~ mwp _ -> w where mwp = mouseWorldPos w f - | ButtonLeft `M.member` _mouseButtons w = lSelect .~ mwp + | ButtonLeft `M.member` _mouseButtons (_input w) = input . lSelect .~ mwp | otherwise = id g - | ButtonRight `M.member` _mouseButtons w = rSelect .~ mwp + | ButtonRight `M.member` _mouseButtons (_input w) = input . rSelect .~ mwp | otherwise = id --mcChooseUpdate :: Machine -> Machine -> World -> World diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 4c98dae8e..eec298a84 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -53,13 +53,13 @@ moveZoomCamera cfig w = vfoffset = do iscam <- yourItem w ^? _Just . itScope . scopeIsCamera guard iscam - guard (SDL.ButtonRight `M.member` _mouseButtons w) + guard (SDL.ButtonRight `M.member` _mouseButtons (_input w)) yourItem w ^? _Just . itScope . scopePos mscopeoffset = do - guard (SDL.ButtonRight `M.member` _mouseButtons w) + guard (SDL.ButtonRight `M.member` _mouseButtons (_input w)) yourItem w ^? _Just . itScope . scopePos newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset - offset = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w + offset = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos (_input w) newzoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope{} -> _scopeZoom zs _ -> newDefaultZoom * newItemZoom @@ -88,7 +88,7 @@ moveZoomCamera cfig w = updateScopeZoom :: World -> World updateScopeZoom w - | SDL.ButtonRight `M.member` _mouseButtons w = + | SDL.ButtonRight `M.member` _mouseButtons (_input w) = case w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) . itScope @@ -129,7 +129,7 @@ zoomInLongGun w ycr = you w Just currentZoom = wp ^? itScope . scopeZoom newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed - mousep = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ _mousePos w + mousep = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ _mousePos (_input w) zoomOutLongGun :: World -> World zoomOutLongGun w @@ -150,7 +150,7 @@ zoomOutLongGun w ifConfigWallRotate :: Configuration -> World -> World ifConfigWallRotate cfig w - | _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons w) = + | _gameplay_rotate_to_wall cfig && not (SDL.ButtonRight `M.member` _mouseButtons (_input w)) = rotateToOverlappingWall w | otherwise = w @@ -193,8 +193,8 @@ rotateCamera cfig w | keyr = over (cWorld . lWorld) (rotateCameraBy (-0.025)) w | otherwise = ifConfigWallRotate cfig w where - keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w - keyr = SDL.ScancodeE `Set.member` _keys w && notAtTerminal w + keyl = SDL.ScancodeQ `Set.member` _keys (_input w) && notAtTerminal w + keyr = SDL.ScancodeE `Set.member` _keys (_input w) && notAtTerminal w -- TODO check where/how this is used notAtTerminal :: World -> Bool diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index da61e0f21..7bc437bc2 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -72,9 +72,9 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of numcombs = length $ combineItemListYou w y = fromIntegral yi numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1 - rbDown = ButtonRight `M.member` _mouseButtons w - lbDown = ButtonLeft `M.member` _mouseButtons w - invKeyDown = ScancodeCapsLock `S.member` _keys w + rbDown = ButtonRight `M.member` _mouseButtons (_input w) + lbDown = ButtonLeft `M.member` _mouseButtons (_input w) + invKeyDown = ScancodeCapsLock `S.member` _keys (_input w) scrollRBOption :: Float -> World -> World scrollRBOption y w diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index ebdcab1a2..0e8838c84 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -20,49 +20,49 @@ import SDL updateUsingInput :: World -> World updateUsingInput w = case w ^. cWorld . lWorld . hud . hudElement of DisplayInventory subinv -> - pressedMBEffects subinv (_mouseButtons w) w + pressedMBEffects subinv (_mouseButtons (_input w)) w DisplayCarte -> - updatePressedButtonsCarte (_mouseButtons w) w + updatePressedButtonsCarte (_mouseButtons (_input w)) w pressedMBEffects :: SubInventory -> M.Map MouseButton Bool -> World -> World pressedMBEffects subinv pkeys w = case subinv of NoSubInventory - | ButtonLeft `M.member` pkeys && w ^?! hammers . ix SubInvHam /= HammerUp -> - w & hammers . ix SubInvHam .~ HammerDown + | ButtonLeft `M.member` pkeys && w ^?! input . hammers . ix SubInvHam /= HammerUp -> + w & input . hammers . ix SubInvHam .~ HammerDown | otherwise -> pressedMBEffectsNoInventory pkeys w CombineInventory mi | pkeys ^? ix ButtonLeft == Just False -> - maybeexitcombine (maybe id doCombine mi w) & hammers . ix SubInvHam .~ HammerDown + maybeexitcombine (maybe id doCombine mi w) & input . hammers . ix SubInvHam .~ HammerDown DisplayTerminal tmid | pkeys ^? ix ButtonLeft == Just False && inTermFocus w -> doTerminalEffectLB (w ^?! cWorld . lWorld . terminals . ix tmid) w - & hammers . ix SubInvHam .~ HammerDown + & input . hammers . ix SubInvHam .~ HammerDown | pkeys ^? ix ButtonLeft == Just False -> w & cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True - & hammers . ix SubInvHam .~ HammerDown + & input . hammers . ix SubInvHam .~ HammerDown _ | ButtonLeft `M.member` pkeys -> - w & hammers . ix SubInvHam .~ HammerDown + w & input . hammers . ix SubInvHam .~ HammerDown _ -> w where maybeexitcombine - | ButtonRight `M.member` _mouseButtons w = id + | ButtonRight `M.member` _mouseButtons (_input w) = id | otherwise = cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory pressedMBEffectsNoInventory :: M.Map MouseButton Bool -> World -> World pressedMBEffectsNoInventory pkeys w | isDown ButtonLeft && isDown ButtonRight && inTopInv = - useItem (you w) w & hammers . ix DoubleMouseHam .~ HammerDown + useItem (you w) w & input . hammers . ix DoubleMouseHam .~ HammerDown | justPressedDown ButtonLeft && inTopInv - && w ^?! hammers . ix DoubleMouseHam == HammerUp = + && w ^?! input . hammers . ix DoubleMouseHam == HammerUp = useLeftItem 0 w | isDown ButtonLeft && inTopInv = - w & hammers . ix DoubleMouseHam .~ HammerDown + w & input . hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle = w & cWorld . lWorld . camPos . camRot -~ rotation - & clickMousePos .~ _mousePos w - | isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown + & input . clickMousePos .~ _mousePos (_input w) + | isDown ButtonLeft = w & input . hammers . ix DoubleMouseHam .~ HammerDown | otherwise = w where inTopInv = case w ^. cWorld . lWorld . hud . hudElement of @@ -70,7 +70,7 @@ pressedMBEffectsNoInventory pkeys w _ -> False justPressedDown but = (pkeys ^. at but) == Just False isDown but = but `M.member` pkeys - rotation = angleBetween (_mousePos w) (_clickMousePos w) + rotation = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w)) -- note "sort" on the inventory indices; otherwise -- lower items may be shifted up and items below these removed instead @@ -90,16 +90,16 @@ updatePressedButtonsCarte :: M.Map MouseButton Bool -> World -> World updatePressedButtonsCarte pkeys w | isDown ButtonRight = w - & clickMousePos .~ _mousePos w + & input . clickMousePos .~ _mousePos (_input w) & cWorld . lWorld . hud . carteCenter %~ (-.- trans) | isDown ButtonLeft = w - & clickMousePos .~ _mousePos w + & input . clickMousePos .~ _mousePos (_input w) & cWorld . lWorld . hud . carteRot -~ rot & cWorld . lWorld . hud . carteZoom *~ czoom | otherwise = w where isDown but = but `M.member` pkeys - rot = angleBetween (_mousePos w) (_clickMousePos w) - czoom = magV (_mousePos w) / magV (_clickMousePos w) - trans = rotateV (w ^. cWorld . lWorld . hud . carteRot) $ 1 / (w ^. cWorld . lWorld . hud . carteZoom) *.* (_mousePos w -.- _clickMousePos w) + rot = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w)) + czoom = magV (_mousePos (_input w)) / magV (_clickMousePos (_input w)) + trans = rotateV (w ^. cWorld . lWorld . hud . carteRot) $ 1 / (w ^. cWorld . lWorld . hud . carteZoom) *.* (_mousePos (_input w) -.- _clickMousePos (_input w))