Refactor level/room generation modules

src/Dodge/Layout.hs

@@ -1,23 +1,20 @@
-module Dodge.Layout where
+module Dodge.Layout 
+    ( module Dodge.Layout
+    , module Dodge.Layout.Tree
+    )
+    where
 -- imports {{{
 import Dodge.Data
-import Dodge.Weapons
-import Dodge.Critters
 import Dodge.LevelGen
 import Dodge.Base
 import Dodge.RandomHelp
-import Dodge.Prototypes
 import Dodge.Path
+import Dodge.Layout.Tree
 
 import Geometry
---
---import Graphics.Gloss
---import Graphics.Gloss.Data.Vector
---import Graphics.Gloss.Geometry.Line
---import Graphics.Gloss.Geometry.Angle
---
+
 import Control.Monad.State
---import Control.Monad.Loops
+
 import Control.Lens
 import System.Random
 
@@ -35,11 +32,10 @@ import Data.Graph.Inductive.NodeMap
 
 import qualified Data.IntMap.Strict as IM
 -- }}}
-
+-- connects a collection (tree) of rooms together
 generateFromTree :: State StdGen (Tree Room) -> World -> World
 generateFromTree t w = zoning $ placeSpots plmnts 
             $ w {_walls = wallsFromTree tr, _randGen = g
---                           ,_loadedSounds = lSounds
                            ,_pathGraph = path
                            ,_pathGraph' = pairGraph
                            ,_pathPoints = foldr insertPoint IM.empty (labNodes path) 
@@ -47,7 +43,6 @@ generateFromTree t w = zoning $ placeSpots plmnts
     where tr = evalState t $ _randGen w
           plmnts = concatMap _rmPS $ flatten tr
           g = _randGen w
---          lSounds = _loadedSounds w
           path = pairsToGraph dist pairGraph
           pairGraph = makePath tr
           insertPoint  pp@(_,(x,y)) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
@@ -66,8 +61,6 @@ makePath = concat . map _rmPath . flatten
 
 wallsFromTree :: Tree Room -> IM.IntMap Wall
 wallsFromTree t = createInnerWalls $ nubWalls $ divideWalls $ foldr cutWalls IM.empty (concatMap _rmPolys $ flatten t)
---wallsFromTree t = checkWalls $ nubWalls $ divideWalls $ foldr cutWalls IM.empty (concatMap _rmPolys $ flatten t)
---wallsFromTree t = divideWalls $ foldr cutWalls IM.empty (concatMap _rmPolys $ flatten t)
 
 divideWall :: Wall -> [Wall]
 divideWall wl
@@ -85,26 +78,11 @@ divideWallIn wl wls =
 
 divideWalls :: IM.IntMap Wall -> IM.IntMap Wall
 divideWalls wls = IM.foldr divideWallIn wls wls
-         
-collapseTree :: Tree (Tree (Either Room Room)) -> Tree (Either Room Room)
-collapseTree = g . expandTreeBy f
-    where f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
-          f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
-          g (Node (Right x) []) = Node (Right x) []
-          g (Node (Right x) xs) = Node (Left x) $ map g xs
-          g (Node y ys) = Node y $ map g ys
-
 
 insertInZone :: Int -> Int -> a -> IM.IntMap (IM.IntMap a) -> IM.IntMap (IM.IntMap a)
 insertInZone x y obj = IM.insertWith f x $ IM.singleton y obj
     where f _ = IM.insert y obj
 
-allPairs :: Eq a => [a] -> [(a,a)]
-allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
-
-treePost :: [a] -> a -> Tree a
-treePost []     y = Node y []
-treePost (x:xs) y = Node x [treePost xs y]
 
 randomiseLinks :: RandomGen g => Room -> State g (Tree (Either Room Room))
 randomiseLinks r = do
@@ -135,16 +113,9 @@ composeTreeWith f (Node x xs) = paste xs $ f x
     where paste xs (Node (Right y) _) = Node (Left y) (map (composeTreeWith f) xs)
           paste xs (Node (Left y) ys) = Node (Left y) (map (paste xs) ys)
 
-doPolysIntersect :: [Point2] -> [Point2] -> Bool
-doPolysIntersect (p:ps) (q:qs)
-    = any isJust $ (\(a,b) (c,d) -> intersectSegSeg' a b c d) <$> pair1s <*> pair2s
-    where pair1s = zip (p:ps) (ps++[p])
-          pair2s = zip (q:qs) (qs++[q])
-doPolysIntersect [] _  = False
-doPolysIntersect _  [] = False
-
+-- the old version of this used a version of polysIntersect with intersectSegSeg'
 boundClip :: Tree Room -> Bool
-boundClip t = or $ map (uncurry doPolysIntersect) [(x,y) | x<- xs, y<-xs, x>y]
+boundClip t = or $ map (uncurry polysIntersect) [(x,y) | x<- xs, y<-xs, x>y]
                     ++ map f [(ps,qs) | ps <- xs, qs <-xs, ps/=qs]
     where xs = map _rmBound $ flatten t
           f ([],qs) = False
@@ -186,4 +157,3 @@ shiftPSBy (pos,rot) ps = case ps of
                             $ over psRot (+rot)
                             ps
 
-