From e3155752ba62962893f206d84beb1190e3239cef Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 29 Oct 2022 22:33:10 +0100 Subject: [PATCH] Commit before pushing more input events into update --- src/Dodge/Base/Collide.hs | 2 +- src/Dodge/Bullet.hs | 2 +- src/Dodge/Creature/Action/Blink.hs | 6 ++-- src/Dodge/Creature/Picture/Awareness.hs | 4 +-- src/Dodge/Creature/YourControl.hs | 8 +++--- src/Dodge/CullBox.hs | 8 +++--- src/Dodge/Data/CWorld.hs | 5 +++- src/Dodge/Data/Input.hs | 6 ++++ src/Dodge/Data/LWorld.hs | 5 +--- src/Dodge/Debug/Picture.hs | 12 ++++---- src/Dodge/Default/Input.hs | 28 ------------------ src/Dodge/Default/World.hs | 9 +++--- src/Dodge/Event.hs | 2 +- src/Dodge/Event/Keyboard.hs | 10 ++----- src/Dodge/HeldUse.hs | 2 +- src/Dodge/Initialisation.hs | 2 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 4 +-- src/Dodge/Item/Weapon/ExtraEffect.hs | 8 +++--- src/Dodge/Item/Weapon/TriggerType.hs | 12 ++++---- src/Dodge/Item/Weapon/Utility.hs | 2 +- src/Dodge/Layout.hs | 2 +- src/Dodge/Luse.hs | 2 +- src/Dodge/Picture/SizeInvariant.hs | 4 +-- src/Dodge/Projectile/Update.hs | 2 +- src/Dodge/Render.hs | 8 +++--- src/Dodge/Render/Lights.hs | 4 +-- src/Dodge/Render/ShapePicture.hs | 34 +++++++++++----------- src/Dodge/Render/Walls.hs | 2 +- src/Dodge/SoundLogic.hs | 4 +-- src/Dodge/Targeting/Draw.hs | 6 ++-- src/Dodge/Update.hs | 17 +++++------ src/Dodge/Update/Camera.hs | 38 ++++++++++++------------- src/Dodge/Update/Scroll.hs | 2 +- src/Dodge/Update/UsingInput.hs | 2 +- src/Dodge/WorldEffect.hs | 2 +- src/Dodge/WorldEvent/Cloud.hs | 2 +- 36 files changed, 121 insertions(+), 147 deletions(-) delete mode 100644 src/Dodge/Default/Input.hs diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index f6520d508..b4434c1f3 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -140,7 +140,7 @@ allVisibleWalls :: World -> [(Point2, Wall)] {-# INLINE allVisibleWalls #-} allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 20 where - vPos = w ^. cWorld . lWorld . camPos . camViewFrom + vPos = w ^. cWorld . camPos . camViewFrom --allVisibleWalls :: World -> StreamOf (Point2,Wall) --{-# INLINE allVisibleWalls #-} diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index d021a4049..ccb8b2df7 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -78,7 +78,7 @@ useAmmoParams it cr w = return $ FlechetteTrajectory tpos BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- it ^? itTargeting . tgPos . _Just - return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) + return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2 bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl) diff --git a/src/Dodge/Creature/Action/Blink.hs b/src/Dodge/Creature/Action/Blink.hs index 983c76846..a8ec5f6fb 100644 --- a/src/Dodge/Creature/Action/Blink.hs +++ b/src/Dodge/Creature/Action/Blink.hs @@ -26,7 +26,7 @@ blinkActionMousePos cr w = & inverseShockwaveAt cpos 40 2 2 where cid = _crID cr - p1 = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + p1 = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) cpos = _crPos cr --p2 = bouncePoint (const True) 1 cpos p1 w p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w) @@ -70,7 +70,7 @@ unsafeBlinkAction cr w wl <- snd $ collidePointWallsFilter (const True) mwp cpos w return (isLHS mwp `uncurry` _wlLine wl) cid = _crID cr - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) cpos = _crPos cr blinkShockwave :: @@ -96,7 +96,7 @@ blinkActionFail cr w = distR = 120 distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9 cid = _crID cr - p1 = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + p1 = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) cpos = _crPos cr p2 = bouncePoint (const True) 1 cpos p1 w r = 1.5 * _crRad cr diff --git a/src/Dodge/Creature/Picture/Awareness.hs b/src/Dodge/Creature/Picture/Awareness.hs index b97d182ca..94fece017 100644 --- a/src/Dodge/Creature/Picture/Awareness.hs +++ b/src/Dodge/Creature/Picture/Awareness.hs @@ -28,8 +28,8 @@ creatureDisplayText w cr = cr where lw = w ^. cWorld . lWorld - campos = w ^. cWorld . lWorld . camPos . camViewFrom - theScale = 0.15 / (w ^. cWorld . lWorld . camPos . camZoom) + campos = w ^. cWorld . camPos . camViewFrom + theScale = 0.15 / (w ^. cWorld . camPos . camZoom) cpos = _crPos cr v = cpos -.- campos (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index f45789d74..bcfab86d3 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -57,12 +57,12 @@ wasdWithAiming w speed cr | otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr' movDir = wasdDir w - dir = (w ^. cWorld . lWorld . camPos . camRot) + argV movDir - movAbs = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ normalizeV movDir + dir = (w ^. cWorld . camPos . camRot) + argV movDir + movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of - Just _ -> argV $ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- _crPos cr - _ -> argV (_mousePos (_input w)) + (w ^. cWorld . lWorld . camPos . camRot) + Just _ -> argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr + _ -> argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs index cdf97996b..9af8b4989 100644 --- a/src/Dodge/CullBox.hs +++ b/src/Dodge/CullBox.hs @@ -12,7 +12,7 @@ import Geometry findBoundDists :: Configuration -> World -> (Float, Float, Float, Float) findBoundDists cfig w | debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw) - | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . lWorld . camPos . camCenter) w + | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . camPos . camCenter) w where hw = halfWidth cfig hh = halfHeight cfig @@ -20,9 +20,9 @@ findBoundDists cfig w updateBounds :: Universe -> Universe updateBounds uv = uv - & uvWorld . cWorld . lWorld . camPos . camBoundDist .~ bdists - & uvWorld . cWorld . lWorld . camPos . camBoundBox - .~ map ((+.+ w ^. cWorld . lWorld . camPos . camCenter) . rotateV (w ^. cWorld . lWorld . camPos . camRot)) (rectNSWE n s w' e) + & uvWorld . cWorld . camPos . camBoundDist .~ bdists + & uvWorld . cWorld . camPos . camBoundBox + .~ map ((+.+ w ^. cWorld . camPos . camCenter) . rotateV (w ^. cWorld . camPos . camRot)) (rectNSWE n s w' e) where w = _uvWorld uv cfig = _uvConfig uv diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index a3ace7e97..7406ee2d6 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -6,6 +6,7 @@ module Dodge.Data.CWorld ( module Dodge.Data.CWorld, module Dodge.Data.LWorld, + module Dodge.Data.CamPos ) where import Dodge.Data.LWorld @@ -15,11 +16,13 @@ import Data.Aeson.TH --import Dodge.Data.GenParams import Dodge.GameRoom import Geometry.ConvexPoly +import Dodge.Data.CamPos data CWorld = CWorld { _lWorld :: LWorld + , _camPos :: CamPos , _cwGen :: CWGen - , _cwClock :: Int + , _cClock :: Int , _pastWorlds :: [LWorld] , _timeFlow :: TimeFlowStatus } diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 0cb2491b5..3caba152a 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -9,6 +9,7 @@ import qualified Data.Set as S import Dodge.Data.CWorld import Geometry.Data import SDL (MouseButton, Scancode) +import qualified Data.Text as T data Input = Input { _mousePos :: Point2 @@ -24,10 +25,15 @@ data Input = Input , _rSelect :: Point2 , _clickMousePos :: Point2 , _backspaceTimer :: Int + , _textInput :: TextInput } +data TextInput = RejectTextInput + | AcceptTextInput {_textInputText :: T.Text} + data WorldHammer = SubInvHam | DoubleMouseHam deriving (Eq, Ord, Show, Read, Enum, Bounded) makeLenses ''Input +makeLenses ''TextInput diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index 40f1bf989..a542e5f09 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/src/Dodge/Data/LWorld.hs @@ -45,10 +45,8 @@ module Dodge.Data.LWorld ( module Dodge.Data.TractorBeam, module Dodge.Data.Wall, module Dodge.Data.WorldEffect, - module Dodge.Data.CamPos ) where -import Dodge.Data.CamPos import Data.Set (Set) import Control.Lens import Data.Aeson @@ -100,8 +98,7 @@ import qualified IntMapHelp as IM import Picture.Data data LWorld = LWorld - { _camPos :: CamPos - , _creatures :: IM.IntMap Creature + { _creatures :: IM.IntMap Creature , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet) , _creatureGroups :: IM.IntMap CrGroupParams , _itemLocations :: IM.IntMap ItemLocation diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index bc19fb6e6..7dac46d9b 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -39,11 +39,11 @@ lineOnScreenCone cfig w p1 p2 = || pointInPolygon p2 sp || any (isJust . uncurry (intersectSegSeg p1 p2)) sps where - sp' = screenPolygon cfig (w ^. cWorld . lWorld . camPos) - vp = w ^. cWorld . lWorld . camPos . camViewFrom + sp' = screenPolygon cfig (w ^. cWorld . camPos) + vp = w ^. cWorld . camPos . camViewFrom sp | pointInPolygon vp sp' = sp' - | otherwise = orderPolygon ((w ^. cWorld . lWorld . camPos . camViewFrom) : sp') + | otherwise = orderPolygon ((w ^. cWorld . camPos . camViewFrom) : sp') sps = zip sp (tail sp ++ [head sp]) pointOnScreen :: Configuration -> CamPos -> Point2 -> Bool @@ -56,13 +56,13 @@ drawWallFace cfig w wall where (x, y) = _wlLine wall points = extendConeToScreenEdge cfig w sightFrom (x, y) - sightFrom = w ^. cWorld . lWorld . camPos . camViewFrom + sightFrom = w ^. cWorld . camPos . camViewFrom extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2] extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs where borderPs = mapMaybe (intersectLinefromScreen cfig w c) [x, y] - scpoly = reverse $ screenPolygon cfig (w ^. cWorld . lWorld . camPos) + scpoly = reverse $ screenPolygon cfig (w ^. cWorld . camPos) cornerPs = filter (pointIsInCone c (x, y)) scpoly wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg y ((2 *.* y) -.- x)) @@ -77,4 +77,4 @@ intersectLinefromScreen cfig w a b = listToMaybe . mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a)) . loopPairs - $ screenPolygon cfig (w ^. cWorld . lWorld . camPos) + $ screenPolygon cfig (w ^. cWorld . camPos) diff --git a/src/Dodge/Default/Input.hs b/src/Dodge/Default/Input.hs deleted file mode 100644 index 237ac2c00..000000000 --- a/src/Dodge/Default/Input.hs +++ /dev/null @@ -1,28 +0,0 @@ -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 906e9b638..812e23faa 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -12,6 +12,7 @@ import System.Random defaultInput :: Input defaultInput = Input { _clickMousePos = V2 0 0 + , _textInput = RejectTextInput , _keys = S.empty , _mouseButtons = mempty , _mousePos = V2 0 0 @@ -65,9 +66,10 @@ defaultCWCam = defaultCWorld :: CWorld defaultCWorld = CWorld - { _lWorld = defaultLWorld + { _camPos = defaultCWCam + , _lWorld = defaultLWorld , _cwGen = defaultCWGen - , _cwClock = 0 + , _cClock = 0 , _pastWorlds = [] , _timeFlow = NormalTimeFlow } @@ -75,8 +77,7 @@ defaultCWorld = defaultLWorld :: LWorld defaultLWorld = LWorld - { _camPos = defaultCWCam - , _magnets = IM.empty + { _magnets = IM.empty , _modifications = IM.empty , _creatures = IM.empty , _crZoning = mempty --Zoning IM.empty crZoneSize zoneOfCreature diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 551b1f4ce..990167eaa 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -23,7 +23,7 @@ import SDL handleEvent :: Event -> Universe -> IO (Maybe Universe) handleEvent e = case eventPayload e of - TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev) + TextInputEvent tev -> return . Just . (handleTextInput (textInputEventText tev)) KeyboardEvent kev -> handleKeyboardEvent kev MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 1eb8d2b90..05dbf1a35 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -5,10 +5,6 @@ module Dodge.Event.Keyboard ( guardDisconnectedID, ) where ---import Color - ---import Data.List - import Data.Maybe import qualified Data.Set as S --import Data.Text (unpack) @@ -35,8 +31,8 @@ import SDL -- also, note that this currently "doubles" the inputs to both terminals if both -- are open handleTextInput :: T.Text -> Universe -> Universe -handleTextInput text u = - u +--handleTextInput text = input . textInput . textInputText %~ T.append (T.toUpper text) +handleTextInput text u = u & uvScreenLayers . ix 0 . scInput %~ updateText & updateTerminalText where @@ -152,8 +148,6 @@ spaceAction w = case w ^?! cWorld . lWorld . hud . hudElement of --theLoc = doWorldPos (fst (_seenLocations (_cWorld w) IM.! _selLocation (_cWorld w))) w theLoc = doWorldPos (w ^?! cWorld . lWorld . seenLocations . ix (w ^. cWorld . lWorld . selLocation) . _1) w --- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail - pauseGame :: Universe -> Universe pauseGame = uvScreenLayers .~ [pauseMenu] diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index 925139d18..a9ebc8405 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -348,7 +348,7 @@ useMod hm = case hm of directedTelPos it cr w = (p, a) where p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just - a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- p) + a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- p) moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x modcrpos x cr = cr & crDir %~ tweenAngles x (_crOldDir cr) diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 8c4d3c5fa..be74720ea 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -16,7 +16,7 @@ splashScreen = initialWorld :: World initialWorld = defaultWorld - & cWorld . lWorld . camPos . camZoom .~ 10 + & cWorld . camPos . camZoom .~ 10 & cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)] & cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing : [MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]] diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 45480df80..ab74da533 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -148,7 +148,7 @@ circleLaser it cr w | otherwise = w where cpos = _crPos cr - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp)) dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000 phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr @@ -167,7 +167,7 @@ shootDualLaser it cr w = gap = _dbGap . _itParams $ it posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir) posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir) - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir | otherwise = mwp diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index f21d84b3e..eb70e90d6 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -83,7 +83,7 @@ targetRBCreatureUp it cr w t . filter (canseepos . _crPos) $ crsNearCirc mwp 40 w canseepos p = hasLOS (_crPos cr) p w - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t') posFromMaybeID Nothing = Nothing posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos @@ -107,7 +107,7 @@ targetCursorUpdate :: World -> Targeting -> Targeting targetCursorUpdate w t | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t - & tgPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + & tgPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) & tgActive .~ True | otherwise = t & tgPos %~ const Nothing @@ -117,7 +117,7 @@ targetRBPressUpdate :: World -> Targeting -> Targeting targetRBPressUpdate w t | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t - & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) Just + & tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) Just & tgActive .~ True | otherwise = t & tgPos %~ const Nothing @@ -139,7 +139,7 @@ targetLaserUpdate _ cr w t where (mp, _) = reflectLaserAlong 0.2 sp ep w sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) - ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- sp) + ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- sp) addLaserPic = cWorld . lWorld . lasers .:~ LaserStart diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 2d0fd92b6..874a16421 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -579,7 +579,7 @@ torqueBefore torque feff item cr w w & randGen .~ g & cWorld . lWorld . creatures . ix cid . crDir +~ rot - & cWorld . lWorld . camPos . camRot +~ rot + & cWorld . camPos . camRot +~ rot | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr @@ -600,7 +600,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w w & randGen .~ g & cWorld . lWorld . creatures . ix cid . crDir +~ rot' - & cWorld . lWorld . camPos . camRot +~ rot' + & cWorld . camPos . camRot +~ rot' | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w where cid = _crID cr @@ -613,7 +613,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w withTorqueAfter :: ChainEffect withTorqueAfter feff item cr w -- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w - | cid == 0 = set randGen g $ over (cWorld . lWorld . camPos . camRot) (+ rot) $ feff item cr w + | cid == 0 = set randGen g $ over (cWorld . camPos . camRot) (+ rot) $ feff item cr w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w where cid = _crID cr @@ -651,7 +651,7 @@ sideEffectOnFrame i sf f it cr w = torqueSideEffect :: Float -> Item -> Creature -> World -> World torqueSideEffect torque _ cr w - | cid == 0 = set randGen g $ over (cWorld . lWorld . camPos . camRot) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . camPos . camRot) (+ rot) w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr @@ -698,12 +698,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss & crPos %~ (+.+ pos) & crDir .~ thedir pos thedir pos - | dist (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) (_crPos cr) < aimingMuzzlePos cr item = + | dist (mouseWorldPos (w ^. input) (w ^. cWorld . camPos)) (_crPos cr) < aimingMuzzlePos cr item = argV ( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr) -.- (_crPos cr +.+ pos) ) - | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- (_crPos cr +.+ pos)) + | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- (_crPos cr +.+ pos)) duplicateItem :: (Item -> [Item]) -> ChainEffect duplicateItem fit eff itm cr w = foldr f w (fit itm) diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index f34cdf6db..445883664 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -84,7 +84,7 @@ unsafeBlinkGun = useForceFieldGun :: Item -> Creature -> World -> World useForceFieldGun itm cr w = fromMaybe w $ do a <- _tgPos $ _itTargeting itm - let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a) wlline = (a, b) return $ diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 0bc38b5b0..282670c9d 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -58,7 +58,7 @@ fromEdgeTuple :: (Int,Int,PathEdge) -> PathEdgeNodes fromEdgeTuple (a,b,pe) = PathEdgeNodes a b pe randomCompass :: World -> World -randomCompass w = w & cWorld . lWorld . camPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) +randomCompass w = w & cWorld . camPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) putFloorTiles :: GenWorld -> GenWorld putFloorTiles gw = gw & gwWorld . cWorld . lWorld . floorTiles .~ floorsFromGenWorld gw diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 62f9b8e13..b5bcdbaea 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -98,7 +98,7 @@ boostPoint x cr w = case mayp2 of where cpos = _crPos cr r = 1.5 * _crRad cr - p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- cpos) + p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- cpos) mayp2 = bouncePoint (const True) 1 cpos p1 w addBoostShockwave :: diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index d5a1f4213..690244269 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -5,7 +5,7 @@ module Dodge.Picture.SizeInvariant import Control.Lens import Data.Maybe import Dodge.Base.Window -import Dodge.Data.LWorld +import Dodge.Data.CWorld import Dodge.Data.Config import Geometry import Picture @@ -62,7 +62,7 @@ fixedSizePicClampArrow :: Picture -> Point2 -> Configuration -> - LWorld -> + CWorld -> Picture fixedSizePicClampArrow xbord ybord pic p cfig w = pictures diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 55c932e6b..f9242822a 100644 --- a/src/Dodge/Projectile/Update.hs +++ b/src/Dodge/Projectile/Update.hs @@ -97,7 +97,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj) | 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 (_input w)) + = (w ^. cWorld . camPos . camRot) + argV (_mousePos (_input w)) | otherwise = _prjDir pj doThrust :: Proj -> World -> World diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index f614094c4..3a1e3ac6e 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -32,14 +32,14 @@ doDrawing pdata u = do sTicks <- SDL.ticks let w = _uvWorld u cfig = _uvConfig u - rot = w ^. cWorld . lWorld . camPos . camRot - camzoom = w ^. cWorld . lWorld . camPos . camZoom - trans = w ^. cWorld . lWorld . camPos . camCenter + rot = w ^. cWorld . camPos . camRot + camzoom = w ^. cWorld . camPos . camZoom + trans = w ^. cWorld . camPos . camCenter wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig) resFact = resFactorNum $ cfig ^. graphics_resolution_factor (wallPointsCol, windowPoints, wallSPics) = wallsToDraw w lightPoints = lightsToRender cfig w - viewFroms@(V2 vfx vfy) = w ^. cWorld . lWorld . camPos . camViewFrom + viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom viewFrom3d = Vector3 vfx vfy 20 shadV = _pictureShaders pdata lwShad = _lightingWallShadShader pdata diff --git a/src/Dodge/Render/Lights.hs b/src/Dodge/Render/Lights.hs index d1df69a6f..cd55f5c91 100644 --- a/src/Dodge/Render/Lights.hs +++ b/src/Dodge/Render/Lights.hs @@ -15,8 +15,8 @@ lightsToRender cfig w = where getLS = getlsparam . _lsParam getTLS = getlsparam . _tlsParam - cbox = w ^. cWorld . lWorld . camPos . camBoundBox - cpos = w ^. cWorld . lWorld . camPos . camCenter + cbox = w ^. cWorld . camPos . camBoundBox + cpos = w ^. cWorld . camPos . camCenter getlsparam ls | not (pointInPolygon lpos cbox) && extraculltest = Nothing | otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 71cb3b35b..aba56dd3c 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -116,8 +116,8 @@ shiftDraw' fpos fdir fdraw x = cullPoint :: Configuration -> World -> Point2 -> Bool cullPoint cfig w p - | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . camPos . camBoundBox) - | otherwise = dist (w ^. cWorld . lWorld . camPos . camCenter) p < (w ^. cWorld . lWorld . camPos . camViewDistance) + | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . camPos . camBoundBox) + | otherwise = dist (w ^. cWorld . camPos . camCenter) p < (w ^. cWorld . camPos . camViewDistance) extraPics :: Configuration -> World -> Picture extraPics cfig w = @@ -176,7 +176,7 @@ debugDraw' cfig w bl = case bl of Inspect_wall -> drawInspectWalls w Cr_awareness -> drawCreatureDisplayTexts w Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w - Cr_status -> drawCrInfo cfig (w ^. cWorld . lWorld) + Cr_status -> drawCrInfo cfig (w ^. cWorld) Mouse_position -> drawMousePosition cfig w Walls_info -> drawWlIDs cfig w Pathing -> drawPathing cfig w @@ -195,7 +195,7 @@ drawCollisionTest cfig w = <> foldMap (drawLabCrossCol cfig cam blue) (xIntercepts crZoneSize a b) where (a, b) = _lrLine (_input w) - cam = w ^. cWorld . lWorld . camPos + cam = w ^. cWorld . camPos drawCreatureDisplayTexts :: World -> Picture drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures) @@ -279,7 +279,7 @@ drawFarWallDetect w = $ getViewpoints p (_cWorld w) -- $ runIdentity $ S.toList_ $ streamViewpoints p w where - p = w ^. cWorld . lWorld . camPos . camViewFrom + p = w ^. cWorld . camPos . camViewFrom drawDDATest :: World -> Picture drawDDATest w = @@ -290,8 +290,8 @@ drawDDATest w = -- <> color blue (runIdentity (S.foldMap_ drawCross qs')) <> setLayer DebugLayer (color yellow (line [cvf, mwp])) where - cvf = w ^. cWorld . lWorld . camPos . camViewFrom - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + cvf = w ^. cWorld . camPos . camViewFrom + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) --ps = ddaStreamX 50 cvf mwp ps = zoneOfSeg 50 cvf mwp @@ -317,7 +317,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5) - <> line [w ^. cWorld . lWorld . camPos . camViewFrom , p] + <> line [w ^. cWorld . camPos . camViewFrom , p] testPic :: Configuration -> World -> Picture testPic _ _ = mempty @@ -333,7 +333,7 @@ testPic _ _ = mempty drawBoundingBox :: World -> Picture drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x] where - (x : xs) = w ^. cWorld . lWorld . camPos . camBoundBox + (x : xs) = w ^. cWorld . camPos . camBoundBox clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c) @@ -357,11 +357,11 @@ mcSPic mc = rotateSP (_mcDir mc) (drawMachine mc) soundPic :: Configuration -> World -> Sound -> Picture -soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld . lWorld) +soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld) where p = _soundPos s thePic = - rotate (w ^. cWorld . lWorld . camPos . camRot) + rotate (w ^. cWorld . camPos . camRot) . scale theScale theScale . centerText . soundToOnomato @@ -377,8 +377,8 @@ drawMousePosition cfig w = . text $ shortPoint2 mwp where - p = worldPosToScreen (w ^. cWorld . lWorld . camPos) mwp - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + p = worldPosToScreen (w ^. cWorld . camPos) mwp + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) drawWlIDs :: Configuration -> World -> Picture drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls) @@ -392,7 +392,7 @@ drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . . text $ show $ _wlID wl where - p = worldPosToScreen (w ^. cWorld . lWorld . camPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl) + p = worldPosToScreen (w ^. cWorld . camPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl) edgeToPic :: [Point2] -> PathEdge -> Picture edgeToPic poly pe @@ -405,7 +405,7 @@ edgeToPic poly pe drawPathing :: Configuration -> World -> Picture drawPathing cfig w = setLayer DebugLayer $ - foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . lWorld . camPos)) . (^?! _3)) (FGL.labEdges gr) + foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . camPos)) . (^?! _3)) (FGL.labEdges gr) <> foldMap dispInc (graphToIncidence gr) where dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n @@ -436,11 +436,11 @@ crDisplayInfo cfig cam cr fpreShow :: (Show a, Functor f) => String -> f a -> f String fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show) -drawCrInfo :: Configuration -> LWorld -> Picture +drawCrInfo :: Configuration -> CWorld -> Picture drawCrInfo cfig w = setLayer FixedCoordLayer $ renderInfoListsAt (2 * hw - 400) 0 cfig cam $ - mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. creatures + mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures where cam = w ^. camPos hw = halfWidth cfig diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index 6bc2d2523..4800d65f1 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -26,7 +26,7 @@ wallsToDraw w = <*> L.premap getWallSPic L.mconcat ) (wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight wlZoneSize cam) - cam = w ^. cWorld . lWorld . camPos + cam = w ^. cWorld . camPos --wallsToDraw -- :: World diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index f7a0e91ff..297776d8f 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -212,9 +212,9 @@ soundAngle p w . radToDeg . normalizeAngle . (+ pi) - $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . lWorld . camPos . camRot) + $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . camPos . camRot) where - earPos = w ^. cWorld . lWorld . camPos . camViewFrom + earPos = w ^. cWorld . camPos . camViewFrom {- | Uses the first free origin from a list. Does nothing if all origins are already creating sounds. diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index 4f1d6745d..cfa274f82 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/src/Dodge/Targeting/Draw.hs @@ -23,7 +23,7 @@ targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do p <- itm ^? itTargeting . tgPos . _Just let p1 = worldPosToScreen cam p - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + mwp = mouseWorldPos (w ^. input) (w ^. cWorld . camPos) p2 = worldPosToScreen cam mwp thecol = if dist p mwp > 100 then red else white return $ @@ -33,7 +33,7 @@ targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do line [p1, p2] <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp) where - cam = w ^. cWorld . lWorld . camPos + cam = w ^. cWorld . camPos targetDraw :: (Item -> Picture) -> Item -> Creature -> Configuration -> World -> Picture targetDraw f it _ cfig w = fromMaybe mempty $ do @@ -45,7 +45,7 @@ targetDraw f it _ cfig w = fromMaybe mempty $ do uncurryV translate (worldPosToScreen cam p) $ f it where - cam = w ^. cWorld . lWorld . camPos + cam = w ^. cWorld . camPos activeTargetCursorPic :: Picture activeTargetCursorPic = diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index df6ec79ea..35e57feaa 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -64,14 +64,19 @@ import Sound.Data import StrictHelp updateUniverse :: Universe -> Universe -updateUniverse = updateUniverseLast . updateUniverseFirst +updateUniverse u = updateUniverseLast . updateUniverseMid + . over uvWorld (updateCamera cfig) + . over (uvWorld . cWorld . cClock) ( + 1) + $ updateBounds u -- where should this go? next to update camera? + where + cfig = u ^. uvConfig updateUniverseLast :: Universe -> Universe 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 -updateUniverseFirst u +updateUniverseMid :: Universe -> Universe +updateUniverseMid u | concurrentblocking = u | otherwise = case _uvScreenLayers u of (OptionScreen{_scOptionFlag = GameOverOptions} : _) -> @@ -156,7 +161,6 @@ functionalUpdate w = . over uvWorld updateDistortions . over uvWorld updateCreatureSoundPositions . over uvWorld ppEvents - . over uvWorld (updateCamera cfig) . colCrsWalls . over uvWorld simpleCrSprings . over uvWorld zoneCreatures @@ -197,12 +201,9 @@ functionalUpdate w = . over uvWorld updateSeenWalls . over uvWorld updateTerminal . over uvWorld updateRBList - . updateBounds -- where should this go? next to update camera? . over uvWorld updateCloseObjects . over uvWorld updateWheelEvents $ over uvWorld updatePastWorlds w - where - cfig = _uvConfig w updateWheelEvents :: World -> World updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y))) @@ -249,7 +250,7 @@ zoneClouds w = foldl' (flip zoneCloud) zn (w ^. cWorld . lWorld . clouds) updateWorldSelect' :: World -> World -updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . lWorld . camPos)) w +updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . camPos)) w updateWorldSelect :: CamPos -> Input -> Input updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index eec298a84..3637e186b 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -32,7 +32,7 @@ update where your avatar's view is from. -} updateCamera :: Configuration -> World -> World updateCamera cfig w = w - & over (cWorld . lWorld . camPos) (setViewDistance cfig) + & over (cWorld . camPos) (setViewDistance cfig) & moveZoomCamera cfig & updateScopeZoom & rotateCamera cfig @@ -40,11 +40,11 @@ updateCamera cfig w = moveZoomCamera :: Configuration -> World -> World moveZoomCamera cfig w = w - & cWorld . lWorld . camPos . camCenter .~ newcen - & cWorld . lWorld . camPos . camViewFrom .~ newvf - & cWorld . lWorld . camPos . camZoom .~ newzoom - & cWorld . lWorld . camPos . camDefaultZoom .~ newDefaultZoom - & cWorld . lWorld . camPos . camItemZoom .~ newItemZoom + & cWorld . camPos . camCenter .~ newcen + & cWorld . camPos . camViewFrom .~ newvf + & cWorld . camPos . camZoom .~ newzoom + & cWorld . camPos . camDefaultZoom .~ newDefaultZoom + & cWorld . camPos . camItemZoom .~ newItemZoom where --cfig = _uvConfig uv --w = _uvWorld uv @@ -59,23 +59,23 @@ moveZoomCamera cfig 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 (_input w) + offset = rotateV (w ^. cWorld . camPos . camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos (_input w) newzoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope{} -> _scopeZoom zs _ -> newDefaultZoom * newItemZoom idealDefaultZoom = clipZoom wallZoom newDefaultZoom = case yourItem w ^? _Just . itScope of Just zs@ZoomScope{} -> _scopeZoom zs - _ -> changeZoom (w ^. cWorld . lWorld . camPos . camDefaultZoom) idealDefaultZoom + _ -> changeZoom (w ^. cWorld . camPos . camDefaultZoom) idealDefaultZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming (you w) zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom) - newItemZoom = changeZoom (w ^. cWorld . lWorld . camPos . camItemZoom) idealItemZoom + newItemZoom = changeZoom (w ^. cWorld . camPos . camItemZoom) idealItemZoom changeZoom curZoom idealZoom | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed | otherwise = idealZoom - wallZoom = min4 (w ^. cWorld . lWorld . camPos . camBoundDist) + wallZoom = min4 (w ^. cWorld . camPos . camBoundDist) min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)] maxd = max distFromEqmnt distFromEqmnt = foldl' max 1 $ IM.mapMaybe (_eeViewDist . _equipEffect . _itUse) $ getCrEquipment $ you w @@ -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 (_input w) + mousep = rotateV (w ^. cWorld . camPos . camRot) $ _mousePos (_input w) zoomOutLongGun :: World -> World zoomOutLongGun w @@ -166,22 +166,22 @@ rotateToOverlappingWall w = p = _crPos (you w) doWallRotate :: Wall -> World -> World -doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . lWorld . camPos . camRot) +doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . camPos . camRot) where rotateUsing a - | b - b' > 0.01 = w & cWorld . lWorld . camPos . camRot +~ 0.01 - | b - b' < negate 0.01 = w & cWorld . lWorld . camPos . camRot -~ 0.01 + | b - b' > 0.01 = w & cWorld . camPos . camRot +~ 0.01 + | b - b' < negate 0.01 = w & cWorld . camPos . camRot -~ 0.01 | otherwise = w where --b = a * (2 / pi) b = a * (4 / pi) b' = fromIntegral (round b :: Int) -rotateCameraBy :: Float -> LWorld -> LWorld +rotateCameraBy :: Float -> CWorld -> CWorld rotateCameraBy x w = w & camPos . camRot +~ x - & creatures . ix 0 . crInv . ix (crSel (w ^?! creatures . ix 0)) + & lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! lWorld . creatures . ix 0)) . itScope . scopePos %~ rotateV x @@ -189,8 +189,8 @@ rotateCameraBy x w = rotateCamera :: Configuration -> World -> World rotateCamera cfig w | keyl && keyr = w - | keyl = over (cWorld . lWorld) (rotateCameraBy 0.025) w - | keyr = over (cWorld . lWorld) (rotateCameraBy (-0.025)) w + | keyl = over cWorld (rotateCameraBy 0.025) w + | keyr = over cWorld (rotateCameraBy (-0.025)) w | otherwise = ifConfigWallRotate cfig w where keyl = SDL.ScancodeQ `Set.member` _keys (_input w) && notAtTerminal w @@ -239,7 +239,7 @@ farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w) where - f q = (rotateV (negate (w ^. cWorld . lWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) + f q = (rotateV (negate (w ^. cWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) wls q = filter wlIsOpaque $ wlsNearSeg p q w findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 7bc437bc2..085051400 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -31,7 +31,7 @@ updateWheelEvent yi w = case w ^. cWorld . lWorld . hud . hudElement of (_, EquipOptions{}) -> scrollRBOption y w (Nothing, _) -> closeObjScrollDir y w (Just f, _) -> doHeldScroll f y (you w) w - | lbDown -> w & cWorld . lWorld . camPos . camZoom +~ y + | lbDown -> w & cWorld . camPos . camZoom +~ y | invKeyDown -> changeSwapInvSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w DisplayInventory (TweakInventory mi) diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 0e8838c84..26b72a397 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -60,7 +60,7 @@ pressedMBEffectsNoInventory pkeys w w & input . hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle = - w & cWorld . lWorld . camPos . camRot -~ rotation + w & cWorld . camPos . camRot -~ rotation & input . clickMousePos .~ _mousePos (_input w) | isDown ButtonLeft = w & input . hammers . ix DoubleMouseHam .~ HammerDown | otherwise = w diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 3d8774605..faba10f7d 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -58,7 +58,7 @@ accessTerminal mtmid w = case mtmid of torqueCr :: Float -> Int -> World -> World torqueCr x cid w - | cid == 0 = set randGen g $ over (cWorld . lWorld . camPos . camRot) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . camPos . camRot) (+ rot) w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where (rot, g) = randomR (- x, x) $ _randGen w diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 2c96c2d8c..5eb035126 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -72,4 +72,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w spawnSmokeAtCursor :: World -> World spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w where - V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) + V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . camPos)