From 85edd98d62b1dac2ff5bd0c0495dfae4251e3137 Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Thu, 23 Sep 2021 15:27:37 +0100
Subject: [PATCH] Various performance improvements

---
 src/Dodge/Base.hs                    | 47 +++++++++++++++++++++++-----
 src/Dodge/Base/Collide.hs            | 47 ++++++++++++++++++++++++----
 src/Dodge/Creature/Picture.hs        |  7 ++---
 src/Dodge/Default/World.hs           |  2 +-
 src/Dodge/Item/Weapon.hs             |  4 +--
 src/Dodge/Item/Weapon/Grenade.hs     |  2 +-
 src/Dodge/Item/Weapon/Launcher.hs    |  2 +-
 src/Dodge/Item/Weapon/TriggerType.hs |  2 +-
 src/Dodge/LightSources.hs            |  6 ++--
 src/Dodge/Render/HUD.hs              | 22 +++++++------
 src/Dodge/Render/Picture.hs          | 11 ++++---
 src/Dodge/Update.hs                  |  3 +-
 src/Dodge/Update/Camera.hs           | 42 +++++++------------------
 src/Dodge/WorldEvent.hs              |  2 +-
 src/Dodge/WorldEvent/ThingsHit.hs    |  9 +++---
 src/Dodge/Zone.hs                    |  8 +++--
 src/Geometry.hs                      |  2 +-
 17 files changed, 137 insertions(+), 81 deletions(-)

diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs
index 2b6b925b5..d2b8cfcac 100644
--- a/src/Dodge/Base.hs
+++ b/src/Dodge/Base.hs
@@ -16,6 +16,7 @@ import FoldableHelp
 
 import Control.Lens
 import qualified Control.Foldl as L
+import Data.Monoid
 import Data.Maybe
 --import Data.Bifunctor
 --import qualified Data.IntSet as IS
@@ -213,22 +214,52 @@ overlapCircWallsReturnWall p rad
   where 
     f (a,b) = intersectSegSeg p (p -.- rad *.* vNormal (normalizeV (a -.- b))) a b
 
+-- | Looks for any collision of a circle with walls.
+-- If found, gives point and reflection velocity, reflection damped in normal.
+-- note that in this version the circle can overlap the wall
+collidePointAnyWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collidePointAnyWalls p1 p2 
+    = getFirst
+    . foldMap (First . findPoint . _wlLine)
+  where 
+    findPoint (x,y) = case intersectSegSeg p1 p2 x y of
+        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
+        Nothing -> Nothing
+
 -- | Looks for first collision of a circle with walls.
 -- If found, gives point and reflection velocity, reflection damped in normal.
-collideCircWalls :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
-collideCircWalls p1 p2 rad ws 
-    = safeMinimumOn f 
+-- note that the "intersection" point is the center of the circle flush against the wall
+collideCircWalls' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collideCircWalls' p1 p2 rad = either (const Nothing) Just . foldr findPoint (Left p2)
+  where 
+    findPoint wl eip = maybe eip Right $ doReflection (getp eip) $ shiftByRad $ _wlLine wl
+    getp (Left p) = p
+    getp (Right (p,_)) = p
+    doReflection p (x,y) = case intersectSegSeg p1 p x y of
+        Nothing -> Nothing
+        Just ip -> Just (ip +.+ normalizeV (vNormal (x -.- y)), reflectInParam 0.5 (x -.- y) (p2 -.- p1))
+    shiftByRad (a,b) =
+        (g $ a +.+ rad *.* normalizeV (a -.-b)
+        ,g $ b +.+ rad *.* normalizeV (b -.-a)
+        )
+      where
+        g = ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
+
+-- | Looks for first collision of a circle with walls.
+-- If found, gives point and reflection velocity, reflection damped in normal.
+collideCircWalls'' :: Point2 -> Point2 -> Float -> IM.IntMap Wall -> Maybe (Point2,Point2)
+collideCircWalls'' p1 p2 rad ws 
+    = safeMinimumOn (dist p1 . fst) 
     $ IM.mapMaybe 
         (( \(x:y:_) -> fmap 
             ((, reflectInParam 0.5 (x -.- y) (p2 -.- p1)) 
-            . (+.+ errorNormalizeV 40 (vNormal (x -.- y)))
+            . (+.+ normalizeV (vNormal (x -.- y)))
             ) 
             (intersectSegSeg p1 p2 x y)
          ) 
          . shiftByRad . _wlLine
         ) ws
   where 
