Cleanup

src/Dodge/Base/Collide.hs

@@ -59,13 +59,13 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 = not 
     . collidePointTestFilter (const True) p1 p2
-    . wallsAlongLineStream p1 p2
+    . wallsAlongLine p1 p2
 
 hasButtonLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasButtonLOS #-}
 hasButtonLOS p1 p2 = not
     . collidePointTestFilter (not . _wlTouchThrough) p1 p2
-    . wallsAlongLineStream p1 p2
+    . wallsAlongLine p1 p2
 
 --hitPointLines
 --    :: Point2
@@ -137,7 +137,7 @@ collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World ->
 collidePointWallsFilterStream t sp ep = runIdentity
     . S.fold_ findPoint (ep, Nothing) id
     . S.filter t
-    . wallsAlongLineStream sp ep
+    . wallsAlongLine sp ep
   where
     findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
 
@@ -155,7 +155,7 @@ visibleWalls sp ep = S.take 1 <=<  -- hlint, was using join and fmap
     ( S.span (not . wlIsOpaque . snd)
     . orderStreamOn (dist sp . fst)
     . S.mapMaybe f
-    . wallsAlongLineStream sp ep    )
+    . wallsAlongLine sp ep    )
   where
     f wl = uncurry (intersectSegSeg sp ep) (_wlLine wl) <&> (,wl)
 
@@ -206,12 +206,12 @@ ssfold p f a0 xs = foldr (\x g a -> if p a then a else g (f a x)) id xs a0
 hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
 hasLOSIndirect p1 p2 = not
     . collidePointTestFilter wlIsOpaque p1 p2
-    . wallsAlongLineStream p1 p2
+    . wallsAlongLine p1 p2
 
 isWalkable :: Point2 -> Point2 -> World -> Bool
 isWalkable p1 p2 = not 
     . collidePointTestFilter (not . (^?! wlPathable)) p1 p2 
-    . wallsAlongLineStream p1 p2
+    . wallsAlongLine p1 p2
 
 canSee :: Int -> Int -> World -> Bool
 canSee i j w = hasLOS p1 p2 w

src/Dodge/Data.hs

@@ -141,9 +141,9 @@ data World = World
     , _foregroundShape      :: Shape
     , _corpses              :: IM.IntMap Corpse
     , _clickMousePos        :: Point2
-    , _pathGraph            :: ~(Gr Point2 Float)
+    , _pathGraph            :: Gr Point2 Float
-    , _pathGraphP           :: ~[(Point2,Point2)]
+    , _pathGraphP           :: S.Set (Point2,Point2)
-    , _pathPoints           :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
+    , _pathPoints           :: IM.IntMap (IM.IntMap [(Int,Point2)])
     , _hud                  :: HUD
     , _lightSources         :: IM.IntMap LightSource
     , _tempLightSources     :: [TempLightSource]

src/Dodge/Debug.hs

@@ -58,7 +58,7 @@ debugWallZoningPic w = setLayer BloomLayer $ zonesPic `appendPic` wallsPic
   where
     --wallsPic = setDepth 25 . color yellow . concatMapPic (drawTheWall . _wlLine) $ IM.elems theWalls
     wallsPic = setDepth 25 . color yellow . runIdentity . S.foldMap_ (drawTheWall . _wlLine) 
-        $ wallsAlongLineStream sp ep w
+        $ wallsAlongLine sp ep w
     drawTheWall (a,b) = thickLine 20 [a,b]
     zonesPic = setDepth 20 $ drawDDA zones
     zones = ddaExt zoneSize sp ep

src/Dodge/Default/World.hs

@@ -71,7 +71,7 @@ defaultWorld = World
 --    , _menuLayers = []
     , _clickMousePos = V2 0 0
     , _pathGraph = Data.Graph.Inductive.Graph.empty
