From 14e2b5cf8f45114035649ce937e14ce419200ad6 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 28 Oct 2022 22:00:38 +0100 Subject: [PATCH] Restrict some arguments --- src/Dodge/Base/Coordinate.hs | 16 ++++----- src/Dodge/Render/ShapePicture.hs | 10 +++--- src/Dodge/Render/Walls.hs | 3 +- src/Dodge/Update.hs | 4 ++- src/Dodge/Update/Camera.hs | 62 ++++++++++++++++---------------- src/Dodge/Zoning/World.hs | 13 +++---- 6 files changed, 55 insertions(+), 53 deletions(-) diff --git a/src/Dodge/Base/Coordinate.hs b/src/Dodge/Base/Coordinate.hs index 6d077761a..0d668d5cf 100644 --- a/src/Dodge/Base/Coordinate.hs +++ b/src/Dodge/Base/Coordinate.hs @@ -1,13 +1,13 @@ -module Dodge.Base.Coordinate - ( mouseWorldPos - , cartePosToScreen - , worldPosToScreen - ) where +module Dodge.Base.Coordinate ( + mouseWorldPos, + cartePosToScreen, + worldPosToScreen, +) where +import Control.Lens import Dodge.Base.WinScale import Dodge.Data.Universe import Geometry -import Control.Lens ---- | Transform coordinates from world position to screen coordinates. --worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2 @@ -52,8 +52,8 @@ mouseWorldPos w = ---- | The mouse position in map coordinates --mouseCartePos :: World -> Point2 --mouseCartePos w = (thehud ^. carteCenter) --- +.+ --- (1 / (thehud ^. carteZoom)) +-- +.+ +-- (1 / (thehud ^. carteZoom)) -- *.* rotateV (thehud ^. carteRot) (_mousePos w) -- where -- thehud = w ^. cWorld . lWorld . hud diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index baa1cf150..497dfcfb7 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -276,7 +276,7 @@ drawFarWallDetect w = , fst $ collidePoint p q $ filter wlIsOpaque $ wlsNearSeg p q w ] ) - $ getViewpoints p w + $ getViewpoints p (_cWorld w) -- $ runIdentity $ S.toList_ $ streamViewpoints p w where p = w ^. cWorld . lWorld . camPos . camViewFrom @@ -411,8 +411,8 @@ drawPathing cfig w = dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n gr = w ^. cWorld . lWorld . pathGraph -crDisplayInfo :: Configuration -> World -> Creature -> Maybe (Point2, [String]) -crDisplayInfo cfig w cr +crDisplayInfo :: Configuration -> CamPos -> Creature -> Maybe (Point2, [String]) +crDisplayInfo cfig cam cr | _crID cr == 0 = Nothing | crOnScreen = Just @@ -431,7 +431,7 @@ crDisplayInfo cfig w cr | otherwise = Nothing where ap = _crActionPlan cr - crOnScreen = pointOnScreen cfig (w ^. cWorld . lWorld . camPos) $ _crPos cr + crOnScreen = pointOnScreen cfig cam $ _crPos cr fpreShow :: (Show a, Functor f) => String -> f a -> f String fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show) @@ -440,7 +440,7 @@ drawCrInfo :: Configuration -> World -> Picture drawCrInfo cfig w = setLayer FixedCoordLayer $ renderInfoListsAt (2 * hw - 400) 0 cfig w $ - mapMaybe (crDisplayInfo cfig w) $ IM.elems $ w ^. cWorld . lWorld . creatures + mapMaybe (crDisplayInfo cfig (w ^. cWorld . lWorld . camPos)) $ IM.elems $ w ^. cWorld . lWorld . creatures where hw = halfWidth cfig diff --git a/src/Dodge/Render/Walls.hs b/src/Dodge/Render/Walls.hs index 321d40653..6bc2d2523 100644 --- a/src/Dodge/Render/Walls.hs +++ b/src/Dodge/Render/Walls.hs @@ -25,7 +25,8 @@ wallsToDraw w = <*> L.prefilter wlSeeThroughDraw (L.premap f L.list) <*> L.premap getWallSPic L.mconcat ) - (wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight wlZoneSize w) + (wlsFromIXs w $ zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfSight wlZoneSize cam) + cam = w ^. cWorld . lWorld . camPos --wallsToDraw -- :: World diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 08eb8aa0b..cb232e212 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -156,7 +156,7 @@ functionalUpdate w = . over uvWorld updateDistortions . over uvWorld updateCreatureSoundPositions . over uvWorld ppEvents - . updateCamera + . over uvWorld (updateCamera cfig) . colCrsWalls . over uvWorld simpleCrSprings . over uvWorld zoneCreatures @@ -201,6 +201,8 @@ functionalUpdate w = . 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))) diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index e08277175..479196a36 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -17,7 +17,8 @@ import Data.Maybe import qualified Data.Set as Set import Dodge.Base import Dodge.Creature.Test -import Dodge.Data.Universe +import Dodge.Data.Config +import Dodge.Data.World import Dodge.Equipment import Dodge.GameRoom import Dodge.Zoning.Wall @@ -28,27 +29,25 @@ 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 :: Universe -> Universe -updateCamera uv = - uv - & over uvWorld (setViewDistance cfig) - & moveZoomCamera - & over uvWorld updateScopeZoom - & over uvWorld (rotateCamera cfig) - where - cfig = _uvConfig uv +updateCamera :: Configuration -> World -> World +updateCamera cfig w = + w + & over (cWorld . lWorld . camPos) (setViewDistance cfig) + & moveZoomCamera cfig + & updateScopeZoom + & rotateCamera cfig -moveZoomCamera :: Universe -> Universe -moveZoomCamera uv = - uv - & 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 +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 where - cfig = _uvConfig uv - w = _uvWorld uv + --cfig = _uvConfig uv + --w = _uvWorld uv cpos = _crPos (you w) newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset vfoffset = do @@ -126,7 +125,6 @@ zoomInLongGun w where decreaseScopeZoomChange = wpPointer . itScope . scopeZoomChange -~ 1 wpPointer = cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (w ^?! cWorld . lWorld . creatures . ix 0)) - --wp = _crInv (_creatures (_cWorld w) IM.! 0) IM.! crSel (_creatures (_cWorld w) IM.! 0) wp = ycr ^?! crInv . ix (crSel ycr) ycr = you w Just currentZoom = wp ^? itScope . scopeZoom @@ -179,11 +177,11 @@ doWallRotate wl' w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl') - (w ^. b = a * (4 / pi) b' = fromIntegral (round b :: Int) -rotateCameraBy :: Float -> World -> World +rotateCameraBy :: Float -> LWorld -> LWorld rotateCameraBy x w = w - & cWorld . lWorld . camPos . camRot +~ x - & cWorld . lWorld . creatures . ix 0 . crInv . ix (crSel (_creatures (_lWorld (_cWorld w)) IM.! 0)) + & camPos . camRot +~ x + & creatures . ix 0 . crInv . ix (crSel (w ^?! creatures . ix 0)) . itScope . scopePos %~ rotateV x @@ -191,8 +189,8 @@ rotateCameraBy x w = rotateCamera :: Configuration -> World -> World rotateCamera cfig w | keyl && keyr = w - | keyl = rotateCameraBy 0.025 w - | keyr = rotateCameraBy (-0.025) w + | keyl = over (cWorld . lWorld) (rotateCameraBy 0.025) w + | keyr = over (cWorld . lWorld) (rotateCameraBy (-0.025)) w | otherwise = ifConfigWallRotate cfig w where keyl = SDL.ScancodeQ `Set.member` _keys w && notAtTerminal w @@ -216,16 +214,16 @@ clipZoom :: Float clipZoom = min 20 . max 0.2 -setViewDistance :: Configuration -> World -> World +setViewDistance :: Configuration -> CamPos -> CamPos setViewDistance cfig w = - w & cWorld . lWorld . camPos . camViewDistance - .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . camPos . camZoom) + w & camViewDistance + .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom) -getViewpoints :: Point2 -> World -> [Point2] +getViewpoints :: Point2 -> CWorld -> [Point2] {-# INLINE getViewpoints #-} getViewpoints p w = concatMap (gameRoomViewpoints p) $ - filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen (_cWorld w)) + filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w) gameRoomViewpoints :: Point2 -> GameRoom -> [Point2] {-# INLINE gameRoomViewpoints #-} @@ -239,7 +237,7 @@ gameRoomViewpoints p gr = farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float) farWallDistDirection p w = boundPoints $ - map f $ getViewpoints p w + map f $ getViewpoints p (_cWorld w) where f q = (rotateV (negate (w ^. cWorld . lWorld . camPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q)) wls q = filter wlIsOpaque $ wlsNearSeg p q w diff --git a/src/Dodge/Zoning/World.hs b/src/Dodge/Zoning/World.hs index fb88b9135..0709bd1bf 100644 --- a/src/Dodge/Zoning/World.hs +++ b/src/Dodge/Zoning/World.hs @@ -1,17 +1,18 @@ -module Dodge.Zoning.World where +module Dodge.Zoning.World + ( zoneOfSight + ) where -import Dodge.Data.World +import Dodge.Data.CamPos import Geometry.Data import Control.Lens -zoneOfSight :: Float -> World -> [Int2] +zoneOfSight :: Float -> CamPos -> [Int2] zoneOfSight s w = [ V2 a b | a <- [minimum xs .. maximum xs] , b <- [minimum ys .. maximum ys] ] where - (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. cWorld . lWorld . camPos . camBoundBox + (xs, ys) = unzip $ map sizeZoneOfPoint $ w ^. camBoundBox sizeZoneOfPoint (V2 x y) = (f x, f y) - where - f = floor . (/ s) + f = floor . (/ s)