Tweak view distances

src/Dodge/CullBox.hs

@@ -1,29 +0,0 @@
-module Dodge.CullBox (
-    updateBounds,
-) where
-
-import Control.Lens
-import Data.Maybe
-import Dodge.Base.Window
-import Dodge.Data.Universe
-import Dodge.Update.Camera
-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 . camPos . camCenter) w
-  where
-    hw = halfWidth cfig
-    hh = halfHeight cfig
-
-updateBounds :: Universe -> Universe
-updateBounds uv =
-    uv
-        & uvWorld . cWorld . camPos . camBoundDist .~ bdists
-        & uvWorld . cWorld . camPos . camBoundBox
-            .~ map ((+.+ w ^. cWorld . camPos . camCenter) . rotateV (w ^. cWorld . camPos . camRot)) (rectNSWE n s w' e)
-  where
-    w = _uvWorld uv
-    cfig = _uvConfig uv
-    bdists@(n, s, e, w') = findBoundDists cfig w

src/Dodge/Data/Creature/Shape.hs

@@ -0,0 +1,2 @@
+module Dodge.Data.Creature.Shape where
+

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
+import Dodge.Viewpoints
 import Dodge.Render.Label
 import Dodge.WorldEvent.ThingsHit
 import Control.Lens
@@ -27,7 +28,7 @@ import Dodge.Render.InfoBox
 import Dodge.Render.List
 import Dodge.ShortShow
 import Dodge.SoundLogic.LoadSound
-import Dodge.Update.Camera
+--import Dodge.Update.Camera
 import Dodge.Zoning
 import Dodge.Zoning.Base
 import Geometry
@@ -473,9 +474,9 @@ viewBoundaries :: CWorld -> Picture
 viewBoundaries w =
     setLayer DebugLayer $
         color green (foldMap (polygonWire . _grBound) grs)
-            <> color yellow (foldMap (\q -> line [p, q]) $ farWallPoints p w)
+            <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w)
   where
-    p = _crPos $ youc w
+    p = w ^. camPos . camViewFrom
     grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
 
 viewClipBounds :: Configuration -> World -> Picture

src/Dodge/Update.hs

@@ -17,7 +17,6 @@ import Dodge.Beam
 import Dodge.Bullet
 import Dodge.CrGroupUpdate
 import Dodge.Creature.Update
-import Dodge.CullBox
 import Dodge.Data.SelectionList
 import Dodge.Data.Universe
 import Dodge.Distortion
@@ -76,7 +75,7 @@ updateUniverse u =
         . updateUseInput
         . over uvWorld (updateCamera cfig)
         . over (uvWorld . cWorld . cClock) (+ 1)
-        $ updateBounds u -- where should this go? next to update camera?
+        $ u
   where
     cfig = u ^. uvConfig
 

src/Dodge/Update/Camera.hs

@@ -3,13 +3,10 @@
 and the position that the character sees from: '_cameraViewFrom'.  -}
 module Dodge.Update.Camera (
     updateCamera,
-    farWallPoints,
-    --    streamViewpoints,
-    farWallDistDirection,
-    getViewpoints,
 ) where
 
 import Bound
+import Dodge.Viewpoints
 import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
@@ -19,7 +16,6 @@ import Dodge.Creature.Test
 import Dodge.Data.Config
 import Dodge.Data.World
 import Dodge.Equipment
-import Dodge.GameRoom
 import Dodge.Zoning.Wall
 import Geometry
 import qualified IntMapHelp as IM
@@ -31,6 +27,7 @@ update where your avatar's view is from.  -}
 updateCamera :: Configuration -> World -> World
 updateCamera cfig w =
     w
+        & updateBounds cfig
         & over (cWorld . camPos) (setViewDistance cfig)
         & cWorld . camPos %~ moveZoomCamera cfig (w ^. input) (you w)
         & updateScopeZoom
