More streaming refactoring

src/Dodge/Base/Collide.hs

@@ -3,9 +3,10 @@
 module Dodge.Base.Collide
     ( hasLOS
     , collidePointWallsWall
+    , collidePointWallsFilterStream
+    , reflectPointWallsDamp
     , hasButtonLOS
     , reflectPointWalls
-    , reflectPointWallsDamp
     , ssfold
     , collidePointUpToIndirectMinDist
     , canSeeIndirect
@@ -35,6 +36,7 @@ module Dodge.Base.Collide
     , nearestCrInRad
     , nearestCrInTri
     , nearestCrInFront
+    , allVisibleWalls
     ) where
 import Dodge.Data
 import Dodge.Zone
@@ -50,6 +52,7 @@ import qualified FoldlHelp as L
 import Data.Monoid
 import Streaming
 import qualified Streaming.Prelude as S
+--import qualified Data.Map.Lazy as M -- note the use of Lazy, the idea being interoperation with Streaming
 
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
@@ -72,13 +75,14 @@ hasButtonLOS p1 p2 = not
 --    = safeMinimumOn (dist p1 . fst)
 --    . mapMaybe
 --    (\(x,y) -> (, (x,y)) <$> intersectSegSeg p1 p2 x y)
-
-reflectPointWallsDamp :: Float -> Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
-reflectPointWallsDamp x p1 p2 = fmap (f p1 p2) . collidePointWallsWall p1 p2 
-  where
-    f a b (p,wl) = ( p +.+ errorNormalizeV 139 (vNormal (uncurry (-.-) $ _wlLine wl))
-        , reflVelWallDamp x wl (b-.-a)
+reflectPointWallsDamp :: (Wall -> Bool) -> Float -> Point2 -> Point2 -> World -> Maybe (Point2,Point2)
+reflectPointWallsDamp t x sp ep w = do
+    wl <- mwl
+    return (p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
+        , reflVelWallDamp x wl (ep -.- sp)
         )
+  where
+    (p, mwl) = collidePointWallsFilterStream t sp ep w
 
 -- | Looks for first collision of a point with walls.
 -- If found, gives point and wall.
@@ -120,38 +124,46 @@ reflectPointWalls p1 p2
 --         . _wlLine
 --        ) ws
 -- | Test if a point collides with walls
-pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
-pointHitsWalls p1 p2 
-    = any $ isJust . uncurry (intersectSegSeg p1 p2) . _wlLine
 
+-- this COULD be written in terms of collidePointWallsFilterStream, TODO test
+-- whether this is actually faster
 collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> Stream (Of Wall) Identity () -> Bool
 collidePointTestFilter t sp ep = runIdentity 
     . S.any_ (isJust . uncurry (intersectSegSeg sp ep) . _wlLine)
     . S.filter t
 
---furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
---furthestPointWalkable p1 p2 ws 
---    = fromMaybe p2
---    . safeMinimumOn (dist p1) 
---    $ IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine) ws
+collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall)
+collidePointWallsFilterStream t sp ep = runIdentity
+    . S.fold_ findPoint (ep, Nothing) id
+    . S.filter t
+    . wallsAlongLineStream sp ep
+  where
+    findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
 
---collideDirectionIndirect 
---    :: Float    -- ^max distance to look
---    -> Point2   -- ^start point
---    -> Point2   -- ^point in direction
---    -> IM.IntMap Wall 
---    -> Float
---{-# INLINE collideDirectionIndirect #-}
---collideDirectionIndirect d p1 p2 wls
---    = fromMaybe d
---    $
---    ( L.fold
---    . L.prefilter wlIsOpaque
---    . L.premapMaybe (fmap (dist p1) . uncurry (intersectSegSeg p1 p3) . _wlLine)
---    ) L.minimum 
---    wls
---  where
---    p3 = p1 +.+ d *.* safeNormalizeV (p2 -.- p1)
+--visibleWallWalls' :: Point2 -> Point2 -> World -> M.Map Float Wall
+--visibleWallWalls' sp ep = L.purely S.fold L.map . visibleWallWalls sp ep
+
+--orderStreamOn :: Ord b => (a -> b) -> Stream (Of a) Identity () -> Identity (Of (M.Map b a) ())
+orderStreamOn :: Ord a => (b -> a) -> Stream (Of b) Identity () -> Stream (Of b) Identity ()
+orderStreamOn f = S.each . runIdentity . L.purely S.fold_ L.map . S.map g
+  where
+    g x = (f x,x)
+
+visibleWallWalls :: Point2 -> Point2 -> World -> Stream (Of (Point2,Wall)) Identity ()
+visibleWallWalls sp ep = 
+    join
+    . fmap (S.take 1)
+    . S.span (not . wlIsOpaque . snd)
+    . orderStreamOn (dist sp . fst)
+    . S.mapMaybe f
+    . wallsAlongLineStream sp ep
+  where
+    f wl = uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)
+
+allVisibleWalls :: World -> Stream (Of (Point2,Wall)) Identity ()
+allVisibleWalls w = concats $ S.subst (flip (visibleWallWalls vPos) w . (+.+ vPos)) $ S.each (nRays 20)
+  where
+    vPos = _cameraViewFrom w
 
 wlIsOpaque :: Wall -> Bool
 wlIsOpaque wl = case _wlOpacity wl of
