From 349f4c27832ab6bd1e14a9c73acbdb5f4c6d4049 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 18 Aug 2021 18:52:09 +0200 Subject: [PATCH] Refactor dynamic camera code --- src/Dodge/Update.hs | 1 + src/Dodge/Update/Camera.hs | 56 ++++++++++++++++++++++++++++---------- 2 files changed, 42 insertions(+), 15 deletions(-) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index a79fed76f..3c0b66c02 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -88,6 +88,7 @@ functionalUpdate w = case _menuLayers w of where (x,y) = cloudZoneOfPoint $ _clPos cl +-- | Note the explict use of record syntax. Using lens creates a space leak. resetWorldEvents :: World -> World resetWorldEvents w = w {_worldEvents = id} diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 34361578c..144a095a6 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -14,11 +14,15 @@ import Dodge.Config.KeyConfig import Dodge.Item.Attachment.Data import Geometry +import qualified Data.List.NonEmpty as NEL import Control.Lens +--import Control.Applicative import Data.Maybe import qualified Data.Set as S import qualified Data.IntMap.Strict as IM import qualified SDL +import Data.Monoid +import Data.Semigroup {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; update where your avatar's view is from. -} updateCamera :: World -> World @@ -154,25 +158,47 @@ autoZoomCam w = over cameraZoom changeZoom w zoomOutSpeed = 15 scZoom = fromMaybe 1 $ yourItem w ^? itAttachment . _Just . scopeZoom + farWallDist :: Point2 -> World -> Float -{-# INLINE farWallDist #-} -farWallDist cpos w = min (halfWidth w / (horizontalMax+50) ) (halfHeight w / (verticalMax+50) ) +--{-# INLINE farWallDist #-} +farWallDist cpos w = values' + --min (halfWidth w / (horizontalMax+50) ) (halfHeight w / (verticalMax+50) ) where - horizontalMax = maximum $ map (h' (V2 1 0)) rRays ++ map (h' (V2 (-1) 0) ) lRays - verticalMax = maximum $ map (h' (V2 0 1)) tRays ++ map (h' (V2 0 (-1))) bRays - --h p = fromMaybe p $ collidePointIndirect cpos p $ wallsAlongLine cpos p w - --h p = fromMaybe p . collidePointIndirect cpos p $ _walls w + horizontalMax = maximum $ map (horSize . h . (+.+) cpos . rotateV camRot) hRays + verticalMax = maximum $ map (verSize . h . (+.+) cpos . rotateV camRot) vRays wos = wallsOnScreen w - h p = fromMaybe p $ collidePointIndirect cpos p wos - h' x p = dotV (rotateV camRot x) (p -.- cpos) + rv = rotateV camRot (V2 1 0) + rh = rotateV camRot (V2 0 1) + horSize = abs . dotV rv . (-.- cpos) + verSize = abs . dotV rh . (-.- cpos) camRot = _cameraRot w - rRays = rotF [V2 maxViewDistance y | y <- zs] - lRays = rotF [V2 (-maxViewDistance) y | y <- zs] - tRays = rotF [V2 y maxViewDistance | y <- zs] - bRays = rotF [V2 y (-maxViewDistance) | y <- zs] - rotF = map (h . (+.+) cpos . rotateV (_cameraRot w)) - zs = takeWhile (< maxViewDistance) [-maxViewDistance,negate $ 0.75*maxViewDistance..] - maxViewDistance = 800 + hRays = [V2 x y | y <- zs , x <- [-maxViewDistance,maxViewDistance]] + vRays = [V2 x y | x <- zs , y <- [-maxViewDistance,maxViewDistance]] + h p = fromMaybe p $ collidePointIndirect cpos p wos + zs = [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance] + zs' = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance] + hw = halfWidth w + hh = halfHeight w + d x = Min . (x /) . (+ 50) . fromMaybe maxViewDistance . fmap getMax . getAp + values' = getMin . uncurry (<>) $ bimap (d hw) (d hh) $ sconcat $ NEL.map vsAt zs' + --values = map (\x -> (valueAtWidth x, valueAtHeight x)) zs + viewDistAtHeight = rotateV camRot . V2 maxViewDistance + viewDistAtWidth x = rotateV camRot $ V2 x maxViewDistance + vsAt x = (valueAtWidth x,valueAtHeight x) + valueAtHeight h = cpiv (cpos +.+ x) <> cpiv (cpos -.- x) + where + x = viewDistAtHeight h + valueAtWidth h = cpih (cpos +.+ x) <> cpih (cpos -.- x) + where + x = viewDistAtWidth h + cpiv p = Ap $ fmap (Max . horSize) $ collidePointIndirect cpos p wos + cpih p = Ap $ fmap (Max . verSize) $ collidePointIndirect cpos p wos + +zs :: [Float] +zs = [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance] +maxViewDistance :: Float +maxViewDistance = 800 + --dirRays :: Float -> [Point2] --dirRays dir = take 11 $ iterate (rotateV (0.5 * pi / 10)) $ rotateV (dir-pi*0.25) (600,0)