Camera position refactor

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 #-}

src/Dodge/Base/Coordinate.hs

@@ -23,11 +23,11 @@ import Control.Lens
 -}
 worldPosToScreen :: World -> Point2 -> Point2
 worldPosToScreen w =
-    rotateV (negate $ cam ^. cwcRot)
+    rotateV (negate $ cam ^. camRot)
-        . ((cam ^. cwcZoom) *.*)
+        . ((cam ^. camZoom) *.*)
-        . (-.- (cam ^. cwcCenter))
+        . (-.- (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)
+    (cam ^. camCenter)
-        +.+ (1 / (cam ^. cwcZoom)) *.* rotateV (cam ^. cwcRot) (_mousePos w)
+        +.+ (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

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))

src/Dodge/Creature/Picture/Awareness.hs

@@ -27,8 +27,8 @@ creatureDisplayText w cr =
             w
             cr
   where
-    campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
+    campos = w ^. cWorld . lWorld . camPos . camViewFrom
-    theScale = 0.15 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
+    theScale = 0.15 / (w ^. cWorld . lWorld . camPos . camZoom)
     cpos = _crPos cr
     v = cpos -.- campos
     (V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v

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
+    dir = (w ^. cWorld . lWorld . camPos . camRot) + argV movDir
-    movAbs = rotateV (w ^. cWorld . lWorld . cwCam . cwcRot) $ normalizeV 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

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 . camPos . camBoundDist .~ bdists
-        & uvWorld . cWorld . lWorld . cwCam . cwcBoundBox
+        & uvWorld . cWorld . lWorld . camPos . camBoundBox
-            .~ map ((+.+ w ^. cWorld . lWorld . cwCam . cwcCenter) . rotateV (w ^. cWorld . lWorld . cwCam . cwcRot)) (rectNSWE n s w' e)
+            .~ map ((+.+ w ^. cWorld . lWorld . camPos . camCenter) . rotateV (w ^. cWorld . lWorld . camPos . camRot)) (rectNSWE n s w' e)
   where
     w = _uvWorld uv
     cfig = _uvConfig uv

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 ]

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
         ]

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
+    sp' = screenPolygon cfig (w ^. cWorld . lWorld . camPos)
-    vp = w ^. cWorld . lWorld . cwCam . cwcViewFrom
+    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)

src/Dodge/Default/World.hs

@@ -43,18 +43,18 @@ defaultCWGen =
         , _cwgRoomClipping = []
         }
 
-defaultCWCam :: CWCam
+defaultCWCam :: CamPos
 defaultCWCam =
