From 78f211a12989f368d8a08674e5a49684a4bf9c7f Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Fri, 24 Jun 2022 11:35:35 +0100
Subject: [PATCH] Use streaming to improve speed of generating cullbox

---
 src/Dodge/CullBox.hs       |  7 +++++--
 src/Dodge/Update/Camera.hs | 37 ++++++++++++++++++++++++++-----------
 src/Dodge/Zone.hs          |  7 ++-----
 3 files changed, 33 insertions(+), 18 deletions(-)

diff --git a/src/Dodge/CullBox.hs b/src/Dodge/CullBox.hs
index 1373b1b40..e41aee8d1 100644
--- a/src/Dodge/CullBox.hs
+++ b/src/Dodge/CullBox.hs
@@ -15,8 +15,11 @@ cullBox :: Configuration -> World -> [Point2]
 --cullBox cfig w = farWallPoints cp w
 cullBox cfig w' 
     | debugOn Bound_box_screen cfig = screenPolygon cfig w'
-    | otherwise = let (n,s,e,w) = farWallDistDirection (_cameraCenter w') w'
-            in map ((+.+ _cameraCenter w') . rotateV (_cameraRot w') ) $ rectNSWE n (negate s) (negate w) e
+    | otherwise = let (n,s,e,w) = f $ farWallDistDirection (_cameraCenter w') w'
+            in map ((+.+ _cameraCenter w') . rotateV (_cameraRot w') ) $ rectNSWE n ( s) ( w) e
+  where
+    f (Just a,Just b,Just c,Just d) = (max 0 a,min 0 b,max 0 c,min 0 d)
+    f _ = (0,0,0,0)
 --    --mapMaybe (fmap (fst . _wlLine . snd) . f) $ screenPolygon cfig w
 --  where
 --    grs = filter (pointInOrOnPolygon cp . _grBound) (_gameRooms w)
diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs
index f840858e7..04dfafd4a 100644
--- a/src/Dodge/Update/Camera.hs
+++ b/src/Dodge/Update/Camera.hs
@@ -4,6 +4,7 @@ and the position that the character sees from: '_cameraViewFrom'.  -}
 module Dodge.Update.Camera 
     ( updateCamera
     , farWallPoints
+--    , streamViewpoints
     , farWallDistDirection
     ) where
 import Dodge.Data
@@ -19,7 +20,7 @@ import LensHelp
 import qualified Data.Map.Strict as M
 --import qualified Data.List.NonEmpty as NEL
 --import Control.Applicative
-import Data.Foldable
+--import Data.Foldable
 import Data.Maybe
 import Control.Monad
 import qualified Data.Set as Set
@@ -29,6 +30,7 @@ import qualified SDL
 --import Data.Semigroup
 import qualified Control.Foldl as L
 import qualified Streaming.Prelude as S
+import Streaming
 {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; 
 update where your avatar's view is from.  -}
 updateCamera :: Configuration -> World -> World
@@ -209,18 +211,31 @@ farWallDist p cfig w = (winFac /)
     wos = wallsOnScreen cfig w
     distFromEqmnt = foldr max 1 $ IM.mapMaybe (_eqViewDist . _eqEq. _itUse) $ getCrEquipment $ you w
 
-farWallDistDirection :: Point2 -> World -> (Float,Float,Float,Float)
-farWallDistDirection p w = foldl' (flip (m . f)) (0,0,0,0) vps
+streamViewpoints :: Monad m => Point2 -> World -> Stream (Of Point2) m ()
+{-# INLINE streamViewpoints #-}
+streamViewpoints p w = flip S.for (gameRoomViewpoints p)
+    $ S.filter (pointInOrOnPolygon p . _grBound) $ S.each (_gameRooms w)
+
+gameRoomViewpoints :: Monad m => Point2 -> GameRoom -> Stream (Of Point2) m ()
+gameRoomViewpoints p gr = S.each (_grViewpoints gr) 
+    <> S.map extend (S.each (_grViewpointsEx gr) <> S.map addDir (S.each $ _grLinkDirs gr))
   where
-    --f q = g $ rotateV (negate $ _cameraRot w) $ collidePointWallsFilt' wlIsOpaque p q wos -.- p
-    f q = g $ rotateV (negate $ _cameraRot w) 
---        $ collidePointWallsFilt wlIsOpaque p q (wallsAlongLine p q w) -.- p
-        -- $ L.purely S.fold_ (collidePointWallsL p q) (wallsAlongLineStream p q w) -.- p
+    extend outp = p +.+ maxViewDistance *.* squashNormalizeV (outp -.- p)
+    addDir a = p +.+ unitVectorAtAngle a
+
+farWallDistDirection :: Point2 -> World -> (Maybe Float,Maybe Float,Maybe Float,Maybe Float)
+farWallDistDirection p w = runIdentity $ L.purely S.fold_ ((,,,) 
+    <$> L.premap (^?! _2) L.maximum
+    <*> L.premap (^?! _2) L.minimum
+    <*> L.premap (^?! _1) L.maximum
+    <*> L.premap (^?! _1) L.minimum
+    )
+    $ S.map f vps
+  where
+    f q = rotateV (negate $ _cameraRot w) 
         $ runIdentity (L.purely S.fold_ (collidePointWallsL p q) (S.filter wlIsOpaque $ wallsAlongLineStream p q w)) -.- p
-    g (V2 x y) = (y, negate y, x, negate x)
-    m (a,b,c,d) (x,y,z,w') = (max a x, max b y, max c z, max d w')
-    vps = concatMap _grViewpoints grs ++ extendedViewPoints p grs
-    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
+    vps = streamViewpoints p w
+
 
 extendedViewPoints :: Point2 -> [GameRoom] -> [Point2]
 extendedViewPoints p grs = map extend 
diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs
index 079ef8c8f..38d589e61 100644
--- a/src/Dodge/Zone.hs
+++ b/src/Dodge/Zone.hs
@@ -35,7 +35,7 @@ import qualified Streaming.Prelude as S
 import Streaming
 import Data.Maybe
 import Data.List
-import Data.IntMap.Merge.Strict
+--import Data.IntMap.Merge.Strict
 import qualified Data.IntMap.Strict as IM
 import qualified Data.IntSet as IS
 import Control.Lens
@@ -176,11 +176,8 @@ wallsAlongLine a b w =
         Just val -> val
         _        -> IM.empty
 
-restrictIMIM :: IM.IntMap (IM.IntMap a) -> IM.IntMap IS.IntSet -> IM.IntMap (IM.IntMap a)
-restrictIMIM = merge dropMissing dropMissing (zipWithMatched $ const IM.restrictKeys)
-
 wallsAlongLineStream :: Monad m => Point2 -> Point2 -> World -> Stream (Of Wall) m ()
-wallsAlongLineStream sp ep w = flip S.for S.each $ S.mapMaybe f $ zoneOfLineStream sp ep
+wallsAlongLineStream sp ep w = S.concat $ S.mapMaybe f $ zoneOfLineStream sp ep
   where
     f (i,j) = w ^? wallsZone . znObjects . ix i . ix j