@@ -192,40 +204,6 @@ 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 = test . foldr f p2 . IM.filter wlIsOpaque
---  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 wlIsOpaque
-    . L.premapMaybe (uncurry (intersectSegSeg p1 p2) . _wlLine)
-    $ L.minimumOn (dist p1)
-
---{- | 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. -}
---collidePointFire :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
---collidePointFire p1 p2 ws 
---    = safeMinimumOn (dist p1) 
---    . IM.mapMaybe ( uncurry (intersectSegSeg p1 p2) . _wlLine ) 
---    $ IM.filter (\wl -> not (_wlFireThrough wl) || wlIsOpaque wl) ws
---{- | 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. -}
---collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
---collidePointFireVision p1 p2 ws 
---    = any ( isJust . uncurry (intersectSegSeg p1 p2) . _wlLine) 
---    $ IM.filter theTest ws
---  where 
---    theTest wl = not (_wlFireThrough wl) || wlIsOpaque wl
-
--- the reason for using the dashed version is the hope that this will short
--- circuit
 hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
 hasLOSIndirect p1 p2 = not
     . collidePointTestFilter wlIsOpaque p1 p2
@@ -242,95 +220,12 @@ canSee i j w = hasLOS p1 p2 w
     p1 = _crPos (_creatures w IM.! i)
     p2 = _crPos (_creatures w IM.! j)
 
---canSeePoint :: Int -> Point2 -> World -> Bool
---canSeePoint i p w = hasLOS p1 p w
---  where
---    p1 = _crPos (_creatures w IM.! i)
-
---pathToPointFireable :: Int -> Point2 -> World -> Bool
---pathToPointFireable i p w 
---    = not 
---    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
---    $ IM.filter (not . _wlFireThrough ) $ wallsAlongLine p1 p w
---  where 
---    p1 = _crPos (_creatures w IM.! i)
-
---canSeePointAll :: Int -> Point2 -> World -> Bool
---canSeePointAll i targPos w 
---    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
---  where 
---    cr = _creatures w IM.! i
---    radius = _crRad cr
-
---canSeeAny :: Int -> Int -> World -> Bool
---canSeeAny fromID toID w 
---    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
---  where 
---    cr = _creatures w IM.! toID
---    cpos = _crPos cr
---    radius = _crRad cr
-
---canSeeAll :: Int -> Int -> World -> Bool
---canSeeAll fromID toID w 
---    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p) . toV2) [(1,0),(0,1),(-1,0),(0,-1)]
---  where 
---    cr = _creatures w IM.! toID
---    cpos = _crPos cr
---    radius = _crRad cr
-
---canWalk :: Int -> Int -> World -> Bool
---canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos w
---  where 
---    ipos = _crPos (_creatures w IM.! i)
---    jpos = _crPos (_creatures w IM.! j)
-
 canSeeIndirect :: Int -> Int -> World -> Bool
 canSeeIndirect i j w = hasLOSIndirect ipos jpos w
   where 
     ipos = _crPos (_creatures w IM.! i)
     jpos = _crPos (_creatures w IM.! j)
     