-    CWCam
+    CamPos
-        { _cwcCenter = V2 0 0
+        { _camCenter = V2 0 0
-        , _cwcRot = 0
+        , _camRot = 0
-        , _cwcZoom = 1
+        , _camZoom = 1
-        , _cwcDefaultZoom = 1
+        , _camDefaultZoom = 1
-        , _cwcViewFrom = V2 0 0
+        , _camViewFrom = V2 0 0
-        , _cwcViewDistance = 1000
+        , _camViewDistance = 1000
-        , _cwcItemZoom = 1
+        , _camItemZoom = 1
-        , _cwcBoundBox = square 100
+        , _camBoundBox = square 100
-        , _cwcBoundDist = (100, -100, 100, -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

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]]

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

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

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 ::
+--fixedSizePicAt ::
-    Picture ->
+--    Picture ->
-    Point2 ->
+--    Point2 ->
-    World ->
+--    CamPos ->
-    Picture
+--    Picture
-fixedSizePicAt pic p w =
+--fixedSizePicAt pic p w =
-    setLayer DebugLayer
+--    setLayer DebugLayer
-        . setDepth 20
+--        . setDepth 20
-        . translate x y
+--        . translate x y
-        . scale theScale theScale
+--        . scale theScale theScale
-        $ pic
+--        $ pic
-  where
+--  where
-    campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
+--    campos = w ^. camViewFrom
-    v = p -.- campos
+--    v = p -.- campos
-    theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
+--    theScale = 1 / (w ^. camZoom)
-    (V2 x y) = campos +.+ v
+--    (V2 x y) = campos +.+ v
 
-fixedSizePicClamp ::
+--fixedSizePicClamp ::
-    -- | horizontal border
+--    -- | horizontal border
-    Int ->
+--    Int ->
-    -- | vertical border
+--    -- | vertical border
-    Int ->
+--    Int ->
-    Picture ->
+--    Picture ->
-    Point2 ->
+--    Point2 ->
-    Configuration ->
+--    Configuration ->
-    World ->
+--    CamPos ->
-    Picture
+--    Picture
-fixedSizePicClamp xbord ybord pic p cfig w =
+--fixedSizePicClamp xbord ybord pic p cfig w =
-    setLayer DebugLayer
+--    setLayer DebugLayer
-        . setDepth 20
+--        . setDepth 20
-        . translate x y
+--        . translate x y
-        . scale theScale theScale
+--        . scale theScale theScale
-        $ pic
+--        $ pic
-  where
+--  where
-    r = negate $ w ^. cWorld . lWorld . cwCam . cwcRot
+--    r = negate $ w ^. camRot
-    z = w ^. cWorld . lWorld . cwCam . cwcZoom
+--    z = w ^. camZoom
-    campos = w ^. cWorld . lWorld . cwCam . cwcViewFrom
+--    campos = w ^. camViewFrom
-    v = p -.- campos
+--    v = p -.- campos
-    theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
+--    theScale = 1 / (w ^. camZoom)
-    (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
+--    (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
-    (V2 xr yr) = rotateV r v
+--    (V2 xr yr) = rotateV r v
-    xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
+--    xr' = absClamp ((halfWidth cfig - fromIntegral xbord) / z) xr
-    yr' = absClamp ((halfHeight cfig - fromIntegral ybord) / z) yr
+--    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
+    winps = screenPolygon cfig (w ^. camPos)
-    bords = screenPolygonBord xbord ybord cfig w
+    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
+    campos = w ^. camPos . camCenter
-    theScale = 1 / (w ^. cWorld . lWorld . cwCam . cwcZoom)
+    theScale = 1 / (w ^. camPos . camZoom)
 
-absClamp ::
+--absClamp ::
-    -- | clamping value, assumed positive
+--    -- | clamping value, assumed positive
-    Float ->
+--    Float ->
-    Float ->
+--    Float ->
-    Float
+--    Float
-absClamp maxVal = max (negate maxVal) . min maxVal
+--absClamp maxVal = max (negate maxVal) . min maxVal

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

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
+        rot = w ^. cWorld . lWorld . camPos . camRot
-        camzoom = w ^. cWorld . lWorld . cwCam . cwcZoom
+        camzoom = w ^. cWorld . lWorld . camPos . camZoom
-        trans = w ^. cWorld . lWorld . cwCam . cwcCenter
+        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

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
+    cbox = w ^. cWorld . lWorld . camPos . camBoundBox
-    cpos = w ^. cWorld . lWorld . cwCam . cwcCenter
+    cpos = w ^. cWorld . lWorld . camPos . camCenter
     getlsparam ls
         | not (pointInPolygon lpos cbox) && extraculltest = Nothing
         | otherwise = Just (_lsPos ls, rad ^ (2 :: Int), _lsCol ls)

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)
+    | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . lWorld . camPos . camBoundBox)
-    | otherwise = dist (w ^. cWorld . lWorld . cwCam . cwcCenter) p < (w ^. cWorld . lWorld . cwCam . cwcViewDistance)
+    | 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)

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.

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 . camPos . camCenter .~ newcen
-        & uvWorld . cWorld . lWorld . cwCam . cwcViewFrom .~ newvf
+        & uvWorld . cWorld . lWorld . camPos . camViewFrom .~ newvf
-        & uvWorld . cWorld . lWorld . cwCam . cwcZoom .~ newzoom
+        & uvWorld . cWorld . lWorld . camPos . camZoom .~ newzoom
-        & uvWorld . cWorld . lWorld . cwCam . cwcDefaultZoom .~ newDefaultZoom
+        & uvWorld . cWorld . lWorld . camPos . camDefaultZoom .~ newDefaultZoom
-        & uvWorld . cWorld . lWorld . cwCam . cwcItemZoom .~ newItemZoom
+        & 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' > 0.01 = w & cWorld . lWorld . camPos . camRot +~ 0.01
-        | b - b' < negate 0.01 = w & cWorld . lWorld . cwCam . cwcRot -~ 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
+    w & cWorld . lWorld . camPos . camViewDistance
-        .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. cWorld . lWorld . cwCam . cwcZoom)
+        .~ 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
 

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)

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

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

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)