Add ngon rooms

src/Dodge/Room/Room.hs

@@ -24,6 +24,7 @@ import Control.Lens
 import Control.Monad.State
 import Control.Monad.Loops
 import System.Random
+import Data.Maybe
 import Data.Tree
 import Data.Bifunctor
 
@@ -208,7 +209,7 @@ roomOctogon = defaultRoom
     { _rmPolys = [poly ]
     , _rmLinks = lnks
     , _rmPath  = allPairs $ map fst lnks -- this is too much
-    , _rmPmnts    = []
+    , _rmPmnts = []
     , _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
     , _rmFloor = [makeTileFromPoly poly 7]
     }
@@ -225,6 +226,25 @@ roomOctogon = defaultRoom
         ,( (0,40),pi)
         ]
 
+roomNgon :: Int -> Room
+roomNgon n = defaultRoom
+    { _rmPolys = [poly]
+    , _rmLinks = lnks
+    , _rmPath  = [] -- TODO
+    , _rmPmnts = []
+    , _rmBound = [poly]
+    , _rmFloor = [makeTileFromPoly poly 9]
+    }
+  where 
+    rot = 2*pi / fromIntegral n
+    rots = map ((rot *) . fromIntegral) [0..n-1]
+    poly = mapMaybe 
+        (\(ra,rb) -> intersectLineLine' (rotateV ra bl) (rotateV ra br) (rotateV rb bl) (rotateV rb br)) 
+        $ loopPairs rots
+    bl = V2   100  100
+    br = V2 (-100) 100
+    lnks = map (\r -> (rotateV r (V2 0 100),r)) rots
+
 allPairs :: Eq a => [a] -> [(a,a)]
 allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
 

src/Dodge/Room/Start.hs

@@ -48,12 +48,12 @@ minigunfakeout = do
         `treeFromPost` Right door
 
 centralLasTurret :: Room
-centralLasTurret = roomOctogon
+centralLasTurret = roomNgon 8
 
 rezThenLasTurret :: RandomGen g => State g (Tree (Either Room Room))
 rezThenLasTurret = do
     rbox <- rezBoxStart 
-    return $ rbox `appendEitherTree` [return $ Right roomOctogon]
+    return $ rbox `appendEitherTree` [return $ Right centralLasTurret]
 
 startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = join $ takeOne 

src/Geometry.hs

@@ -462,9 +462,9 @@ chainPairs xs = zip xs $ tail xs
 
 -- | Given a list of points, returns pairs of points linking the points into a
 -- loop.
-loopPairs :: [Point2] -> [(Point2,Point2)]
-loopPairs [] = error "tried to make loop with empty list of points"
-loopPairs [_] = error "tried to make loop with singleton list of points"
+loopPairs :: [a] -> [(a,a)]
+loopPairs [] = error "tried to make loop with empty list of elements"
+loopPairs [_] = error "tried to make loop with singleton list of elements"
 loopPairs (x:xs) = zip (x:xs) (xs ++ [x])
 -- | Test whether a point is in a cone.
 -- Note the pair is ordered.