Add aggressive light culling

src/Dodge/Render/HUD.hs

@@ -317,7 +317,7 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
 
 
 mapOverlay :: Configuration -> World -> [Picture]
-mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ rectNSEW 1 (-1) (-1) 1) : 
+mapOverlay cfig w = (color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) : 
             (mapMaybe (mapWall cfig w) . IM.elems $ _walls w)
 
 mapWall :: Configuration -> World -> Wall -> Maybe Picture

src/Dodge/Render/Lights.hs

@@ -2,17 +2,24 @@ module Dodge.Render.Lights
     ( lightsForGloom
     ) where
 import Dodge.Data
+import Dodge.CullBox
 import Geometry
 
 import Data.Maybe
 import qualified Data.IntMap.Lazy as IM
 
-lightsForGloom :: World -> [(Point3,Float,Point3)]
-lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
+lightsForGloom :: Configuration -> World -> [(Point3,Float,Point3)]
+lightsForGloom cfig w = mapMaybe getLS (IM.elems $ _lightSources w) 
+    ++ mapMaybe getTLS (_tempLightSources w)
   where 
     getLS  = getlsparam . _lsParam
     getTLS = getlsparam . _tlsParam 
+    cbox = cullBox cfig w
     getlsparam ls
+        | not (pointInPolygon lpos cbox) = Nothing
         | dist (_cameraCenter w) (fst2 $ _lsPos ls) > _viewDistance w + _lsRad ls = Nothing
         | otherwise = Just ( _lsPos ls,  _lsRad ls^(2::Int) , _lsCol ls)
+      where
+        lpos = xyV3 $ _lsPos ls
+        rad  = _lsRad ls
     fst2 (V3 a b _) = V2 a b

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
 import Dodge.ShortShow
+import Dodge.CullBox
 import Dodge.Config.Data
 import Dodge.Render.InfoBox
 import Dodge.Debug.Picture
@@ -53,7 +54,7 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)
     <> concatMapPic (dbArg _bmDraw) (_electronBeams $ _beams w)
     <> concatMapPic (dbArg _lsPict) (_lightSources w)
-    <> testPic w
+    <> testPic cfig w
     <> _debugPicture w
     <> concatMapPic clDraw (_clouds w      )
     <> concatMapPic ppDraw (_pressPlates w )
@@ -65,8 +66,10 @@ extraPics cfig w = pictures (_decorations w)
     <> drawPathing cfig w
     <> drawCrInfo cfig w
 
-testPic :: World -> Picture
-testPic _ = mempty
+testPic :: Configuration -> World -> Picture
+testPic cfig w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
+  where
+    (x:xs) = cullBox cfig w
 
 clDraw :: Cloud -> Picture
 clDraw c = translate3 (_clPos c) (_clPict c c)