Test aggressive object culling

src/Dodge/Config/Data.hs

@@ -28,6 +28,8 @@ data Configuration = Configuration
     , _debug_walls  :: Bool
     , _debug_view_clip_bounds :: RoomClipping
     , _debug_pathing        :: Bool
+    , _debug_remove_LOS     :: Bool
+    , _debug_cull_more_lights :: Bool
     }
   deriving (Generic, Show)
 data ResFactor = FullRes | HalfRes | QuarterRes
@@ -77,4 +79,6 @@ defaultConfig = Configuration
     , _debug_view_clip_bounds = NoRoomClipBoundaries
     , _debug_pathing    = False
     , _debug_walls    = False
+    , _debug_remove_LOS      = False
+    , _debug_cull_more_lights     = False
     }

src/Dodge/CullBox.hs

@@ -2,14 +2,14 @@ module Dodge.CullBox
     (cullBox
     ) where
 import Dodge.Data
-import Dodge.GameRoom
+--import Dodge.GameRoom
-import Dodge.Base
+--import Dodge.Base
-import Dodge.Zone
+--import Dodge.Zone
 import Geometry
 import Dodge.Update.Camera
-import Shape
+--import Shape
 
-import Data.Maybe (mapMaybe)
+--import Data.Maybe (mapMaybe)
 
 cullBox :: Configuration -> World -> [Point2]
 --cullBox cfig w = farWallPoints cp w

src/Dodge/Data.hs

@@ -86,11 +86,12 @@ data World = World
     , _mousePos             :: Point2
     , _cameraCenter         :: Point2
     , _cameraRot            :: Float
-    , _cameraZoom           :: Float
+    , _cameraZoom           :: Float  -- smaller values zoom out
     , _itemZoom             :: Float
     , _defaultZoom          :: Float
     , _cameraViewFrom       :: Point2
     , _viewDistance         :: Float
+    , _boundBox             :: [Point2]
     , _creatures            :: IM.IntMap Creature
     , _creaturesZone        :: Zone (IM.IntMap Creature)
     , _creatureGroups       :: IM.IntMap CrGroupParams

src/Dodge/Default/World.hs

@@ -6,6 +6,7 @@ import Dodge.Bounds
 --import Dodge.Menu
 --import Picture
 import Geometry.Data
+import Geometry.Polygon
 --import Picture.Texture
 --import Data.Preload
 
@@ -105,6 +106,7 @@ defaultWorld = World
     , _genRooms = IM.empty
     , _deathDelay = Nothing
     , _testFloat = 0
+    , _boundBox = square 1000
     }
 youLight :: TempLightSource
 youLight = TLS 

src/Dodge/Initialisation.hs

@@ -42,6 +42,7 @@ initialWorld = defaultWorld
 
 testStringInit :: World -> [String]
 testStringInit = const [] -- map (show . _mcTermMID) . IM.elems . _machines
+--testStringInit w = [show $ _cameraZoom w]
 --testStringInit = (:[]) . show . _testFloat
 --testStringInit = map (concatMap $ \(_,ct,_,_) -> show ct) . invertListInvMult . yourInv
 --testStringInit w = fmap (show . _crHammerPosition) . IM.elems $ _creatures w

src/Dodge/Menu.hs

@@ -90,6 +90,8 @@ debugMenuOptions = zipWith ($)
     , makeBoolOption debug_show_sound     "SHOW VISUAL SOUNDS" 
     , makeBoolOption debug_mouse_position    "SHOW MOUSE POSITION" 
     , makeBoolOption debug_walls "SHOW WALL INFO"
+    , makeBoolOption debug_remove_LOS "REMOVE LOS"
+    , makeBoolOption debug_cull_more_lights "CULL MORE LIGHTS"
     ]
     $ map Scancode [4 ..]
 gameplayMenu :: ScreenLayer

src/Dodge/Render.hs

@@ -107,10 +107,12 @@ doDrawing pdata u = do
     currentProgram $= Just (_shadProg lwShad)
     uniform (head $  _shadUnis lwShad) $= viewFrom3d
     bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad)
