Tweak wall cutting, removes inverse walls

src/Dodge/Room/Procedural.hs

@@ -1,12 +1,19 @@
+{-
+Procedural creation of rooms.
+-}
 module Dodge.Room.Procedural
-  where
+    ( roomRect
+    , roomRectAutoLinks
+    , testRoom
+    ) where
 import Dodge.Room.Data
 import Dodge.Room.Placement
+import Dodge.Room.Link
 import Dodge.LevelGen
 import Dodge.LevelGen.Data
 import Geometry
 
-import Data.List (nub,sortBy)
+import Data.List (nub,nubBy,sortBy)
 import Data.Function (on)
 --import Control.Monad.State
 --import System.Random
@@ -14,13 +21,13 @@ import Data.Function (on)
 A simple rectangular room with a light in the center.
 Creates links and pathfinding graph.
  -}
-roomRect'
+roomRect
     :: Float    -- ^ Width
     -> Float    -- ^ Height
     -> Int      -- ^ Number of links on vertical walls
     -> Int      -- ^ Number of links on horizontal walls
     -> Room
-roomRect' x y xn yn = Room
+roomRect x y xn yn = Room
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmPath  = concatMap doublePair pth
@@ -36,9 +43,11 @@ roomRect' x y xn yn = Room
     slnks = flip zip (repeat (   pi)) $ translateS (20,0) $ gridPoints xd (xn+1)  0  1
     lnks = nlnks ++ elnks ++ wlnks ++ slnks
     pth  = linksAndPath lnks $ translateS (20,20) (makeGrid xd xn yd yn)
-
+{-
+Creates a rectangular room, automatically creates links and pathfinding graph at a sensible size.
+-}
 roomRectAutoLinks :: Float -> Float -> Room
-roomRectAutoLinks x y = roomRect' x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
+roomRectAutoLinks x y = roomRect x y ((ceiling x - 40) `div` 60) ((ceiling y - 40) `div` 60)
 
 makeGrid :: Float -> Int -> Float -> Int -> [(Point2,Point2)]
 makeGrid x nx y ny = nub $ concatMap doublePair 
@@ -61,3 +70,33 @@ linksAndPath :: [(Point2,Float)] -> [(Point2,Point2)] -> [(Point2,Point2)]
 linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks
     where linkClosest (p,_) = doublePair (p, head $ sortBy (compare `on` dist p) $ map fst subpth)
 
+{- Combines two rooms into one room.
+Combines into one big bound, concatenates the rest.
+-}
+combineRooms :: Room -> Room -> Room
+combineRooms r r' = Room
+    { _rmPolys = _rmPolys r ++ _rmPolys r'
+    , _rmLinks = _rmLinks r ++ _rmLinks r'
+    , _rmPath  = _rmPath  r ++ _rmPath  r'
+    , _rmPS    = _rmPS    r ++ _rmPS    r'
+    , _rmBound = convexHull . nubBy (\a b -> dist a b < 5) $ _rmBound r ++ _rmBound r'
+    }
+
+northSegment :: Room
+northSegment = Room
+    { _rmPolys  = [ [(0,0),(200,200),(-200,200)] ]
+    , _rmLinks  = [((0,200), 0)]
+    , _rmPath   = [((0,200),(0,0)),((0,0),(0,200))]
+    , _rmPS     = [PS (0,100) 0 putLamp]
+    , _rmBound  = [(200,200),(-200,200)]
+    --, _rmBound  = []
+    }
+
+testRoom :: Room
+testRoom = foldr1 combineRooms $ map (\a -> shiftRoomBy ((0,0),a) northSegment) [0,pi/2,pi,3*pi/2]
+
+---- -- -{- Combines multiple rooms into one room.
+---- -- -Combines into one big poly and one big bound, and concatenates the rest.
+---- -- --}
+---- -- -combineRooms :: [Room] -> Room
+---- -- -combineRooms rs = foldr f