From 07a1d71039064eed5dc94b4237e9d51fac36d438 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 26 Mar 2023 20:09:00 +0100 Subject: [PATCH] Add general smooth scrolling, move camera into world --- src/Dodge/Base/Collide.hs | 2 +- src/Dodge/Base/Coordinate.hs | 6 ++-- src/Dodge/Bullet.hs | 2 +- src/Dodge/Creature/Action/Blink.hs | 6 ++-- src/Dodge/Creature/Picture/Awareness.hs | 4 +-- src/Dodge/Creature/YourControl.hs | 10 +++--- src/Dodge/Data/CWorld.hs | 1 - src/Dodge/Data/Input.hs | 3 +- src/Dodge/Data/World.hs | 1 + src/Dodge/Debug/Picture.hs | 12 +++---- src/Dodge/Default/World.hs | 5 +-- src/Dodge/Event/Input.hs | 17 +++++---- src/Dodge/HeldUse.hs | 4 +-- src/Dodge/Initialisation.hs | 2 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 4 +-- src/Dodge/Item/Weapon/TriggerType.hs | 12 +++---- src/Dodge/Layout.hs | 2 +- src/Dodge/Luse.hs | 2 +- src/Dodge/Picture/SizeInvariant.hs | 12 +++---- src/Dodge/Projectile/Update.hs | 2 +- src/Dodge/Render.hs | 10 +++--- src/Dodge/Render/Picture.hs | 4 +-- src/Dodge/Render/ShapePicture.hs | 48 ++++++++++++------------- src/Dodge/SoundLogic.hs | 4 +-- src/Dodge/Targeting.hs | 8 ++--- src/Dodge/Targeting/Draw.hs | 4 +-- src/Dodge/TestString.hs | 12 ++++--- src/Dodge/Update.hs | 31 ++++++++++------ src/Dodge/Update/Camera.hs | 47 +++++++++++++----------- src/Dodge/Update/Scroll.hs | 2 +- src/Dodge/WorldEffect.hs | 2 +- src/Dodge/WorldEvent/Cloud.hs | 4 +-- 32 files changed, 154 insertions(+), 131 deletions(-) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index acf416418..cb9418a4f 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -132,7 +132,7 @@ allVisibleWalls :: World -> [(Point2, Wall)] {-# INLINE allVisibleWalls #-} allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 15 where - vPos = w ^. cWorld . cwCam . camViewFrom + vPos = w ^. wCam . camViewFrom overlapCircWalls :: Point2 -> diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 0d2e67726..4099f2da5 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -15,9 +15,9 @@ import Geometry --worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2 --worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate -- where --- doTranslate p = p -.- (w ^. cWorld . lWorld . cwCam . cwcCenter) --- doZoom p = (w ^. cWorld . lWorld . cwCam . cwcZoom) *.* p --- doRotate p = rotateV (negate (w ^. cWorld . lWorld . cwCam . cwcRot)) p +-- doTranslate p = p -.- (w ^. cWorld . lWorld . wCam . cwcCenter) +-- doZoom p = (w ^. cWorld . lWorld . wCam . cwcZoom) *.* p +-- doRotate p = rotateV (negate (w ^. cWorld . lWorld . wCam . cwcRot)) p {- | Transform world coordinates to scaled screen coordinates. - These have to be scaled according to the size of the window to get actual screen positions. diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 7a67fab04..44bd1ffc1 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -82,7 +82,7 @@ useAmmoParams it cr w = return $ FlechetteTrajectory tpos BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do tpos <- cr ^? crTargeting . ctPos . _Just - return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) + return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam)) 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 f8cdf4b8d..d379c36d6 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 . cwCam) + p1 = mouseWorldPos (w ^. input) (w ^. wCam) 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 . cwCam) + mwp = mouseWorldPos (w ^. input) (w ^. wCam) 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 . cwCam) + p1 = mouseWorldPos (w ^. input) (w ^. wCam) 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 3d0be819f..e9b2126a1 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 . cwCam . camViewFrom - theScale = 0.15 / (w ^. cWorld . cwCam . camZoom) + campos = w ^. wCam . camViewFrom + theScale = 0.15 / (w ^. wCam . 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 2b2d258ef..20ab06d45 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -75,15 +75,15 @@ wasdWithAiming w speed cr | otherwise = crMvForward speed theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr' movDir = wasdDir w - dir = fmap ((w ^. cWorld . cwCam . camRot) +) (safeArgV movDir) - movAbs = rotateV (w ^. cWorld . cwCam . camRot) $ normalizeV movDir + dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir) + movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming mouseDir = fromMaybe - (argV (_mousePos (_input w)) + (w ^. cWorld . cwCam . camRot) ) + (argV (_mousePos (_input w)) + (w ^. wCam . camRot) ) $ do itRef <- cr ^? crManipulation . manObject . inInventory . ispItem _ <- cr ^? crInv . ix itRef . itScope . scopePos - return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- _crPos cr + return . argV $ mouseWorldPos (w ^. input) (w ^. wCam) -.- _crPos cr aimTurn :: Float -> Creature -> Creature aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr @@ -120,7 +120,7 @@ pressedMBEffectsTopInventory pkeys w | isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w | isDown SDL.ButtonLeft && inTopInv = doTopInvLeftClick (you w) w | isDown SDL.ButtonMiddle = - w & cWorld . cwCam . camRot -~ rotation + w & wCam . camRot -~ rotation & input . clickMousePos .~ _mousePos (_input w) | otherwise = w where diff --git a/src/Dodge/Data/CWorld.hs b/src/Dodge/Data/CWorld.hs index 143429c40..f86ac42ac 100644 --- a/src/Dodge/Data/CWorld.hs +++ b/src/Dodge/Data/CWorld.hs @@ -24,7 +24,6 @@ import Data.Graph.Inductive data CWorld = CWorld { _lWorld :: LWorld - , _cwCam :: Camera , _cwGen :: CWGen , _cClock :: Int , _seenWalls :: IS.IntSet diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 3d8b15f7b..b20c1fbbc 100644 --- a/src/Dodge/Data/Input.hs +++ b/src/Dodge/Data/Input.hs @@ -23,6 +23,7 @@ data Input = Input , _mouseButtons :: M.Map MouseButton Int -- counts number of frames held down , _scrollAmount :: Int , _previousScrollAmount :: Int + , _smoothScrollAmount :: Int , _lLine :: (Point2, Point2) , _rLine :: (Point2, Point2) , _lrLine :: (Point2, Point2) @@ -31,7 +32,7 @@ data Input = Input , _clickMousePos :: Point2 -- is this in world or screen coords? , _clickPos :: M.Map MouseButton Point2 -- updates when mouse button is pressed , _heldPos :: M.Map MouseButton Point2 -- updates when mouse button is held - -- ideally, lags ONE FRAME BEHIND the stored mouse position + -- lags ONE FRAME BEHIND the stored mouse position , _textInput :: [Either TermSignal Char] , _scrollTestFloat :: Float , _scrollTestInt :: Int diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 3e4867e05..472fbe46e 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -51,6 +51,7 @@ data World = World , _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature , _peZoning :: IntMap (IntMap (Set PathEdgeNodes)) , _gsZoning :: IntMap (IntMap IntSet) + , _wCam :: Camera } data TimeFlowStatus diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 74e48ad9c..723280d65 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 . cwCam) - vp = w ^. cWorld . cwCam . camViewFrom + sp' = screenPolygon cfig (w ^. wCam) + vp = w ^. wCam . camViewFrom sp | pointInPolygon vp sp' = sp' - | otherwise = orderPolygon ((w ^. cWorld . cwCam . camViewFrom) : sp') + | otherwise = orderPolygon ((w ^. wCam . camViewFrom) : sp') sps = zip sp (tail sp ++ [head sp]) pointOnScreen :: Configuration -> Camera -> 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 . cwCam . camViewFrom + sightFrom = w ^. wCam . 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 . cwCam) + scpoly = reverse $ screenPolygon cfig (w ^. wCam) 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 . cwCam) + $ screenPolygon cfig (w ^. wCam) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index c0b2a0d61..5e6d0fa12 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -23,6 +23,7 @@ defaultInput = , _mouseMoving = False , _scrollAmount = 0 , _previousScrollAmount = 0 + , _smoothScrollAmount = 0 , _lrLine = (0, 0) , _lLine = (0, 0) , _rLine = (0, 0) @@ -36,6 +37,7 @@ defaultWorld :: World defaultWorld = World { _cWorld = defaultCWorld + , _wCam = defaultCWCam , _pastWorlds = mempty , _timeFlow = NormalTimeFlow , _input = defaultInput @@ -82,8 +84,7 @@ defaultCWCam = defaultCWorld :: CWorld defaultCWorld = CWorld - { _cwCam = defaultCWCam - , _lWorld = defaultLWorld + { _lWorld = defaultLWorld , _cwGen = defaultCWGen , _cClock = 0 , _seenWalls = mempty diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index 4baa4a7d5..d529ff635 100644 --- a/src/Dodge/Event/Input.hs +++ b/src/Dodge/Event/Input.hs @@ -1,5 +1,6 @@ --- | Capture input events, store them in structures for later use. --- Should not update the world other than this. +{- | Capture input events, store them in structures for later use. + Should not update the world other than this. +-} module Dodge.Event.Input ( handleKeyboardEvent, handleTextInput, @@ -12,6 +13,7 @@ import Dodge.Data.Config import Dodge.Data.Input import LensHelp import SDL + --import qualified Data.Map.Strict as M -- annoyingly, the text input event doesn't register backspace, so deletion has to be @@ -23,8 +25,9 @@ handleTextInput text = textInput %~ (++ map Right text) handleKeyboardEvent :: KeyboardEventData -> Input -> Input handleKeyboardEvent kev = case keyboardEventKeyMotion kev of Released -> pressedKeys . at scode .~ Nothing - Pressed -> (pressedKeys . at scode ?~ val) - . addTermSignal scode + Pressed -> + (pressedKeys . at scode ?~ val) + . addTermSignal scode where val | keyboardEventRepeat kev = LongPress @@ -50,14 +53,16 @@ handleMouseMotionEvent mmev cfig = (0.5 * windowYFloat cfig - fromIntegral y) handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input -handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y +handleMouseWheelEvent mwev = + (scrollAmount +~ fromIntegral y) where V2 _ y = mouseWheelEventPos mwev + handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of Released -> mouseButtons . at thebutton .~ Nothing Pressed -> mouseButtons . at thebutton ?~ 1 -- note that mouse button events are NOT repeating where --- pointtothebutton = mouseButtons . at thebutton + -- pointtothebutton = mouseButtons . at thebutton thebutton = mouseButtonEventButton mbev diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index f1c8b2917..68cb42c5d 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -349,7 +349,7 @@ useMod hm = case hm of directedTelPos _ cr w = (p, a) where p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just - a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- p) + a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p) moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x modcrpos x cr = cr & crDir %~ tweenAngles x (_crOldDir cr) @@ -513,7 +513,7 @@ shootTeslaArc it cr w = useForceFieldGun :: Item -> Creature -> World -> World useForceFieldGun itm cr w = fromMaybe w $ do a <- cr ^? crTargeting . ctPos . _Just - let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + let mwp = mouseWorldPos (w ^. input) (w ^. wCam) b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a) wlline = (a, b) return $ diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 67c179386..e5ad388cb 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -16,7 +16,7 @@ splashScreen = initialWorld :: World initialWorld = defaultWorld - & cWorld . cwCam . camZoom .~ 10 + & wCam . 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 437a751a0..33a3938f8 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -149,7 +149,7 @@ circleLaser it cr w | otherwise = w where cpos = _crPos cr - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + mwp = mouseWorldPos (w ^. input) (w ^. wCam) 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.! itRef @@ -169,7 +169,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 . cwCam) + mwp = mouseWorldPos (w ^. input) (w ^. wCam) mwp' | dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir | otherwise = mwp diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 67653b3d7..ec5a1832b 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -589,7 +589,7 @@ torqueBefore torque feff item cr w w & randGen .~ g & cWorld . lWorld . creatures . ix cid . crDir +~ rot - & cWorld . cwCam . camRot +~ rot + & wCam . camRot +~ rot | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr @@ -610,7 +610,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w w & randGen .~ g & cWorld . lWorld . creatures . ix cid . crDir +~ rot' - & cWorld . cwCam . camRot +~ rot' + & wCam . camRot +~ rot' | otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w where cid = _crID cr @@ -623,7 +623,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 . cwCam . camRot) (+ rot) $ feff item cr w + | cid == 0 = set randGen g $ over (wCam . 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 @@ -661,7 +661,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 . cwCam . camRot) (+ rot) w + | cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr @@ -708,12 +708,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss & crPos %~ (+.+ pos) & crDir .~ thedir pos thedir pos - | dist (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) (_crPos cr) < aimingMuzzlePos cr item = + | dist (mouseWorldPos (w ^. input) (w ^. wCam)) (_crPos cr) < aimingMuzzlePos cr item = argV ( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr) -.- (_crPos cr +.+ pos) ) - | otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- (_crPos cr +.+ pos)) + | otherwise = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- (_crPos cr +.+ pos)) duplicateItem :: (Item -> [Item]) -> ChainEffect duplicateItem fit eff itm cr w = foldr f w (fit itm) diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 65020471b..4d504b464 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -57,7 +57,7 @@ generateLevelFromRoomList gr' w = randomCompass :: World -> World -randomCompass w = w & cWorld . cwCam . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) +randomCompass w = w & wCam . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) -- note the order of traversal of the rooms is important -- hence the reverse diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index 6fab9b357..bbdba904d 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -113,7 +113,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 . cwCam) -.- cpos) + p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- 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 392945d7e..a36d5622b 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.CWorld +import Dodge.Data.World import Dodge.Data.Config import Geometry import Picture @@ -62,7 +62,7 @@ fixedSizePicClampArrow :: Picture -> Point2 -> Configuration -> - CWorld -> + World -> Picture fixedSizePicClampArrow xbord ybord pic p cfig w = pictures @@ -70,16 +70,16 @@ fixedSizePicClampArrow xbord ybord pic p cfig w = , setLayer DebugLayer . color white . setDepth 20 $ arrowPic ] where - winps = screenPolygon cfig (w ^. cwCam) - bords = screenPolygonBord xbord ybord cfig (w ^. cwCam) + winps = screenPolygon cfig (w ^. wCam) + bords = screenPolygonBord xbord ybord cfig (w ^. wCam) borderPoint = intersectSegPolyFirst campos p bords windowPoint = intersectSegPolyFirst campos p winps arrowPic = case borderPoint of Nothing -> blank Just bp -> thickLine 5 [bp, fromMaybe p windowPoint] (V2 x y) = fromMaybe p borderPoint - campos = w ^. cwCam . camCenter - theScale = 1 / (w ^. cwCam . camZoom) + campos = w ^. wCam . camCenter + theScale = 1 / (w ^. wCam . camZoom) --absClamp :: -- -- | clamping value, assumed positive diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 5b930d397..d8fc52d9c 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 . crManipulation . manObject . inInventory . ispItem == w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID - = (w ^. cWorld . cwCam . camRot) + argV (_mousePos (_input w)) + = (w ^. wCam . 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 d6805d723..af7f8881b 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -49,13 +49,13 @@ doDrawing' win pdata u = do checkGLError let w = _uvWorld u cfig = _uvConfig u - rot = w ^. cWorld . cwCam . camRot - camzoom = w ^. cWorld . cwCam . camZoom - trans = w ^. cWorld . cwCam . camCenter + rot = w ^. wCam . camRot + camzoom = w ^. wCam . camZoom + trans = w ^. wCam . camCenter wins = V2 (windowXFloat cfig) (windowYFloat cfig) (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w - lightPoints = lightsToRender cfig (w ^. cWorld . cwCam) (w ^. cWorld . lWorld) - viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . camViewFrom + lightPoints = lightsToRender cfig (w ^. wCam) (w ^. cWorld . lWorld) + viewFroms@(V2 vfx vfy) = w ^. wCam . camViewFrom shadV = _pictureShaders pdata nFls = w ^. cWorld . numberFloorVerxs -- bind as much data into vbos as feasible at this point diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 90d80f85f..f5f4f16a2 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -76,8 +76,8 @@ mouseCursorType u a = fromMaybe 0 $ do cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos return . toClosestMultiple (pi / 32) $ - argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos) - - w ^. cWorld . cwCam . camRot + argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos) + - w ^. wCam . camRot mousePlus :: Picture mousePlus = 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 d3823ea2b..ddbc41528 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -83,7 +83,7 @@ drawSweep cr w = fromMaybe mempty $ do cdir = _crDir cr rot = campos ^. camRot p = _crPos cr - campos = w ^. cWorld . cwCam + campos = w ^. wCam theinput = w ^. input mwp = mouseWorldPos theinput campos @@ -134,8 +134,8 @@ shiftDraw' fpos fdir fdraw x = cullPoint :: Configuration -> World -> Point2 -> Bool cullPoint cfig w p - | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . camBoundBox) - | otherwise = dist (w ^. cWorld . cwCam . camCenter) p < (w ^. cWorld . cwCam . camViewDistance) + | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. wCam . camBoundBox) + | otherwise = dist (w ^. wCam . camCenter) p < (w ^. wCam . camViewDistance) extraPics :: Configuration -> Universe -> Picture extraPics cfig u = @@ -185,7 +185,7 @@ debugDraw' cfig w bl = case bl of Close_shape_culling -> mempty Bound_box_screen -> mempty Show_ms_frame -> mempty - View_boundaries -> viewBoundaries (w ^. cWorld) + View_boundaries -> viewBoundaries w Show_bound_box -> drawBoundingBox w Show_wall_search_rays -> drawWallSearchRays w Show_dda_test -> drawDDATest w @@ -197,7 +197,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) + Cr_status -> drawCrInfo cfig w Mouse_position -> drawMousePosition w Walls_info -> drawWlIDs w Pathing -> drawPathing cfig w @@ -243,7 +243,7 @@ drawWallsNearYou w = fromMaybe mempty $ do drawWallsNearCursor :: World -> Picture drawWallsNearCursor w = - setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCam $ _cWorld w)) w + setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_wCam w)) w where f wl = color rose $ thickLine 3 [a, b] where @@ -307,13 +307,13 @@ drawFarWallDetect w = ) $ getViewpoints p (_cWorld w) where - p = w ^. cWorld . cwCam . camViewFrom + p = w ^. wCam . camViewFrom drawZoneNearPointCursor :: World -> Picture drawZoneNearPointCursor w = foldMap (drawZoneCol orange 50) ps where - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + mwp = mouseWorldPos (w ^. input) (w ^. wCam) ps = [zoneOfPoint 50 mwp] drawDDATest :: World -> Picture @@ -321,8 +321,8 @@ drawDDATest w = foldMap (drawZoneCol orange 50) ps <> setLayer DebugLayer (color yellow (line [cvf, mwp])) where - cvf = w ^. cWorld . cwCam . camViewFrom - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + cvf = w ^. wCam . camViewFrom + mwp = mouseWorldPos (w ^. input) (w ^. wCam) ps = zoneOfSeg 50 cvf mwp drawZoneCol :: Color -> Float -> V2 Int -> Picture @@ -342,7 +342,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5) - <> line [w ^. cWorld . cwCam . camViewFrom, p] + <> line [w ^. wCam . camViewFrom, p] testPic :: Configuration -> World -> Picture testPic _ _ = mempty @@ -350,7 +350,7 @@ testPic _ _ = mempty drawBoundingBox :: World -> Picture drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x] where - (x : xs) = w ^. cWorld . cwCam . camBoundBox + (x : xs) = w ^. wCam . camBoundBox ppDraw :: PressPlate -> Picture ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c) @@ -371,11 +371,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) +soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w where p = _soundPos s thePic = - rotate (w ^. cWorld . cwCam . camRot) + rotate (w ^. wCam . camRot) . scale theScale theScale . centerText . soundToOnomato @@ -391,7 +391,7 @@ drawMousePosition w = . text $ shortPoint2 mwp where - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + mwp = mouseWorldPos (w ^. input) (w ^. wCam) drawWlIDs :: World -> Picture drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls) @@ -404,7 +404,7 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls . text $ show $ _wlID wl where - p = worldPosToScreen (w ^. cWorld . cwCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl) + p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl) edgeToPic :: [Point2] -> PathEdge -> Picture edgeToPic poly pe @@ -417,7 +417,7 @@ edgeToPic poly pe drawPathing :: Configuration -> World -> Picture drawPathing cfig w = setLayer DebugLayer $ - foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCam)) . (^?! _3)) (FGL.labEdges gr) + foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _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 @@ -448,23 +448,23 @@ crDisplayInfo cfig cam cr fpreShow :: (Show a, Functor f) => String -> f a -> f String fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show) -drawCrInfo :: Configuration -> CWorld -> Picture +drawCrInfo :: Configuration -> World -> Picture drawCrInfo cfig w = setLayer FixedCoordLayer $ renderInfoListsAt (2 * hw - 400) 0 cfig cam $ - mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures + mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. cWorld . lWorld . creatures where - cam = w ^. cwCam + cam = w ^. wCam hw = halfWidth cfig -viewBoundaries :: CWorld -> Picture +viewBoundaries :: World -> Picture viewBoundaries w = setLayer DebugLayer $ color green (foldMap (polygonWire . _grBound) grs) - <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w) + <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p (_cWorld w)) where - p = w ^. cwCam . camViewFrom - grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w) + p = w ^. wCam . camViewFrom + grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen $ _cWorld w) viewClipBounds :: Configuration -> World -> Picture viewClipBounds cfig w diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 430477874..f1d626aa0 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -163,9 +163,9 @@ soundAngle p w . radToDeg . normalizeAngle . (+ pi) - $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . cwCam . camRot) + $ argV (vNormal (p -.- earPos)) - (w ^. wCam . camRot) where - earPos = w ^. cWorld . cwCam . camViewFrom + earPos = w ^. wCam . camViewFrom {- | Uses the first free origin from a list. Does nothing if all origins are already creating sounds. diff --git a/src/Dodge/Targeting.hs b/src/Dodge/Targeting.hs index 761d1a51d..3516e694f 100644 --- a/src/Dodge/Targeting.hs +++ b/src/Dodge/Targeting.hs @@ -49,7 +49,7 @@ targetRBCreatureUp cr w . filter (canseepos . _crPos) $ crsNearCirc mwp 40 w canseepos p = hasLOS (_crPos cr) p w - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + mwp = mouseWorldPos (w ^. input) (w ^. wCam) updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t') posFromMaybeID Nothing = Nothing posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos @@ -61,7 +61,7 @@ targetRBCreatureUp cr w targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting targetCursorUpdate w ct = ct - & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + & ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. wCam) & ctActive .~ True & ctType ?~ TargetCursor @@ -69,7 +69,7 @@ targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting targetRBPressUpdate w t | SDL.ButtonRight `M.member` _mouseButtons (_input w) = t - & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) Just + & ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just & ctActive .~ True & ctType ?~ TargetRBPress | otherwise = @@ -100,7 +100,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 . cwCam) -.- sp) + ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- sp) addLaserPic = cWorld . lWorld . lasers .:~ LaserStart diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index 6a8d1851a..5d7cc95a7 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/src/Dodge/Targeting/Draw.hs @@ -26,7 +26,7 @@ targetDistanceDraw :: Creature -> Configuration -> World -> Picture targetDistanceDraw cr _ w = fromMaybe mempty $ do p <- cr ^? crTargeting . ctPos . _Just let p1 = worldPosToScreen cam p - mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + mwp = mouseWorldPos (w ^. input) (w ^. wCam) p2 = worldPosToScreen cam mwp thecol = if dist p mwp > 100 then red else white return . @@ -35,7 +35,7 @@ targetDistanceDraw cr _ w = fromMaybe mempty $ do line [p1, p2] <> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp) where - cam = w ^. cWorld . cwCam + cam = w ^. wCam targetDraw :: Picture -> Creature -> Configuration -> World -> Picture targetDraw f cr _ _ = fromMaybe mempty $ do diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 5240bc335..6d06118a4 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -1,6 +1,7 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} module Dodge.TestString where +import Dodge.SmoothScroll import HelpNum import Dodge.Base.Coordinate import Geometry.Vector @@ -16,9 +17,10 @@ import Dodge.Data.Universe --import qualified Data.Map.Strict as M --import qualified IntMapHelp as IM testStringInit :: Universe -> [String] -testStringInit u = [show $ u ^. uvWorld . input . mouseButtons - , show $ u ^. uvWorld . input . heldPos] --- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCam) +testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount + , show $ getSmoothScrollValue (u ^. uvWorld . input) + ] +-- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam) -- (u ^. uvWorld . cWorld . lWorld) -- , show a -- , show $ u ^. uvWorld . input . mousePos @@ -30,8 +32,8 @@ testStringInit u = [show $ u ^. uvWorld . input . mouseButtons -- w = u ^. uvWorld -- a = fromMaybe 0 $ do -- cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos --- return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos) --- - w ^. cWorld . cwCam . camRot +-- return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos) +-- - w ^. wCam . camRot --[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just] -- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 9d0b84d24..4b9322132 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -8,6 +8,7 @@ module Dodge.Update (updateUniverse) where --import Dodge.InputFocus +import Dodge.SmoothScroll import Color import Control.Applicative import Data.List @@ -74,15 +75,21 @@ updateUniverse u = . maybeOpenTerminal . over (uvWorld . input . textInput) (const mempty) . updateUniverseMid - . updateUseInput -- this should be pushed inside when the universe is paused etc - -- OR the keys should be tested "in game", so to speak + . updateUseInput -- this should be pushed inside when the universe is paused etc + -- OR the keys should be tested "in game", so to speak . over uvWorld (updateCamera cfig) - . over (uvWorld . input) updateScrollTestValue - . over (uvWorld . cWorld . cClock) (+ 1) + . updateUniverseFirst $ u where cfig = u ^. uvConfig +updateUniverseFirst :: Universe -> Universe +updateUniverseFirst u = + u + & uvWorld . input . smoothScrollAmount %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount) + & over (uvWorld . input) updateScrollTestValue + & over (uvWorld . cWorld . cClock) (+ 1) + updateWorldEventFlags :: Universe -> Universe updateWorldEventFlags u = (uvWorld . worldEventFlags .~ mempty) @@ -105,11 +112,12 @@ gotoTerminal w = case _uvScreenLayers w of _ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command" updateUniverseLast :: Universe -> Universe -updateUniverseLast u = u - & uvWorld . input . pressedKeys . each %~ f - & uvWorld . input . mouseMoving .~ False - & uvWorld . input . mouseButtons . each +~ 1 - & uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons)) +updateUniverseLast u = + u + & uvWorld . input . pressedKeys . each %~ f + & uvWorld . input . mouseMoving .~ False + & uvWorld . input . mouseButtons . each +~ 1 + & uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons)) where mp = u ^. uvWorld . input . mousePos f LongPress = LongPress @@ -141,7 +149,7 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of DeathTime{} -> u PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u where - debugcamera = CamInGame /= (u ^. uvWorld . cWorld . cwCam . camControl) + debugcamera = CamInGame /= (u ^. uvWorld . wCam . camControl) pauseTime :: Int -> World -> World pauseTime itmloc w @@ -262,6 +270,7 @@ advanceScrollAmount u = u & uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u) & uvWorld . input . scrollAmount .~ 0 + & uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll updatePastWorlds :: World -> World updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :)) @@ -287,7 +296,7 @@ zoneClouds :: World -> World zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds) updateWorldSelect' :: World -> World -updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCam)) w +updateWorldSelect' w = over input (updateWorldSelect (w ^. wCam)) w updateWorldSelect :: Camera -> 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 a4afdd9f9..a86822e81 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -5,6 +5,7 @@ module Dodge.Update.Camera ( updateCamera, ) where +import Dodge.SmoothScroll import SDL (MouseButton (..)) import Dodge.Base.Coordinate import Dodge.InputFocus @@ -28,7 +29,7 @@ import qualified SDL {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; update where your avatar's view is from. -} updateCamera :: Configuration -> World -> World -updateCamera cfig w = case w ^. cWorld . cwCam . camControl of +updateCamera cfig w = case w ^. wCam . camControl of CamInGame -> updateInGameCamera cfig w CamFloat -> updateFloatingCamera cfig w CamPan -> w @@ -36,9 +37,9 @@ updateCamera cfig w = case w ^. cWorld . cwCam . camControl of updateFloatingCamera :: Configuration -> World -> World updateFloatingCamera cfig w = w & updateBounds cfig - & cWorld . cwCam %~ setViewDistance cfig - & cWorld . cwCam %~ translateFloatingCamera theinput - & cWorld . cwCam %~ zoomFloatingCamera theinput + & wCam %~ setViewDistance cfig + & wCam %~ translateFloatingCamera theinput + & wCam %~ zoomFloatingCamera theinput where theinput = w ^. input @@ -54,14 +55,18 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do return $ cam & camCenter +~ thetran & camViewFrom +~ thetran +zoomFloatingCamera :: Input -> Camera -> Camera zoomFloatingCamera theinput cam = cam + & camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput)) + -- & camZoom *~ (zoomSpeed ^^ negate (theinput ^. smoothScrollAmount)) + updateInGameCamera :: Configuration -> World -> World updateInGameCamera cfig w = w & updateBounds cfig - & over (cWorld . cwCam) (setViewDistance cfig) - & cWorld . cwCam %~ moveZoomCamera cfig (w ^. input) (you w) + & over (wCam) (setViewDistance cfig) + & wCam %~ moveZoomCamera cfig (w ^. input) (you w) & updateScopeZoom & rotateCamera cfig @@ -129,7 +134,7 @@ updateScopeZoom' i w wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl resetscope otherAtt = otherAtt - mp = rotateV (w ^. cWorld . cwCam . camRot) $ _mousePos (_input w) + mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w) doScopeZoom :: Point2 -> Scope -> Scope doScopeZoom mp sc = case sc ^? scopeZoomChange of @@ -194,25 +199,25 @@ rotateToOverlappingWall w = p = _crPos (you w) doWallRotate :: Wall -> World -> World -doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCam . camRot) +doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. wCam . camRot) where rotateUsing a - | b - b' > 0.01 = w & cWorld . cwCam . camRot +~ 0.01 - | b - b' < negate 0.01 = w & cWorld . cwCam . camRot -~ 0.01 + | b - b' > 0.01 = w & wCam . camRot +~ 0.01 + | b - b' < negate 0.01 = w & wCam . camRot -~ 0.01 | otherwise = w where --b = a * (2 / pi) b = a * (4 / pi) b' = fromIntegral (round b :: Int) -rotateCameraBy :: Float -> CWorld -> CWorld +rotateCameraBy :: Float -> World -> World rotateCameraBy x w = w - & cwCam . camRot +~ x - & rotateanyscope + & wCam . camRot +~ x + & cWorld %~ rotateanyscope where rotateanyscope = fromMaybe id $ do - i <- w ^? lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem + i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem return $ lWorld . creatures . ix 0 . crInv . ix i . itScope . scopePos @@ -221,8 +226,8 @@ rotateCameraBy x w = rotateCamera :: Configuration -> World -> World rotateCamera cfig w | keydown SDL.ScancodeQ && keydown SDL.ScancodeE = w - | keydown SDL.ScancodeQ = over cWorld (rotateCameraBy 0.025) w - | keydown SDL.ScancodeE = over cWorld (rotateCameraBy (-0.025)) w + | keydown SDL.ScancodeQ = (rotateCameraBy 0.025) w + | keydown SDL.ScancodeE = (rotateCameraBy (-0.025)) w | otherwise = ifConfigWallRotate cfig w where keydown scode = scode `M.member` _pressedKeys (_input w) && not (inInputFocus w) @@ -249,7 +254,7 @@ farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w) where - f q = (rotateV (negate (w ^. cWorld . cwCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) + f q = (rotateV (negate (w ^. wCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) wls q = filter wlIsOpaque $ wlsNearSeg p q w findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine @@ -257,7 +262,7 @@ 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 . camPos . camCenter) w - | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCam . camViewFrom) w + | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w where hw = halfWidth cfig hh = halfHeight cfig @@ -265,8 +270,8 @@ findBoundDists cfig w updateBounds :: Configuration -> World -> World updateBounds cfig w = w - & cWorld . cwCam . camBoundDist .~ bdists - & cWorld . cwCam . camBoundBox - .~ map ((+.+ w ^. cWorld . cwCam . camCenter) . rotateV (w ^. cWorld . cwCam . camRot)) (rectNSWE n s w' e) + & wCam . camBoundDist .~ bdists + & wCam . camBoundBox + .~ map ((+.+ w ^. wCam . camCenter) . rotateV (w ^. wCam . camRot)) (rectNSWE n s w' e) where bdists@(n, s, e, w') = findBoundDists cfig w diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index 21219a721..abd7b4aa7 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -30,7 +30,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of (_, EquipOptions{}) -> w & rbOptions %~ scrollRBOption yi (Nothing, _) -> closeObjScrollDir y w (Just f, _) -> doHeldScroll f y (you w) w - | lbDown -> w & cWorld . cwCam . camZoom +~ y + | lbDown -> w & wCam . camZoom +~ y | invKeyDown -> changeSwapSel yi w | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w DisplayInventory {_subInventory = ExamineInventory mi} diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index c15fa54c0..1951949f5 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 . cwCam . camRot) (+ rot) w + | cid == 0 = set randGen g $ over (wCam . 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 0ef245fe2..10dd496f7 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -63,7 +63,7 @@ makeStartCloudAt :: Point3 -> World -> World makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50 shellTrailCloud :: Int -> Float -> Point3 -> World -> World -shellTrailCloud age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 30 +shellTrailCloud age fadet = makeCloudAt (CloudColor (3 / 2) fadet (greyN 0.5)) 15 age 30 makeFlamerSmokeAt :: Point3 -> World -> World makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w @@ -73,4 +73,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w spawnSmokeAtCursor :: World -> World spawnSmokeAtCursor w = shellTrailCloud 400 100 (V3 x y 20) w where - V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) + V2 x y = mouseWorldPos (w ^. input) (w ^. wCam)