-    f (a,_) = magV (p1 -.- a)
     shiftByRad (a,b) = map ((rad *.* normalizeV (vNormal $ a -.- b)) +.+)
         [a +.+ rad *.* normalizeV (a -.-b)
         ,b +.+ rad *.* normalizeV (b -.-a)
@@ -356,7 +387,7 @@ nearestCrInTri
     -> World -> Maybe Creature
 nearestCrInTri p dir x w 
     = safeMinimumOn (dist p . _crPos)
-    $ IM.filter (\cr -> errorPointInPolygon 1 (_crPos cr) tri) $ _creatures w
+    $ IM.filter (\cr -> pointInPolygon (_crPos cr) tri) $ _creatures w
  where 
     tri = 
         [p 
@@ -373,7 +404,7 @@ nearestCrInFront
     -> World -> Maybe Creature
 nearestCrInFront p dir x w 
     = safeMinimumOn (dist p . _crPos)
-    $ IM.filter (\cr -> errorPointInPolygon 2 (_crPos cr) rec) $ _creatures w
+    $ IM.filter (\cr -> pointInPolygon (_crPos cr) rec) $ _creatures w
   where 
     rec = [p, pR, pR1, pL1, pL ]
     pR  = p +.+ rotateV (dir - pi*(3/8)) (V2 (x/2) 0)
@@ -382,7 +413,7 @@ nearestCrInFront p dir x w
     pL1 = pL +.+ rotateV dir (V2 (x/2) 0)
 {- | Test whether a creature is in a polygon.  -}
 crInPolygon :: Creature -> [Point2] -> Bool
-crInPolygon cr = errorPointInPolygon 3 (_crPos cr)
+crInPolygon cr = pointInPolygon (_crPos cr)
 
 {- | Transform coordinates from world position to screen coordinates.  -}
 worldPosToScreenNorm :: World -> Point2 -> Point2
diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs
index d73d6b40d..d01de26bc 100644
--- a/src/Dodge/Base/Collide.hs
+++ b/src/Dodge/Base/Collide.hs
@@ -90,17 +90,50 @@ collideDirectionIndirect d p1 p2 wls
   where
     p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
 
+collidePointUpToIndirect
+    :: Point2   -- ^start point
+    -> Point2   -- ^end point
+    -> IM.IntMap Wall 
+    -> Point2
+{-# INLINE collidePointUpToIndirect #-}
+collidePointUpToIndirect p1 p2 = foldr f p2 . IM.filter (not . _wlIsSeeThrough)
+  where
+    f wl x = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
+
+collidePointUpToIndirectMinDist
+    :: Point2   -- ^start point
+    -> Point2   -- ^end point
+    -> Float    -- ^minimal possible distance
+    -> IM.IntMap Wall 
+    -> Point2
+{-# INLINE collidePointUpToIndirectMinDist #-}
+collidePointUpToIndirectMinDist p1 p2 md = ssfold prop f p2 . IM.filter (not . _wlIsSeeThrough)
+  where
+    f x wl = fromMaybe x . uncurry (intersectSegSeg p1 x) $ _wlLine wl
+    prop p3 = dist p1 p3 < md
+
+-- from haskell-cafe
+-- short circuit a fold when a given property is satisfied
+-- the fold builds a function that is then called on a0
+ssfold :: Foldable t => (a -> Bool) -> (a -> b -> a) -> a -> t b -> a
+{-# INLINABLE ssfold #-}
+ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0
+
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
-collidePointIndirect  p1 p2
+collidePointIndirect p1 p2 = test . foldr f p2 . IM.filter (not . _wlIsSeeThrough)
+  where
+    f wl p = fromMaybe p $ uncurry (intersectSegSeg p1 p) $ _wlLine wl
+    test p | p == p2 = Nothing
+           | otherwise = Just p
+
+collidePointIndirect' :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
+{-# INLINE collidePointIndirect' #-}
+collidePointIndirect'  p1 p2
     = L.fold
     . L.prefilter (not . _wlIsSeeThrough)
     . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
     $ L.minimumOn (dist p1)
---collidePointIndirect p1 p2
---    = safeMinimumOn (dist p1) 
---    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) 
---    . IM.filter (not . _wlIsSeeThrough)
 
 {- | Checks to see whether someone can fire bullets effectively between two points. 
  - Not sure if this needs vision as well, need to make this uniform. -}
@@ -120,8 +153,10 @@ collidePointFireVision p1 p2 ws
         Just _  -> not $ _wlIsSeeThrough wl
         Nothing -> True
 
+-- the reason for using the dashed version is the hope that this will short
+-- circuit
 hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
-hasLOSIndirect p1 p2 w = case collidePointIndirect p1 p2 $ wallsAlongLine p1 p2 w of 
+hasLOSIndirect p1 p2 w = case collidePointIndirect' p1 p2 $ wallsAlongLine p1 p2 w of 
     Just _ -> False
     Nothing -> True
 
diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs
index e6347bb59..07190fbc7 100644
--- a/src/Dodge/Creature/Picture.hs
+++ b/src/Dodge/Creature/Picture.hs
@@ -51,11 +51,10 @@ basicCrShape
     -> Creature 
     -> Shape
 basicCrShape col cr = tr $ mconcat
-    [ rotdir $ _spShape $ drawEquipment cr
-    , translateSHz 25 . dm . rotdir $ scalp cr
+    [ rotdir . _spShape $ drawEquipment cr
+    , rotdir . dm . translateSHz 25 $ scalp cr
+    , rotdir . dm $ upperBody col cr
     , dm . rotmdir $ feet cr
-    , dm . rotdir $ upperBody col cr
-    , rotdir $ _spShape $ drawEquipment cr
     ]
   where 
     dm = damageModSH cr
diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs
index c3c359335..bc5e56337 100644
--- a/src/Dodge/Default/World.hs
+++ b/src/Dodge/Default/World.hs
@@ -101,4 +101,4 @@ youLight =
         ,_tlsTime = 0
         }
   where
-    f (V2 x y) = V3 x y 10
+    f (V2 x y) = V3 x y 100
diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs
index a92998b2c..79c29915d 100644
--- a/src/Dodge/Item/Weapon.hs
+++ b/src/Dodge/Item/Weapon.hs
@@ -802,7 +802,7 @@ moveRemoteBomb itid time pID w
     -- this is hacky, should use a version of collidePointWalls' that collides
     -- circles and walls
     invShift x = x -.- 5 *.* normalizeV (_pjVel pj)
-    hitWl  = collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w
+    hitWl  = collideCircWalls'' oldPos newPos 4 $ wallsNearPoint newPos w
     finalPos = maybe newPos (invShift . fst) hitWl
     setV v = set (projectiles . ix pID . pjVel) v
     updateV = maybe id (setV . snd) hitWl
@@ -978,7 +978,7 @@ moveRemoteShell cid itid pj w
     (frict,g)  = randomR (0.6,0.9) $ _randGen w
     (sparkD,_) = randomR (-0.5,0.5) $ _randGen w
     hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
-    hitWl    = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
+    hitWl    = fst <$> collideCircWalls'' oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
     r1 = _randGen w & evalState (randInCirc 10)
     smokeGen = shellTrailCloud $ addZ 20 $ oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)
diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs
index cfa39a92d..5bf88fb3f 100644
--- a/src/Dodge/Item/Weapon/Grenade.hs
+++ b/src/Dodge/Item/Weapon/Grenade.hs
@@ -45,7 +45,7 @@ moveGrenade time dir pID w = case hitWl of
     pj     = _projectiles w IM.! pID
     oldPos = _pjPos pj
     newPos = _pjVel pj +.+ oldPos
-    hitWl  = collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w
+    hitWl  = collideCircWalls'' oldPos newPos 4 $ wallsNearPoint newPos w
     finalPos = maybe newPos fst hitWl
     setV v = set (projectiles .ix pID.pjVel) v
     updateV = maybe id (setV . snd) hitWl
diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs
index 16225b529..258c5b981 100644
--- a/src/Dodge/Item/Weapon/Launcher.hs
+++ b/src/Dodge/Item/Weapon/Launcher.hs
@@ -179,7 +179,7 @@ moveShell pj w
     projectileExplosion = _pjPayload pj
     newPos   = oldPos +.+ vel
     hitCr    = fst <$> collideCircCrsPoint oldPos newPos 4 w
-    hitWl    = fst <$> collideCircWalls oldPos newPos 2 (wallsNearPoint newPos w)
+    hitWl    = fst <$> collideCircWalls'' oldPos newPos 2 (wallsNearPoint newPos w)
     thingHit = hitCr <|> hitWl
 
 reduceSpinBy :: Float -> Projectile -> World -> World
diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs
index 295795128..6ae4fb2b7 100644
--- a/src/Dodge/Item/Weapon/TriggerType.hs
+++ b/src/Dodge/Item/Weapon/TriggerType.hs
@@ -317,7 +317,7 @@ withMuzFlareI f it cr w =
     $ f it cr w
   where 
     --pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
-    pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+    pos2 = addZ 35 $ _crPos cr +.+ (2.5 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
 {- | Applies the effect to a randomly rotated creature,
  - rotation amount given by wpSpread  -}
 randSpreadDir :: ChainEffect
diff --git a/src/Dodge/LightSources.hs b/src/Dodge/LightSources.hs
index c2788ee4d..f030a0a6b 100644
--- a/src/Dodge/LightSources.hs
+++ b/src/Dodge/LightSources.hs
@@ -42,10 +42,10 @@ tLight
     :: Int 
     -> Float -- ^ maximal radius
     -> Point3
-    -> Point2 
+    -> Point3 
     -> TempLightSource
-tLight t rmax col (V2 x y) = TLS 
-    { _tlsPos = V3 x y 1
+tLight t rmax col (V3 x y z) = TLS 
+    { _tlsPos = V3 x y z
     , _tlsRad = rmax
     , _tlsIntensity = col
     , _tlsUpdate = upF
diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs
index 75a1fec56..5dfcdb8a5 100644
--- a/src/Dodge/Render/HUD.hs
+++ b/src/Dodge/Render/HUD.hs
@@ -34,7 +34,8 @@ hudDrawings w = pictures
 
 
 drawInventory :: World -> Picture
-drawInventory w = displayInv 0 w `appendPic` subInventoryDisplay w 
+drawInventory w = subInventoryDisplay w 
+    `appendPic` displayInv 0 w
 
 subInventoryDisplay :: World -> Picture
 subInventoryDisplay w = case _inventoryMode w of
@@ -104,7 +105,7 @@ invHead :: World -> String -> Picture
 invHead w s = winScale w . translate (-130) (halfHeight w - 40) . dShadCol white . scale 0.4 0.4 $ text s
 
 renderItemMapAt :: Float -> Float -> World -> IM.IntMap Item -> Picture
---{-# INLINE renderItemMapAt #-}
+{-# INLINE renderItemMapAt #-}
 renderItemMapAt tx ty w = concatMapPic (uncurry $ listItemAt tx ty w) . IM.toList
 
 displayInv :: Int -> World -> Picture
@@ -187,19 +188,22 @@ listItemAt
     -> Int      -- ^ y offset (discrete)
     -> Item   -- ^ The item
     -> Picture
---{-# INLINE listItemAt #-}
-listItemAt xoff yoff w yint item 
+{-# INLINE listItemAt #-}
+listItemAt xoff yoff w yint
     = winScale w 
     . translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
     . scale 0.1 0.1
-    . dShadCol col
-    $ text s
+    . itemText
   where
     hw = halfWidth w
     hh = halfHeight w
-    (s,col) = case item of 
-        NoItem -> ("----", greyN 0.5)
-        _       -> (_itInvDisplay item item , _itInvColor item)
+
+itemText :: Item -> Picture
+{-# INLINE itemText #-}
+--itemText NoItem = dShadCol (greyN 0.5) $ text "----"
+--itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
+itemText NoItem = text "----"
+itemText it = color (_itInvColor it) $ text (_itInvDisplay it it)
 
 openCursorAt 
     :: Float    -- ^ Width
diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs
index fdacaca18..aa4aa57cf 100644
--- a/src/Dodge/Render/Picture.hs
+++ b/src/Dodge/Render/Picture.hs
@@ -32,7 +32,6 @@ worldPictures w = pictures
     ,concatMapPic (dbArg _ptDraw) $ _particles w
     ,testPic w
     ,concatMapPic (_spPicture . floorItemSPic) $ _floorItems w
-    ,concatMapPic (crDraw w) $ _creatures w
     ,concatMapPic clDraw $ _clouds w      
     ,concatMapPic ppDraw $ _pressPlates w
     ,concatMapPic btDraw $ _buttons w
@@ -149,8 +148,9 @@ wallShadowsToDraw w
 -- cannot only test if walls are on screen, but also if they are on the cone
 -- towards the center of sight
 lineOnScreenCone :: World -> Point2 -> Point2 -> Bool
-lineOnScreenCone w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp 
-                                                || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
+lineOnScreenCone w p1 p2 = pointInPolygon p1 sp 
+    || pointInPolygon p2 sp 
+    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
   where 
     sp' = screenPolygon w
     vp = _cameraViewFrom w
@@ -160,8 +160,9 @@ lineOnScreenCone w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
 
 
 lineOnScreen :: World -> Point2 -> Point2 -> Bool
-lineOnScreen w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp 
-                                                || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
+lineOnScreen w p1 p2 = pointInPolygon p1 sp 
+    || pointInPolygon p2 sp 
+    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
   where 
     sp = screenPolygon w
     sps = zip sp (tail sp ++ [head sp])
diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs
index aaf9a5fa9..a448d1a83 100644
--- a/src/Dodge/Update.hs
+++ b/src/Dodge/Update.hs
@@ -199,7 +199,8 @@ updateCloud w c
     oldPos2 = stripZ oldPos
     newPos@(V3 _ _ npz) = oldPos +.+.+ newVel
     newPos2 = stripZ newPos
-    hitWl = collideCircWalls oldPos2 newPos2 5 $ wallsNearPoint newPos2 w
+    -- the following only tests for the first collision with a wall
+    hitWl = collidePointAnyWalls oldPos2 newPos2 $ wallsNearPoint newPos2 w
     finalPos = addZ npz $ maybe newPos2 fst hitWl
     finalVel = addZ nvz $ maybe newVel2 snd hitWl
 
diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs
index 9b4dde504..adaafd497 100644
--- a/src/Dodge/Update/Camera.hs
+++ b/src/Dodge/Update/Camera.hs
@@ -26,7 +26,7 @@ import qualified Data.IntMap.Strict as IM
 import qualified SDL
 --import Data.Monoid
 --import Data.Semigroup
-import qualified Control.Foldl as L
+--import qualified Control.Foldl as L
 {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers; 
 update where your avatar's view is from.  -}
 updateCamera :: World -> World
@@ -163,46 +163,28 @@ autoZoomCam w = over cameraZoom changeZoom w
     theScopeZoom = fromMaybe 1 $ yourItem w ^? itAttachment . scopeZoom
 
 farWallDist' :: Point2 -> World -> Float
-farWallDist' p w = (winFac /) $ fromMaybe maxViewDistance $ L.fold L.maximum vdists
+farWallDist' p w = (winFac /) . min maxViewDistance $ ssfold (> maxViewDistance) findMax 1 vps
   where
+    findMax curMax pout = max curMax $ dist p $ collidePointUpToIndirectMinDist p pout curMax wos
     hw = halfWidth w
     hh = halfHeight w
     winFac = min hw hh
-    vdists = map (flip (collideDirectionIndirect maxViewDistance p) wos)
-        vps
     vps = concatMap _grViewpoints grs
     grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
     wos = wallsOnScreen w
----- | Find the furthest viewable distance from a given point in the world
+
 --farWallDist :: Point2 -> World -> Float
-----{-# INLINE farWallDist #-}
---farWallDist cpos w 
---    = getMin 
---    . uncurry (<>) 
---    $ bimap (toScale hw) (toScale hh) 
---    $ sconcat 
---    $ NEL.map distsMaybeTo viewTestValues
+--farWallDist p w = (winFac /) $ fromMaybe maxViewDistance 
+--    $ L.fold (L.premap (dist p) L.maximum) vdists
 --  where
---    wos = wallsOnScreen w
---    camRot = _cameraRot w
 --    hw = halfWidth w
 --    hh = halfHeight w
---    toScale x = Min . (x /) . (+ 50) . maybe maxViewDistance getMax . getAp
---    distsMaybeTo x = (valueAtWidth x,valueAtHeight x)
---    valueAtHeight h  = cpiv (cpos +.+ x) <> cpiv (cpos -.- x)
---      where
---        x = rotateV camRot $ V2 maxViewDistance h
---        cpiv p = Ap $ Max . horSize <$> collidePointIndirect cpos p wos
---        horSize = abs . dotV rv . (-.- cpos)
---        rv = rotateV camRot (V2 1 0)
---    valueAtWidth h  = cpih (cpos +.+ x) <> cpih (cpos -.- x)
---      where
---        x = rotateV camRot $ V2 h maxViewDistance
---        cpih p = Ap $ Max . verSize <$> collidePointIndirect cpos p wos
---        verSize = abs . dotV rh . (-.- cpos)
---        rh = rotateV camRot (V2 0 1)
---viewTestValues :: NEL.NonEmpty Float
---viewTestValues = NEL.fromList [-maxViewDistance,negate $ 0.75*maxViewDistance..maxViewDistance]
+--    winFac = min hw hh
+--    vdists :: [Point2]
+--    vdists = map (flip (collidePointUpToIndirect p) wos) vps
+--    vps = concatMap _grViewpoints grs
+--    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
+--    wos = wallsOnScreen w
 
 maxViewDistance :: Float
 maxViewDistance = 800
diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs
index b766a6786..ad72faa2f 100644
--- a/src/Dodge/WorldEvent.hs
+++ b/src/Dodge/WorldEvent.hs
@@ -58,5 +58,5 @@ damCrsOnLine dam p1 p2 = over creatures (IM.map damIfOnLine)
                                      = over crHP (\hp -> hp - dam) cr
                          | otherwise = cr
 
-makeTLight :: Int -> Float -> Point3 -> Point2 -> World -> World
+makeTLight :: Int -> Float -> Point3 -> Point3 -> World -> World
 makeTLight i rad col p = tempLightSources %~ (tLight i rad col p :)
diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs
index 1252ec10f..33846685e 100644
--- a/src/Dodge/WorldEvent/ThingsHit.hs
+++ b/src/Dodge/WorldEvent/ThingsHit.hs
@@ -2,6 +2,11 @@
 Find which objects lie upon a line.
  -}
 module Dodge.WorldEvent.ThingsHit
+    ( thingsHit
+    , thingsHitLongLine
+    , thingsHitExceptCr
+    , thingsHitExceptCrLongLine
+    )
     where
 import Dodge.Data
 import Dodge.Base
@@ -80,7 +85,3 @@ thingsHitLongLine sp ep w
     hitPoint wl = uncurry (intersectSegSeg sp ep) (_wlLine wl)
     hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
     ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
-
-thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, Either3 Creature Wall ForceField ) ] ]
-thingsHitOnPath [] _ = error "tried to find thingsHitOnPath containing no points"
-thingsHitOnPath ps w = zipWith (\ a b -> thingsHit a b w) ps $ tail ps
diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs
index 3ac9c0117..c2a7aecb3 100644
--- a/src/Dodge/Zone.hs
+++ b/src/Dodge/Zone.hs
@@ -100,10 +100,13 @@ wallsDoubleScreen w
     ys = [y - n .. y + n]
 
 wallsOnScreen :: World -> IM.IntMap Wall
+{-# INLINABLE wallsOnScreen #-}
 wallsOnScreen w
-    = foldl' (flip $ IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
+   -- = foldl' (flip $ IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
+    = foldr (IM.union . \i -> innerFold (f i (_znObjects $ _wallsZone w))) IM.empty xs
   where 
-    innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
+    --innerFold m = foldl' (flip $ IM.union . \ j -> f j m) IM.empty ys
+    innerFold m = foldr (IM.union . \ j -> f j m) IM.empty ys
     f i m = case IM.lookup i m of 
         Just val -> val
         _        -> IM.empty
@@ -113,7 +116,6 @@ wallsOnScreen w
     xs = [x - n .. x + n]
     ys = [y - n .. y + n]
 
-
 wallsNearZones :: [(Int,Int)] -> World -> IM.IntMap Wall
 wallsNearZones is w -- = IM.unions [f b $ f a $ _wallsZone w | (a,b) <- is]
     = foldl' (flip $ IM.union . \(a,b) -> f b (f a (_znObjects $ _wallsZone w))) IM.empty is
diff --git a/src/Geometry.hs b/src/Geometry.hs
index 1ae34f316..5477a8a93 100644
--- a/src/Geometry.hs
+++ b/src/Geometry.hs
@@ -81,7 +81,7 @@ pointInOrOnPolygon _ _ = undefined
 -- | Test whether a point is strictly inside a polygon.
 -- Supposes the points in the polygon are listed in anticlockwise order.
 pointInPolygon :: Point2 -> [Point2] -> Bool
-pointInPolygon !p (x:xs) = all (\l -> uncurry (errorIsLHS 1) l p) $ zip (x:xs) (xs ++ [x])
+pointInPolygon !p (x:xs) = all (\l -> uncurry isLHS l p) $ zip (x:xs) (xs ++ [x])
 pointInPolygon _ [] = False
 -- | Debug version of 'pointInPolygon'.
 errorPointInPolygon :: Int -> Point2 -> [Point2] -> Bool