-    , _pathGraphP = []
+    , _pathGraphP = mempty
     , _pathPoints = IM.empty
     , _hud = HUD
         { _hudElement = DisplayInventory NoSubInventory

src/Dodge/Floor.hs

@@ -41,8 +41,8 @@ initialAnoTree :: Annotation
 initialAnoTree = OnwardList 
         $ intersperse (AnTree corDoor)
     [ IntAnno $ AnTree . startRoom
-    , AnRoom $ roomCCrits 10
     , AnRoom slowDoorRoom
+    , AnRoom $ roomCCrits 10
     , AnTree firstBreather
     , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
     ]

src/Dodge/Layout.hs

@@ -26,6 +26,7 @@ import Color
 import Shape
 --import Padding
 
+import qualified Data.Set as S
 import Data.List (nubBy)
 import Data.Traversable
 import Control.Lens
@@ -52,7 +53,7 @@ generateLevelFromRoomList gr' w = initWallZoning
         }
   where
     path = pairsToGraph dist pairPath
-    pairPath = concatMap _rmPath rs
+    pairPath = S.fromList $ concatMap _rmPath rs
     rs = map doRoomShift $ IM.elems rs'
     rs'= mapM shuffleRoomPos gr' & evalState $ _randGen w
 

src/Dodge/Path.hs

@@ -17,6 +17,7 @@ import Data.Maybe
 import Data.List
 import qualified Data.IntMap.Strict as IM
 import Data.Graph.Inductive hiding ((&))
+import qualified Data.Set as S
 --import Data.Graph.Inductive.PatriciaTree
 --import Data.Graph.Inductive.Graph hiding ((&))
 
@@ -78,11 +79,11 @@ pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs a
 --        [] -> return Nothing
 --        _  -> return $ Just $ ns !! i
 --
-pairsToGraph :: (Ord a, Eq b) => (a -> a -> b) -> [(a,a)] -> Gr a b
+pairsToGraph :: (Ord a, Ord b) => (a -> a -> b) -> S.Set (a,a) -> Gr a b
 pairsToGraph f pairs = 
-    let nodes' = nub (map fst pairs ++ map snd pairs)
+    let nodes' = S.map fst pairs `S.union` S.map snd pairs
-        pairs' = map (\(x,y)->(x,y,f x y)) pairs
+        pairs' = S.map (\(x,y)->(x,y,f x y)) pairs
-    in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM nodes' >> insMapEdgesM pairs'
+    in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM (S.toList nodes') >> insMapEdgesM (S.toList pairs')
 
 removePathsCrossing :: Point2 -> Point2 -> World -> World
 removePathsCrossing a b w = w
@@ -90,6 +91,6 @@ removePathsCrossing a b w = w
     & pathGraphP .~ pg'
     & pathPoints .~ foldr insertPoint IM.empty (labNodes newGraph)
   where 
-    pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
+    pg' = S.filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
     insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
     newGraph = pairsToGraph dist pg'

src/Dodge/Update/Camera.hs

@@ -233,7 +233,7 @@ farWallDistDirection p w = runIdentity $ L.purely S.fold_ ((,,,)
     $ S.map f vps
   where
     f q = runIdentity (S.fold_ findPoint q (rotateV (negate $ _cameraRot w) . (-.- p)) (wls q))
-    wls q = S.filter wlIsOpaque $ wallsAlongLineStream p q w
+    wls q = S.filter wlIsOpaque $ wallsAlongLine p q w
     findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
     vps = streamViewpoints p w
 

src/Dodge/Zone.hs

@@ -2,8 +2,7 @@ module Dodge.Zone
     ( crZoneOfPoint
     , zoneOfLineIntMap
     , wallsNearPoint
---    , wallsAlongLine
+    , wallsAlongLine
-    , wallsAlongLineStream
     , zoneSize
     , zoneOfPoint
     , wallsAlongCirc
@@ -176,8 +175,8 @@ cloudsNearPoint p w = f (IM.lookup x (_znObjects $ _cloudsZone w) >>= IM.lookup
 --        Just val -> val
 --        _        -> IM.empty
 
-wallsAlongLineStream :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
+wallsAlongLine :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
-wallsAlongLineStream sp ep w = S.concat $ S.mapMaybe f $ zoneOfLineStream sp ep
+wallsAlongLine sp ep w = S.concat $ S.mapMaybe f $ zoneOfLineStream sp ep
   where
     f (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j