@@ -45,8 +42,6 @@ moveZoomCamera cfig theinput cr campos =
         & camDefaultZoom .~ newDefaultZoom
         & camItemZoom .~ newItemZoom
   where
-    --cfig = _uvConfig uv
-    --w = _uvWorld uv
     cpos = _crPos cr
     mitm = cr ^? crInv . ix (crSel cr)
     newvf = cpos +.+ fromMaybe (V2 0 0) vfoffset
@@ -219,20 +214,6 @@ setViewDistance cfig w =
     w & camViewDistance
         .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)
 
-getViewpoints :: Point2 -> CWorld -> [Point2]
-{-# INLINE getViewpoints #-}
-getViewpoints p w =
-    concatMap (gameRoomViewpoints p) $
-        filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
-
-gameRoomViewpoints :: Point2 -> GameRoom -> [Point2]
-{-# INLINE gameRoomViewpoints #-}
-gameRoomViewpoints p gr =
-    _grViewpoints gr
-        <> map extend (_grViewpointsEx gr <> map addDir (_grLinkDirs gr))
-  where
-    extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
-    addDir a = p +.+ unitVectorAtAngle a
 
 farWallDistDirection :: Point2 -> World -> Maybe (Float, Float, Float, Float)
 farWallDistDirection p w =
@@ -243,21 +224,20 @@ farWallDistDirection p w =
     wls q = filter wlIsOpaque $ wlsNearSeg p q w
     findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
 
-extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
-extendedViewPoints p grs =
-    map
-        extend
-        ( concatMap _grViewpointsEx grs
-            ++ map addDir (concatMap _grLinkDirs grs)
-        )
+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 . camPos . camViewFrom) w
   where
-    extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
-    addDir a = p +.+ unitVectorAtAngle a
+    hw = halfWidth cfig
+    hh = halfHeight cfig
 
-farWallPoints :: Point2 -> CWorld -> [Point2]
-farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
+updateBounds :: Configuration -> World -> World
+updateBounds cfig w =
+    w
+        & cWorld . camPos . camBoundDist .~ bdists
+        & cWorld . camPos . camBoundBox
+            .~ map ((+.+ w ^. cWorld . camPos . camCenter) . rotateV (w ^. cWorld . camPos . camRot)) (rectNSWE n s w' e)
   where
-    grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
-
-maxViewDistance :: Float
-maxViewDistance = 800
+    bdists@(n, s, e, w') = findBoundDists cfig w

src/Dodge/Viewpoints.hs

@@ -0,0 +1,42 @@
+module Dodge.Viewpoints (
+    getViewpoints,
+--    farWallPoints,
+) where
+
+import Dodge.Data.CWorld
+import Dodge.GameRoom
+import Geometry
+
+--farWallPoints :: Point2 -> CWorld -> [Point2]
+--farWallPoints p w = concatMap _grViewpoints grs ++ extendedViewPoints p grs
+--  where
+--    grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
+--
+--extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
+--extendedViewPoints p grs =
+--    map
+--        extend
+--        ( concatMap _grViewpointsEx grs
+--            ++ map addDir (concatMap _grLinkDirs grs)
+--        )
+--  where
+--    extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
+--    addDir a = p +.+ unitVectorAtAngle a
+
+maxViewDistance :: Float
+maxViewDistance = 800
+
+getViewpoints :: Point2 -> CWorld -> [Point2]
+{-# INLINE getViewpoints #-}
+getViewpoints p w =
+    concatMap (gameRoomViewpoints p) $
+        filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
+
+gameRoomViewpoints :: Point2 -> GameRoom -> [Point2]
+{-# INLINE gameRoomViewpoints #-}
+gameRoomViewpoints p gr =
+    _grViewpoints gr
+        <> map extend (_grViewpointsEx gr <> map addDir (_grLinkDirs gr))
+  where
+    extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
+    addDir a = p +.+ unitVectorAtAngle a