Add ngon rooms
This commit is contained in:
+21
-1
@@ -24,6 +24,7 @@ import Control.Lens
|
|||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Loops
|
import Control.Monad.Loops
|
||||||
import System.Random
|
import System.Random
|
||||||
|
import Data.Maybe
|
||||||
import Data.Tree
|
import Data.Tree
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
|
|
||||||
@@ -208,7 +209,7 @@ roomOctogon = defaultRoom
|
|||||||
{ _rmPolys = [poly ]
|
{ _rmPolys = [poly ]
|
||||||
, _rmLinks = lnks
|
, _rmLinks = lnks
|
||||||
, _rmPath = allPairs $ map fst lnks -- this is too much
|
, _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)] ]
|
, _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
|
||||||
, _rmFloor = [makeTileFromPoly poly 7]
|
, _rmFloor = [makeTileFromPoly poly 7]
|
||||||
}
|
}
|
||||||
@@ -225,6 +226,25 @@ roomOctogon = defaultRoom
|
|||||||
,( (0,40),pi)
|
,( (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 :: Eq a => [a] -> [(a,a)]
|
||||||
allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
|
allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
|
||||||
|
|
||||||
|
|||||||
@@ -48,12 +48,12 @@ minigunfakeout = do
|
|||||||
`treeFromPost` Right door
|
`treeFromPost` Right door
|
||||||
|
|
||||||
centralLasTurret :: Room
|
centralLasTurret :: Room
|
||||||
centralLasTurret = roomOctogon
|
centralLasTurret = roomNgon 8
|
||||||
|
|
||||||
rezThenLasTurret :: RandomGen g => State g (Tree (Either Room Room))
|
rezThenLasTurret :: RandomGen g => State g (Tree (Either Room Room))
|
||||||
rezThenLasTurret = do
|
rezThenLasTurret = do
|
||||||
rbox <- rezBoxStart
|
rbox <- rezBoxStart
|
||||||
return $ rbox `appendEitherTree` [return $ Right roomOctogon]
|
return $ rbox `appendEitherTree` [return $ Right centralLasTurret]
|
||||||
|
|
||||||
startRoom :: RandomGen g => State g (Tree (Either Room Room))
|
startRoom :: RandomGen g => State g (Tree (Either Room Room))
|
||||||
startRoom = join $ takeOne
|
startRoom = join $ takeOne
|
||||||
|
|||||||
+3
-3
@@ -462,9 +462,9 @@ chainPairs xs = zip xs $ tail xs
|
|||||||
|
|
||||||
-- | Given a list of points, returns pairs of points linking the points into a
|
-- | Given a list of points, returns pairs of points linking the points into a
|
||||||
-- loop.
|
-- loop.
|
||||||
loopPairs :: [Point2] -> [(Point2,Point2)]
|
loopPairs :: [a] -> [(a,a)]
|
||||||
loopPairs [] = error "tried to make loop with empty list of points"
|
loopPairs [] = error "tried to make loop with empty list of elements"
|
||||||
loopPairs [_] = error "tried to make loop with singleton list of points"
|
loopPairs [_] = error "tried to make loop with singleton list of elements"
|
||||||
loopPairs (x:xs) = zip (x:xs) (xs ++ [x])
|
loopPairs (x:xs) = zip (x:xs) (xs ++ [x])
|
||||||
-- | Test whether a point is in a cone.
|
-- | Test whether a point is in a cone.
|
||||||
-- Note the pair is ordered.
|
-- Note the pair is ordered.
|
||||||
|
|||||||
Reference in New Issue
Block a user