justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Separate out input datatype

Browse Source
This commit is contained in:
justin
2022-10-29 11:36:57 +01:00
parent 82e2a5a234
commit af6cdff063
19 changed files with 160 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Coordinate.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/Impulse/UseItem.hs
+1 -1
View File
@@ -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)))
src/Dodge/Creature/YourControl.hs
+4 -4
View File
@@ -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
src/Dodge/Data/Input.hs
+33
View File
@@ -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
src/Dodge/Data/World.hs
+3 -21
View File
@@ -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
src/Dodge/Default/Input.hs
+28
View File
@@ -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]
src/Dodge/Default/World.hs
+14 -9
View File
@@ -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
}
src/Dodge/Event.hs
+4 -4
View File
@@ -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
src/Dodge/Event/Keyboard.hs
+6 -6
View File
@@ -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
src/Dodge/Item/Weapon/ExtraEffect.hs
+3 -3
View File
@@ -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
src/Dodge/Projectile/Update.hs
+2 -2
View File
@@ -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
src/Dodge/Render/HUD.hs
+3 -3
View File
@@ -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
src/Dodge/Render/Picture.hs
+1 -1
View File
@@ -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]]
src/Dodge/Render/ShapePicture.hs
+6 -6
View File
@@ -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 =
src/Dodge/TestString.hs
+2 -2
View File
@@ -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
]
src/Dodge/Update.hs
+18 -18
View File
@@ -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
src/Dodge/Update/Camera.hs
+8 -8
View File
@@ -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
src/Dodge/Update/Scroll.hs
+3 -3
View File
@@ -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
src/Dodge/Update/UsingInput.hs
+20 -20
View File
@@ -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))