---canSeeFire :: Point2 -> Point2 -> World -> Bool
---canSeeFire p p' w = not $ collidePointFireVision p p' $ wallsAlongLine p p' w
-
---canSeeFireVision :: Int -> Int -> World -> Bool
---canSeeFireVision i j w = canSeeFire ipos jpos w
---  where 
---    ipos = _crPos (_creatures w IM.! i)
---    jpos = _crPos (_creatures w IM.! j)
---{- | Test whether both of the outside lines between two creatures are blocked -}
---canSeeFireVisionAny :: Int -> Int -> World -> Bool
---canSeeFireVisionAny i j w 
---    = not 
---    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
---        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
---    && collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
---        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
---  where
---    icr = _creatures w IM.! i
---    jcr = _creatures w IM.! j
---    ipos = _crPos icr
---    jpos = _crPos jcr
---    n = normalizeV $ vNormal $ ipos -.- jpos
---    ni = _crRad icr *.* n
---    nj = _crRad jcr *.* n
---{- | Test whether either of the outside lines between two creatures are blocked -}
---canSeeFireVisionAll :: Int -> Int -> World -> Bool
---canSeeFireVisionAll i j w 
---    = not 
---    $ collidePointFireVision (ipos +.+ ni) (jpos +.+ nj) 
---        (wallsAlongLine (ipos +.+ ni) (jpos +.+ nj) w)
---    || collidePointFireVision (ipos -.- ni) (jpos -.- nj) 
---        (wallsAlongLine (ipos -.- ni) (jpos -.- nj) w)
---  where
---    icr = _creatures w IM.! i
---    jcr = _creatures w IM.! j
---    ipos = _crPos icr
---    jpos = _crPos jcr
---    n = normalizeV $ vNormal $ ipos -.- jpos
---    ni = _crRad icr *.* n
---    nj = _crRad jcr *.* n
-
 wallsOnLineHit :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap (Point2, Wall)
 wallsOnLineHit p1 p2 = IM.mapMaybe f
   where
@@ -341,8 +236,6 @@ wallsOnCirc p r = IM.filter f
   where 
     f wl = uncurry circOnSeg (_wlLine wl) p r
 
---wallNormal :: Wall -> Point2
---wallNormal = normalizeV . vNormal . uncurry (-.-) . _wlLine
 -- | Looks for overlap of a circle with walls.
 -- If found, gives wall
 overlapCircWallsReturnWall :: Point2 -> Float -> IM.IntMap Wall -> Maybe Wall

src/Dodge/Config/Data.hs

@@ -39,6 +39,7 @@ data DebugBool
     | Close_shape_culling
     | Show_bound_box
     | Bound_box_screen
+    | Show_wall_search_rays
   deriving (Generic, Eq,Ord,Bounded, Enum, Show)
 data ResFactor = FullRes | HalfRes | QuarterRes
   deriving (Generic, Show, Eq, Ord, Enum, Bounded)

src/Dodge/Creature/Action.hs

@@ -29,7 +29,7 @@ import Dodge.Creature.Stance.Data
 import Dodge.WorldEvent.Shockwave
 import Dodge.Data
 import Dodge.Base
-import Dodge.Zone
+--import Dodge.Zone
 import Dodge.SoundLogic
 --import Dodge.WorldEvent
 import Dodge.Inventory
@@ -172,7 +172,7 @@ blinkActionFail cr w = w
     cid  = _crID cr
     p1 = mouseWorldPos w
     cpos = _crPos cr
-    p2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
+    p2 = reflectPointWallsDamp (const True) 1 cpos p1 w
     r  = 1.5 * _crRad cr
     p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
 
@@ -193,7 +193,7 @@ blinkAction cr w = w
     cid  = _crID cr
     p1 = mouseWorldPos w
     cpos = _crPos cr
-    p2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
+    p2 = reflectPointWallsDamp (const True) 1 cpos p1 w
     r  = 1.5 * _crRad cr
     p3 = maybe p1 (mvPointTowardAtSpeed r cpos . fst) p2
 
@@ -215,7 +215,7 @@ unsafeBlinkAction cr w
             Damage ENTERREMENT 10000 mwp mwp mwp NoDamageEffect
   where
     success = fromMaybe True $ do
-        (_,wl) <- collidePointWallsWall mwp cpos $ wallsAlongLine mwp cpos w
+        wl <- snd $ collidePointWallsFilterStream (const True) mwp cpos w
         return (isLHS mwp `uncurry` _wlLine wl)
     distR = 120
     distortionBulge = 

src/Dodge/Floor.hs

@@ -41,15 +41,16 @@ initialAnoTree :: Annotation
 initialAnoTree = OnwardList 
         $ intersperse (AnTree corDoor)
     [ IntAnno $ AnTree . startRoom
+    , AnRoom $ roomCCrits 10
     , AnRoom slowDoorRoom
     , AnTree firstBreather
     , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
---    ]
---
---extraAnoList :: [Annotation]
---extraAnoList =
-----     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
---    [ AnRoom $ roomCCrits 10
+    ]
+
+extraAnoList :: [Annotation]
+extraAnoList =
+--     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
+    [ AnRoom $ roomCCrits 10
     , AnRoom $ roomCCrits 10
     , AnTree $ tToBTree "spawners" <$> spawnerRoom
     , AnRoom pistolerRoom

src/Dodge/Item/Equipment/Booster.hs

@@ -3,7 +3,6 @@ module Dodge.Item.Equipment.Booster
     ) where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Zone
 import Dodge.Default.Weapon
 import Geometry
 import qualified IntMapHelp as IM
