From 2e7cd0aec2f6e137313fb66b6faf0512de4a96af Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 28 Oct 2022 15:32:46 +0100 Subject: [PATCH] Camera position refactor --- src/Dodge/Base/Collide.hs | 2 +- src/Dodge/Base/Coordinate.hs | 14 +-- src/Dodge/Base/Window.hs | 17 ++-- src/Dodge/Creature/Picture/Awareness.hs | 4 +- src/Dodge/Creature/YourControl.hs | 6 +- src/Dodge/CullBox.hs | 8 +- src/Dodge/Data/CamPos.hs | 28 ++++++ src/Dodge/Data/LWorld.hs | 17 +--- src/Dodge/Debug/Picture.hs | 22 ++--- src/Dodge/Default/World.hs | 24 ++--- src/Dodge/Initialisation.hs | 2 +- src/Dodge/Item/Weapon/TriggerType.hs | 8 +- src/Dodge/Layout.hs | 2 +- src/Dodge/Picture/SizeInvariant.hs | 113 ++++++++++++------------ src/Dodge/Projectile/Update.hs | 2 +- src/Dodge/Render.hs | 8 +- src/Dodge/Render/Lights.hs | 4 +- src/Dodge/Render/ShapePicture.hs | 20 ++--- src/Dodge/SoundLogic.hs | 4 +- src/Dodge/Update/Camera.hs | 34 +++---- src/Dodge/Update/Scroll.hs | 2 +- src/Dodge/Update/UsingInput.hs | 2 +- src/Dodge/WorldEffect.hs | 2 +- src/Dodge/Zoning/World.hs | 2 +- 24 files changed, 184 insertions(+), 163 deletions(-) create mode 100644 src/Dodge/Data/CamPos.hs diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 41f97884a..f6520d508 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 . cwCam . cwcViewFrom + vPos = w ^. cWorld . lWorld . camPos . camViewFrom --allVisibleWalls :: World -> StreamOf (Point2,Wall) --{-# INLINE allVisibleWalls #-} diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index fb67b8a64..83b03790b 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -23,11 +23,11 @@ import Control.Lens -} worldPosToScreen :: World -> Point2 -> Point2 worldPosToScreen w = - rotateV (negate $ cam ^. cwcRot) - . ((cam ^. cwcZoom) *.*) - . (-.- (cam ^. cwcCenter)) + rotateV (negate $ cam ^. camRot) + . ((cam ^. camZoom) *.*) + . (-.- (cam ^. camCenter)) where - cam = w ^. cWorld . lWorld . cwCam + cam = w ^. cWorld . lWorld . camPos {- | Transform coordinates from the map position to screen coordinates. @@ -46,10 +46,10 @@ cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate -- | The mouse position in world coordinates. mouseWorldPos :: World -> Point2 mouseWorldPos w = - (cam ^. cwcCenter) - +.+ (1 / (cam ^. cwcZoom)) *.* rotateV (cam ^. cwcRot) (_mousePos w) + (cam ^. camCenter) + +.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos w) where - cam = w ^. cWorld . lWorld . cwCam + cam = w ^. cWorld . lWorld . camPos ---- | The mouse position in map coordinates --mouseCartePos :: World -> Point2 diff --git a/src/Dodge/Base/Window.hs b/src/Dodge/Base/Window.hs index 6311cec72..bb9172c1c 100644 --- a/src/Dodge/Base/Window.hs +++ b/src/Dodge/Base/Window.hs @@ -7,19 +7,20 @@ module Dodge.Base.Window ( screenBox, ) where -import Dodge.Data.Universe +import Dodge.Data.CamPos +import Dodge.Data.Config import Geometry import Control.Lens -- | A box covering the screen in world coordinates -screenPolygon :: Configuration -> World -> [Point2] +screenPolygon :: Configuration -> CamPos -> [Point2] screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig where - scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) + scRot = rotateV (w ^. camRot) scZoom p - | (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p + | (w ^. camZoom) /= 0 = (1 / (w ^. camZoom)) *.* p | otherwise = p - scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter) + scTran p = p +.+ (w ^. camCenter) -- | A box covering the screen in world coordinates, with a x and y border screenPolygonBord :: @@ -28,16 +29,16 @@ screenPolygonBord :: -- | Y border Float -> Configuration -> - World -> + CamPos -> [Point2] screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br] where hw = halfWidth cfig - xbord hh = halfHeight cfig - ybord scZoom p - | (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p + | (w ^. camZoom) /= 0 = (1 / (w ^. camZoom)) *.* p | otherwise = p - theTransform = (+.+ (w ^. cWorld . lWorld . cwCam . cwcCenter)) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) . scZoom + theTransform = (+.+ (w ^. camCenter)) . rotateV (w ^. camRot) . scZoom tr = theTransform (V2 hw hh) tl = theTransform (V2 (- hw) hh) br = theTransform (V2 hw (- hh)) diff --git a/src/Dodge/Creature/Picture/Awareness.hs b/src/Dodge/Creature/Picture/Awareness.hs index db189407e..764e65d47 100644 --- a/src/Dodge/Creature/Picture/Awareness.hs +++ b/src/Dodge/Creature/Picture/Awareness.hs @@ -27,8 +27,8 @@ creatureDisplayText w cr = w cr where - campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom - theScale = 0.15 / (w ^. cWorld . lWorld . cwCam . cwcZoom) + campos = w ^. cWorld . lWorld . camPos . camViewFrom + theScale = 0.15 / (w ^. cWorld . lWorld . 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 e8af5be94..e197d21f2 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 . cwCam . cwcRot) + argV movDir - movAbs = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ normalizeV movDir + dir = (w ^. cWorld . lWorld . camPos . camRot) + argV movDir + movAbs = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ normalizeV movDir 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 . cwCam . cwcRot) + _ -> argV (_mousePos w) + (w ^. cWorld . lWorld . camPos . camRot) wasdM :: SDL.Scancode -> Point2 wasdM scancode = case scancode of diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs index ed288373f..cdf97996b 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 . cwCam . cwcCenter) w + | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . lWorld . 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 . cwCam . cwcBoundDist .~ bdists - & uvWorld . cWorld . lWorld . cwCam . cwcBoundBox - .~ map ((+.+ w ^. cWorld . lWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)) (rectNSWE n s w' e) + & 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) where w = _uvWorld uv cfig = _uvConfig uv diff --git a/src/Dodge/Data/CamPos.hs b/src/Dodge/Data/CamPos.hs new file mode 100644 index 000000000..46c5c6c74 --- /dev/null +++ b/src/Dodge/Data/CamPos.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +module Dodge.Data.CamPos where + +import Control.Lens +import Data.Aeson +import Data.Aeson.TH +import Geometry.Data + +data CamPos = CamPos + { _camCenter :: Point2 + , _camRot :: Float + , _camZoom :: Float -- smaller values zoom out + , _camItemZoom :: Float + , _camDefaultZoom :: Float + , _camViewFrom :: Point2 + , _camViewDistance :: Float + , _camBoundBox :: [Point2] + , _camBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative + } + +makeLenses ''CamPos +concat + <$> mapM + (deriveJSON defaultOptions) + [ ''CamPos ] diff --git a/src/Dodge/Data/LWorld.hs b/src/Dodge/Data/LWorld.hs index 434ebeec7..8c540e3a2 100644 --- a/src/Dodge/Data/LWorld.hs +++ b/src/Dodge/Data/LWorld.hs @@ -45,8 +45,10 @@ 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 @@ -98,7 +100,7 @@ import qualified IntMapHelp as IM import Picture.Data data LWorld = LWorld - { _cwCam :: CWCam + { _camPos :: CamPos , _creatures :: IM.IntMap Creature , _crZoning :: IM.IntMap (IM.IntMap IS.IntSet) , _creatureGroups :: IM.IntMap CrGroupParams @@ -159,17 +161,6 @@ data LWorld = LWorld , _distortions :: [Distortion] , _lClock :: Int } -data CWCam = CWCam - { _cwcCenter :: Point2 - , _cwcRot :: Float - , _cwcZoom :: Float -- smaller values zoom out - , _cwcItemZoom :: Float - , _cwcDefaultZoom :: Float - , _cwcViewFrom :: Point2 - , _cwcViewDistance :: Float - , _cwcBoundBox :: [Point2] - , _cwcBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative - } data WorldBeams = WorldBeams { _blockingBeams :: [Beam] , _lightBeams :: [Beam] @@ -178,12 +169,10 @@ data WorldBeams = WorldBeams } makeLenses ''LWorld -makeLenses ''CWCam makeLenses ''WorldBeams concat <$> mapM (deriveJSON defaultOptions) [ ''WorldBeams - , ''CWCam , ''LWorld ] diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index a4c90f6cf..bc19fb6e6 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -17,14 +17,14 @@ printRotPoint r p = . uncurryV translate p $ pictures [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)] -outsideScreenPolygon :: Configuration -> World -> [Point2] +outsideScreenPolygon :: Configuration -> CamPos -> [Point2] outsideScreenPolygon cfig w = [tr, tl, bl, br] where - scRot = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) + scRot = rotateV (w ^. camRot) scZoom p - | (w ^. cWorld . lWorld . cwCam . cwcZoom) /= 0 = (1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)) *.* p + | (w ^. camZoom) /= 0 = (1 / (w ^. camZoom)) *.* p | otherwise = error "Trying to set screen zoom to zero" - scTran p = p +.+ (w ^. cWorld . lWorld . cwCam . cwcCenter) + scTran p = p +.+ (w ^. camCenter) tr = f 3 3 tl = f (-3) 3 br = f 3 (-3) @@ -39,14 +39,14 @@ lineOnScreenCone cfig w p1 p2 = || pointInPolygon p2 sp || any (isJust . uncurry (intersectSegSeg p1 p2)) sps where - sp' = screenPolygon cfig w - vp = w ^. cWorld . lWorld . cwCam . cwcViewFrom + sp' = screenPolygon cfig (w ^. cWorld . lWorld . camPos) + vp = w ^. cWorld . lWorld . camPos . camViewFrom sp | pointInPolygon vp sp' = sp' - | otherwise = orderPolygon ((w ^. cWorld . lWorld . cwCam . cwcViewFrom) : sp') + | otherwise = orderPolygon ((w ^. cWorld . lWorld . camPos . camViewFrom) : sp') sps = zip sp (tail sp ++ [head sp]) -pointOnScreen :: Configuration -> World -> Point2 -> Bool +pointOnScreen :: Configuration -> CamPos -> Point2 -> Bool pointOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w drawWallFace :: Configuration -> World -> Wall -> Picture @@ -56,13 +56,13 @@ drawWallFace cfig w wall where (x, y) = _wlLine wall points = extendConeToScreenEdge cfig w sightFrom (x, y) - sightFrom = w ^. cWorld . lWorld . cwCam . cwcViewFrom + sightFrom = w ^. cWorld . lWorld . 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 + scpoly = reverse $ screenPolygon cfig (w ^. cWorld . lWorld . 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 + $ screenPolygon cfig (w ^. cWorld . lWorld . camPos) diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 4022f6e92..73a01c4fd 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -43,18 +43,18 @@ defaultCWGen = , _cwgRoomClipping = [] } -defaultCWCam :: CWCam +defaultCWCam :: CamPos defaultCWCam = - CWCam - { _cwcCenter = V2 0 0 - , _cwcRot = 0 - , _cwcZoom = 1 - , _cwcDefaultZoom = 1 - , _cwcViewFrom = V2 0 0 - , _cwcViewDistance = 1000 - , _cwcItemZoom = 1 - , _cwcBoundBox = square 100 - , _cwcBoundDist = (100, -100, 100, -100) + CamPos + { _camCenter = V2 0 0 + , _camRot = 0 + , _camZoom = 1 + , _camDefaultZoom = 1 + , _camViewFrom = V2 0 0 + , _camViewDistance = 1000 + , _camItemZoom = 1 + , _camBoundBox = square 100 + , _camBoundDist = (100, -100, 100, -100) } defaultCWorld :: CWorld @@ -70,7 +70,7 @@ defaultCWorld = defaultLWorld :: LWorld defaultLWorld = LWorld - { _cwCam = defaultCWCam + { _camPos = defaultCWCam , _magnets = IM.empty , _modifications = IM.empty , _creatures = IM.empty diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index 3ae465e97..8c4d3c5fa 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -16,7 +16,7 @@ splashScreen = initialWorld :: World initialWorld = defaultWorld - & cWorld . lWorld . cwCam . cwcZoom .~ 10 + & cWorld . lWorld . 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/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 372ca1d12..c4456f2b2 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 . cwCam . cwcRot +~ rot + & cWorld . lWorld . 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 . cwCam . cwcRot +~ rot' + & cWorld . lWorld . 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 . cwCam . cwcRot) (+ rot) $ feff item cr w + | cid == 0 = set randGen g $ over (cWorld . lWorld . 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 . cwCam . cwcRot) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . lWorld . camPos . camRot) (+ rot) w | otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w where cid = _crID cr diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 8217b625c..0bc38b5b0 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 . cwCam . cwcRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w) +randomCompass w = w & cWorld . lWorld . 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/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index 0459d0ca9..d5a1f4213 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -1,55 +1,58 @@ -module Dodge.Picture.SizeInvariant where +module Dodge.Picture.SizeInvariant + ( fixedSizePicClampArrow + ) where import Control.Lens import Data.Maybe import Dodge.Base.Window -import Dodge.Data.Universe +import Dodge.Data.LWorld +import Dodge.Data.Config import Geometry import Picture -fixedSizePicAt :: - Picture -> - Point2 -> - World -> - Picture -fixedSizePicAt pic p w = - setLayer DebugLayer - . setDepth 20 - . translate x y - . scale theScale theScale - $ pic - where - campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom - v = p -.- campos - theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom) - (V2 x y) = campos +.+ v +--fixedSizePicAt :: +-- Picture -> +-- Point2 -> +-- CamPos -> +-- Picture +--fixedSizePicAt pic p w = +-- setLayer DebugLayer +-- . setDepth 20 +-- . translate x y +-- . scale theScale theScale +-- $ pic +-- where +-- campos = w ^. camViewFrom +-- v = p -.- campos +-- theScale = 1 / (w ^. camZoom) +-- (V2 x y) = campos +.+ v -fixedSizePicClamp :: - -- | horizontal border - Int -> - -- | vertical border - Int -> - Picture -> - Point2 -> - Configuration -> - World -> - Picture -fixedSizePicClamp xbord ybord pic p cfig w = - setLayer DebugLayer - . setDepth 20 - . translate x y - . scale theScale theScale - $ pic - where - r = negate $ w ^. cWorld . lWorld . cwCam . cwcRot - z = w ^. cWorld . lWorld . cwCam . cwcZoom - campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom - v = p -.- campos - theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom) - (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr') - (V2 xr yr) = rotateV r v - xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr - yr' = absClamp ((halfHeight cfig - fromIntegral ybord) / z) yr +--fixedSizePicClamp :: +-- -- | horizontal border +-- Int -> +-- -- | vertical border +-- Int -> +-- Picture -> +-- Point2 -> +-- Configuration -> +-- CamPos -> +-- Picture +--fixedSizePicClamp xbord ybord pic p cfig w = +-- setLayer DebugLayer +-- . setDepth 20 +-- . translate x y +-- . scale theScale theScale +-- $ pic +-- where +-- r = negate $ w ^. camRot +-- z = w ^. camZoom +-- campos = w ^. camViewFrom +-- v = p -.- campos +-- theScale = 1 / (w ^. camZoom) +-- (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr') +-- (V2 xr yr) = rotateV r v +-- xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr +-- yr' = absClamp ((halfHeight cfig - fromIntegral ybord) / z) yr fixedSizePicClampArrow :: -- | horizontal border @@ -59,7 +62,7 @@ fixedSizePicClampArrow :: Picture -> Point2 -> Configuration -> - World -> + LWorld -> Picture fixedSizePicClampArrow xbord ybord pic p cfig w = pictures @@ -67,20 +70,20 @@ fixedSizePicClampArrow xbord ybord pic p cfig w = , setLayer DebugLayer . color white . setDepth 20 $ arrowPic ] where - winps = screenPolygon cfig w - bords = screenPolygonBord xbord ybord cfig w + winps = screenPolygon cfig (w ^. camPos) + bords = screenPolygonBord xbord ybord cfig (w ^. camPos) 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 ^. cWorld . lWorld . cwCam . cwcCenter - theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom) + campos = w ^. camPos . camCenter + theScale = 1 / (w ^. camPos . camZoom) -absClamp :: - -- | clamping value, assumed positive - Float -> - Float -> - Float -absClamp maxVal = max (negate maxVal) . min maxVal +--absClamp :: +-- -- | clamping value, assumed positive +-- Float -> +-- Float -> +-- Float +--absClamp maxVal = max (negate maxVal) . min maxVal diff --git a/src/Dodge/Projectile/Update.hs b/src/Dodge/Projectile/Update.hs index 8e381bdb4..54075a54f 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 w && w ^? cWorld . lWorld . creatures . ix cid . crInvSel . iselPos == w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID - = (w ^. cWorld . lWorld . cwCam . cwcRot) + argV (_mousePos w) + = (w ^. cWorld . lWorld . camPos . camRot) + argV (_mousePos w) | otherwise = _prjDir pj doThrust :: Proj -> World -> World diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index c71b983aa..f614094c4 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 . cwCam . cwcRot - camzoom = w ^. cWorld . lWorld . cwCam . cwcZoom - trans = w ^. cWorld . lWorld . cwCam . cwcCenter + rot = w ^. cWorld . lWorld . camPos . camRot + camzoom = w ^. cWorld . lWorld . camPos . camZoom + trans = w ^. cWorld . lWorld . 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 . cwCam . cwcViewFrom + viewFroms@(V2 vfx vfy) = w ^. cWorld . lWorld . 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 7a0071fb5..d1df69a6f 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 . cwCam . cwcBoundBox - cpos = w ^. cWorld . lWorld . cwCam . cwcCenter + cbox = w ^. cWorld . lWorld . camPos . camBoundBox + cpos = w ^. cWorld . lWorld . 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 f9b6bc799..223e99e6c 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 . cwCam . cwcBoundBox) - | otherwise = dist (w ^. cWorld . lWorld . cwCam . cwcCenter) p < (w ^. cWorld . lWorld . cwCam . cwcViewDistance) + | 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) extraPics :: Configuration -> World -> Picture extraPics cfig w = @@ -278,7 +278,7 @@ drawFarWallDetect w = $ getViewpoints p w -- $ runIdentity $ S.toList_ $ streamViewpoints p w where - p = w ^. cWorld . lWorld . cwCam . cwcViewFrom + p = w ^. cWorld . lWorld . camPos . camViewFrom drawDDATest :: World -> Picture drawDDATest w = @@ -289,7 +289,7 @@ drawDDATest w = -- <> color blue (runIdentity (S.foldMap_ drawCross qs')) <> setLayer DebugLayer (color yellow (line [cvf, mwp])) where - cvf = w ^. cWorld . lWorld . cwCam . cwcViewFrom + cvf = w ^. cWorld . lWorld . camPos . camViewFrom mwp = mouseWorldPos w --ps = ddaStreamX 50 cvf mwp ps = zoneOfSeg 50 cvf mwp @@ -316,7 +316,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5) - <> line [w ^. cWorld . lWorld . cwCam . cwcViewFrom , p] + <> line [w ^. cWorld . lWorld . camPos . camViewFrom , p] testPic :: Configuration -> World -> Picture testPic _ _ = mempty @@ -332,7 +332,7 @@ testPic _ _ = mempty drawBoundingBox :: World -> Picture drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x] where - (x : xs) = w ^. cWorld . lWorld . cwCam . cwcBoundBox + (x : xs) = w ^. cWorld . lWorld . camPos . camBoundBox clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (drawCloud (_clPict c) c) @@ -356,11 +356,11 @@ mcSPic mc = rotateSP (_mcDir mc) (drawMachine mc) soundPic :: Configuration -> World -> Sound -> Picture -soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w +soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld . lWorld) where p = _soundPos s thePic = - rotate (w ^. cWorld . lWorld . cwCam . cwcRot) + rotate (w ^. cWorld . lWorld . camPos . camRot) . scale theScale theScale . centerText . soundToOnomato @@ -404,7 +404,7 @@ edgeToPic poly pe drawPathing :: Configuration -> World -> Picture drawPathing cfig w = setLayer DebugLayer $ - foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr) + foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . lWorld . 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 @@ -430,7 +430,7 @@ crDisplayInfo cfig w cr | otherwise = Nothing where ap = _crActionPlan cr - crOnScreen = pointOnScreen cfig w $ _crPos cr + crOnScreen = pointOnScreen cfig (w ^. cWorld . lWorld . camPos) $ _crPos cr fpreShow :: (Show a, Functor f) => String -> f a -> f String fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show) diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index d78840d10..f7a0e91ff 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 . cwCam . cwcRot) + $ argV (vNormal (p -.- earPos)) - (w ^. cWorld . lWorld . camPos . camRot) where - earPos = w ^. cWorld . lWorld . cwCam . cwcViewFrom + earPos = w ^. cWorld . lWorld . camPos . camViewFrom {- | Uses the first free origin from a list. Does nothing if all origins are already creating sounds. diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 4387f7158..e08277175 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -41,11 +41,11 @@ updateCamera uv = moveZoomCamera :: Universe -> Universe moveZoomCamera uv = uv - & uvWorld . cWorld . lWorld . cwCam . cwcCenter .~ newcen - & uvWorld . cWorld . lWorld . cwCam . cwcViewFrom .~ newvf - & uvWorld . cWorld . lWorld . cwCam . cwcZoom .~ newzoom - & uvWorld . cWorld . lWorld . cwCam . cwcDefaultZoom .~ newDefaultZoom - & uvWorld . cWorld . lWorld . cwCam . cwcItemZoom .~ newItemZoom + & uvWorld . cWorld . lWorld . camPos . camCenter .~ newcen + & uvWorld . cWorld . lWorld . camPos . camViewFrom .~ newvf + & uvWorld . cWorld . lWorld . camPos . camZoom .~ newzoom + & uvWorld . cWorld . lWorld . camPos . camDefaultZoom .~ newDefaultZoom + & uvWorld . cWorld . lWorld . camPos . camItemZoom .~ newItemZoom where cfig = _uvConfig uv w = _uvWorld uv @@ -60,23 +60,23 @@ moveZoomCamera uv = guard (SDL.ButtonRight `M.member` _mouseButtons w) yourItem w ^? _Just . itScope . scopePos newcen = cpos +.+ fromMaybe (V2 0 0) mscopeoffset +.+ offset - offset = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos w + offset = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ ((newzoom - newDefaultZoom) / (newDefaultZoom * newzoom)) *.* _mousePos 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 . cwCam . cwcDefaultZoom) idealDefaultZoom + _ -> changeZoom (w ^. cWorld . lWorld . camPos . camDefaultZoom) idealDefaultZoom idealItemZoom = fromMaybe 1 $ do guard $ crIsAiming (you w) zoomFromItem' <$> (yourItem w ^? _Just . itUse . heldAim . aimZoom) - newItemZoom = changeZoom (w ^. cWorld . lWorld . cwCam . cwcItemZoom) idealItemZoom + newItemZoom = changeZoom (w ^. cWorld . lWorld . 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 . cwCam . cwcBoundDist) + wallZoom = min4 (w ^. cWorld . lWorld . 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 @@ -131,7 +131,7 @@ zoomInLongGun w ycr = you w Just currentZoom = wp ^? itScope . scopeZoom newzoom = (wp ^?! itScope . scopeZoom) / zoomSpeed - mousep = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ _mousePos w + mousep = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ _mousePos w zoomOutLongGun :: World -> World zoomOutLongGun w @@ -168,11 +168,11 @@ rotateToOverlappingWall w = p = _crPos (you w) doWallRotate :: Wall -> World -> World -doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . lWorld . cwCam . cwcRot) +doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. cWorld . lWorld . camPos . camRot) where rotateUsing a - | b - b' > 0.01 = w & cWorld . lWorld . cwCam . cwcRot +~ 0.01 - | b - b' < negate 0.01 = w & cWorld . lWorld . cwCam . cwcRot -~ 0.01 + | b - b' > 0.01 = w & cWorld . lWorld . camPos . camRot +~ 0.01 + | b - b' < negate 0.01 = w & cWorld . lWorld . camPos . camRot -~ 0.01 | otherwise = w where --b = a * (2 / pi) @@ -182,7 +182,7 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. rotateCameraBy :: Float -> World -> World rotateCameraBy x w = w - & cWorld . lWorld . cwCam . cwcRot +~ x + & cWorld . lWorld . camPos . camRot +~ x & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_lWorld (_cWorld w)) IM.! 0)) . itScope . scopePos @@ -218,8 +218,8 @@ clipZoom = min 20 . max 0.2 setViewDistance :: Configuration -> World -> World setViewDistance cfig w = - w & cWorld . lWorld . cwCam . cwcViewDistance - .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . cwCam . cwcZoom) + w & cWorld . lWorld . camPos . camViewDistance + .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . camPos . camZoom) getViewpoints :: Point2 -> World -> [Point2] {-# INLINE getViewpoints #-} @@ -241,7 +241,7 @@ farWallDistDirection p w = boundPoints $ map f $ getViewpoints p w where - f q = (rotateV (negate (w ^. cWorld . lWorld . cwCam . cwcRot)) . (-.- p)) (foldl' findPoint q (wls q)) + f q = (rotateV (negate (w ^. cWorld . lWorld . 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 8c30552e9..8d1f069e2 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 . cwCam . cwcZoom +~ y + | lbDown -> w & cWorld . lWorld . 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 1e4b45861..0732c4819 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -60,7 +60,7 @@ pressedMBEffectsNoInventory pkeys w w & hammers . ix DoubleMouseHam .~ HammerDown | isDown ButtonRight && inTopInv = w | isDown ButtonMiddle = - w & cWorld . lWorld . cwCam . cwcRot -~ rotation + w & cWorld . lWorld . camPos . camRot -~ rotation & clickMousePos .~ _mousePos w | isDown ButtonLeft = w & hammers . ix DoubleMouseHam .~ HammerDown | otherwise = w diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index d435766a7..3d8774605 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 . cwCam . cwcRot) (+ rot) w + | cid == 0 = set randGen g $ over (cWorld . lWorld . 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/Zoning/World.hs b/src/Dodge/Zoning/World.hs index 8d7fe5baa..fb88b9135 100644 --- a/src/Dodge/Zoning/World.hs +++ b/src/Dodge/Zoning/World.hs @@ -11,7 +11,7 @@ zoneOfSight s w = , b <- [minimum ys .. maximum ys] ] where - (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . lWorld . cwCam . cwcBoundBox + (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . lWorld . camPos . camBoundBox sizeZoneOfPoint (V2 x y) = (f x, f y) where f = floor . (/ s)