-    glDrawArrays 
+    if not (_debug_remove_LOS cfig)
-        (marshalEPrimitiveMode $ _shadPrim lwShad) 
+        then glDrawArrays 
-        0 
+            (marshalEPrimitiveMode $ _shadPrim lwShad) 
-        (fromIntegral nWalls)
+            0 
+            (fromIntegral nWalls)
+        else return ()
     --draw walls onto base buffer
     if cfig ^. graphics_wall_textured
         then renderTextureWalls pdata nWalls

src/Dodge/Render/Lights.hs

@@ -17,12 +17,11 @@ lightsForGloom cfig w = mapMaybe getLS (IM.elems $ _lightSources w)
     cbox = cullBox cfig w
     cpos = _cameraCenter w
     getlsparam ls
-        | not (pointInPolygon lpos cbox) 
+        | not (pointInPolygon lpos cbox) && extraculltest = Nothing
-            && isNothing (intersectSegPolyFirst lpos (lpos +.+ rad *.* (normalizeV (cpos -.- lpos))) cbox)
-            = Nothing
---        | dist (_cameraCenter w) (fst2 $ _lsPos ls) > _viewDistance w + _lsRad ls = Nothing
         | otherwise = Just ( _lsPos ls,  rad^(2::Int) , _lsCol ls)
       where
         lpos = xyV3 $ _lsPos ls
         rad  = _lsRad ls
-    fst2 (V3 a b _) = V2 a b
+        extraculltest
+            | _debug_cull_more_lights cfig = True
+            | otherwise = isNothing (intersectSegPolyFirst lpos (lpos +.+ rad *.* (normalizeV (cpos -.- lpos))) cbox)

src/Dodge/Render/ShapePicture.hs

@@ -41,9 +41,13 @@ worldSPic cfig w =
     <> foldMap mcSPic (filtOn _mcPos _machines)
   where
     filtOn f g = IM.filter (pointIsClose . f) (g w)
-    pointIsClose p = dist camCen p < 30 + _viewDistance w
+    --pointIsClose p = dist camCen p < _viewDistance w
+    pointIsClose = cullPoint w
     camCen = _cameraCenter w
 
+cullPoint :: World -> Point2 -> Bool
+cullPoint w p = pointInPolygon p (_boundBox w)
+
 extraShapes :: World -> Shape
 extraShapes = _foregroundShape
 

src/Dodge/Update.hs

@@ -5,6 +5,7 @@ Description : Simulation update
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
 import Dodge.Menu
+import Dodge.CullBox
 import Dodge.Block
 import Dodge.Distortion
 import Dodge.SoundLogic
@@ -84,6 +85,7 @@ functionalUpdate cfig w = checkEndGame
 --    . (youHammerPosition %~ moveHammerUp)
     . updateTerminal
     . updateRBList
+    . updateBoundBox cfig  -- where should this go? next to update camera?
     $ updateCloseObjects w
   where 
     --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w
@@ -92,6 +94,9 @@ functionalUpdate cfig w = checkEndGame
       where 
         (x,y) = cloudZoneOfPoint $ stripZ $ _clPos cl
 
+updateBoundBox :: Configuration -> World -> World
+updateBoundBox cfig w = w & boundBox .~ cullBox cfig w
+
 mcChooseUpdate :: Machine -> Machine -> World -> World
 mcChooseUpdate mc mc'
     | _mcHP mc > 0  = _mcUpdate mc mc'

src/Dodge/Update/Camera.hs

@@ -188,6 +188,8 @@ clipZoom = min 20 . max 0.2
 setViewDistance :: Configuration -> World -> World
 setViewDistance cfig w = w & viewDistance 
     .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / _cameraZoom w
+--    .~ max (halfWidth cfig) (halfHeight cfig) / _cameraZoom w
+
 
 -- TODO consider adding visible/nearby creatures as view points
 farWallDist :: Point2 -> Configuration -> World -> Float