@@ -27,7 +26,7 @@ boostPoint x cr w = case mayp2 of
     cpos = _crPos cr
     r = 1.5 * _crRad cr
     p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
-    mayp2 = reflectPointWalls cpos p1 $ wallsAlongLine cpos p1 w
+    mayp2 = reflectPointWallsDamp (const True) 1 cpos p1 w
 
 boostSelfL
     :: Float    -- ^ boost amount

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -36,7 +36,7 @@ import Dodge.Default.Weapon
 --import Dodge.Item.Attachment
 --import Dodge.WorldEvent.HelperParticle
 import Dodge.Base
-import Dodge.Zone
+--import Dodge.Zone
 import Geometry
 import Picture
 import Shape
@@ -447,8 +447,7 @@ aTractorBeam _ cr w = w & plNew props pjID (tractorBeamAt spos outpos dir power)
     spos = cpos +.+ (_crRad cr + 10) *.* unitVectorAtAngle dir
     xpos = cpos +.+ 400 *.* unitVectorAtAngle dir
     dir = _crDir cr
-    outpos = collidePointWalls' cpos xpos
-        $ wallsAlongLine cpos xpos w
+    outpos = fst $ collidePointWallsFilterStream (const True) cpos xpos w
     power = _attractionPower . _itParams $ _crInv cr IM.! crSel cr
 
 tractorBeamAt :: Point2 -> Point2 -> Float -> Point2 -> Prop

src/Dodge/Item/Weapon/Shatter.hs

@@ -6,7 +6,7 @@ import Dodge.Wall.Damage
 --import Dodge.SoundLogic
 import Dodge.Block.Debris
 import Dodge.Base.Collide
-import Dodge.Zone
+--import Dodge.Zone
 import Dodge.Creature.HandPos
 --import Dodge.ChainEffect
 import Dodge.Default.Weapon
@@ -24,7 +24,7 @@ import Shape
 --import Sound.Data
 import LensHelp
 
-import qualified Data.IntMap.Strict as IM
+--import qualified Data.IntMap.Strict as IM
 
 shatterGun :: Item
 shatterGun = defaultWeapon
@@ -46,9 +46,8 @@ shatterGunSPic _ = noPic $ colorSH blue $
     xa = 1
     xb = 9
 shootShatter :: Item -> Creature -> World -> World
-shootShatter it cr w = maybe w (uncurry $ shatterWall w sp ep) $ collidePointWallsWall sp ep 
-    $ IM.filter canshatter 
-    $ wallsAlongLine sp ep w
+shootShatter it cr w = maybe w (uncurry $ shatterWall w sp ep) $ sequence 
+    $ collidePointWallsFilterStream canshatter sp ep w
   where
     canshatter wl = case _wlOpacity wl of
         Opaque -> True

src/Dodge/Prop/Moving.hs

@@ -3,7 +3,7 @@ module Dodge.Prop.Moving
     , fallSmallBounceDamage
     , fallSmallBounce
     ) where
-import Dodge.Zone
+--import Dodge.Zone
 import Dodge.Base
 import Dodge.Data
 --import Dodge.Damage
@@ -58,7 +58,7 @@ fallSmallBounce' w pr
     velz = _pjVelZ pr
     vel  = _pjVel pr
     pos  = _prPos pr
-    updateWithVel v = case reflectPointWallsDamp 0.5 pos (pos + v) $ wallsAlongLine pos (pos +v) w of
+    updateWithVel v = case reflectPointWallsDamp (const True) 0.5 pos (pos + v) w of
         Nothing -> prPos +~ v
         Just (p,v') -> (prPos .~ p) . (pjVel .~ v')
 

src/Dodge/Render/ShapePicture.hs

@@ -22,11 +22,13 @@ import Shape
 import Picture
 import Sound.Data
 import Geometry.ConvexPoly
+--import Dodge.Base.Collide
 
 import qualified Data.IntMap.Strict as IM -- Lazy?
 import qualified Data.Map.Strict as M
 import Control.Lens
 import Data.Maybe
+import qualified Streaming.Prelude as S
 
 -- TODO only filter out shapes outside the range of the furthest shown light source
 worldSPic :: Configuration -> World -> SPic
@@ -76,15 +78,24 @@ extraPics cfig w = pictures (_decorations w)
     <> drawWallIDs cfig w
     <> drawPathing cfig w
     <> drawCrInfo cfig w
-    <> drawBoundingBox cfig w
+    <> cfigdraw Show_bound_box drawBoundingBox
+    <> cfigdraw Show_wall_search_rays (const drawWallSearchRays)
+  where
+    cfigdraw boption draw
+        | debugOn boption cfig = draw cfig w
+        | otherwise = mempty
+
+drawWallSearchRays :: World -> Picture
+drawWallSearchRays w = runIdentity $ S.foldMap_ f $ S.map fst $ allVisibleWalls w
+  where
+    f p = setLayer DebugLayer $ color yellow $ uncurryV translate p (circle 5)
+        <> line [_cameraViewFrom w, p]
 
 testPic :: Configuration -> World -> Picture
 testPic _ _ = mempty
 
 drawBoundingBox :: Configuration -> World -> Picture
-drawBoundingBox cfig w 
-    | debugOn Show_bound_box cfig = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
-    | otherwise = mempty
+drawBoundingBox cfig w = setLayer DebugLayer $ color green $ line $ (x:xs) ++ [x]
   where
     (x:xs) = cullBox cfig w
 

src/Dodge/Update.hs

@@ -34,6 +34,8 @@ import Control.Applicative
 --import qualified Data.Set as S
 --import Data.Monoid
 --import System.Random
+import qualified Streaming.Prelude as S
+--import Streaming
 
 {- For most menus the only way to change the world is using event handling.  -}
 updateUniverse :: Universe -> Universe
@@ -286,19 +288,24 @@ ppEvents :: World -> World
 ppEvents w = IM.foldl' (flip $ \pp -> _ppEvent pp pp) w $ _pressPlates w
 
 -- this is not working correctly, maybe a problem with wallsAlongLine
+--updateSeenWalls :: World -> World
+--updateSeenWalls w = foldl' markWallSeen w wallsToUpdate
+--  where 
+--    vPos = _cameraViewFrom w
+--    wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ wallsAlongLine vPos (vPos +.+ p) w)
+--                             $ nRays 20
 updateSeenWalls :: World -> World
-updateSeenWalls w = foldl' markWallSeen w wallsToUpdate
+updateSeenWalls w = runIdentity $ S.fold_ f w id (S.map (_wlID . snd) $ allVisibleWalls w)
   where 
-    vPos = _cameraViewFrom w
-    wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ wallsAlongLine vPos (vPos +.+ p) w)
-                             $ nRays 20
---    wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ _walls w)
+    f w' i = w' & walls . ix i . wlSeen .~ True
+
+--    wallsToUpdate = concatMap (\p -> visibleWalls vPos (vPos +.+p) $ wallsAlongLine vPos (vPos +.+ p) w)
 --                             $ nRays 20
 
-markWallSeen :: World -> Wall -> World
-markWallSeen w wl = w { _walls = IM.adjust mw (_wlID wl) $ _walls w }
-  where
-    mw wl' = wl' {_wlSeen = True}
+--markWallSeen :: World -> Wall -> World
+--markWallSeen w wl = w { _walls = IM.adjust mw (_wlID wl) $ _walls w }
+--  where
+--    mw wl' = wl' {_wlSeen = True}
 
 checkEndGame :: World -> World
 checkEndGame w = case _deathDelay w of
@@ -398,18 +405,6 @@ crCrSpring c1 c2 w
     overlap2 = ((comRad - diff) * _crMass c1 * 0.5 / massT) *.* errorNormalizeV 56 vec
     massT    = _crMass c1 + _crMass c2
 
-{- Finds the visible walls from a point to another point.  -}
-visibleWalls :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
-visibleWalls p1 p2 ws 
-    = takeUntil wlIsOpaque
-    . map snd 
-    . sortOn (dist p1 . fromJust . fst) 
-    . filter (isJust . fst) 
-    . map f 
-    $ IM.elems ws
-  where 
-    f wl = (uncurry intersectSegSeg (_wlLine wl) p1 p2, wl)
-
 updateDelayedEvents :: World -> World
 updateDelayedEvents w = let (neww,newde) = mapAccumR f w (_delayedEvents w)
     in neww & delayedEvents .~ catMaybes newde