diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index e6f7b366c..60008b30a 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -36,41 +36,41 @@ lev1 = do ++ [return $ connectRoom corridor ,return $ connectRoom door ,glassSwitchBack >>= randomiseLinks] --- ++ [return $ connectRoom corridor --- ,return $ connectRoom door] --- ++ [miniRoom3] --- ++ [return $ connectRoom corridor --- ,return $ connectRoom door] --- ++ [roomCCrits] --- ++ [return $ connectRoom corridor --- ,return $ connectRoom door] --- ++[roomMiniIntro] --- ++ [longRoom >>= randomiseLinks] --- ++ [return $ connectRoom corridor --- ,return $ connectRoom door] + ++ [return $ connectRoom corridor + ,return $ connectRoom door] + ++ [miniRoom3] + ++ [return $ connectRoom corridor + ,return $ connectRoom door] + ++ [roomCCrits] + ++ [return $ connectRoom corridor + ,return $ connectRoom door] + ++[roomMiniIntro] + ++ [longRoom >>= randomiseLinks] + ++ [return $ connectRoom corridor + ,return $ connectRoom door] ++ firstWeapon --- ++ [return $ connectRoom corridor --- ,return $ connectRoom door] --- ++ [randomiseLinks =<< pistolerRoom] --- ++ [return $ connectRoom door] --- ++ [randomiseLinks =<< shooterRoom] --- ++ (replicate 3 $ randomiseLinks corridor) --- ++ [return $ connectRoom (set rmPS [PS (20,40) 0 basicLS] corridor)] --- ++ [return $ connectRoom corridor] --- ++ (replicate 3 $ randomiseLinks corridor) --- ++ [return $ connectRoom corridor] --- ++[return $ connectRoom corridor,return $ connectRoom door] --- ++ [shootingRange] --- ++ (replicate 3 $ randomiseLinks corridor) --- ++[roomMiniIntro] --- ++ (replicate 3 $ randomiseLinks corridor) --- ++ [return $ connectRoom corridor --- ,return $ connectRoom door --- ,slowDoorRoom] --- ++ [return $ connectRoom corridor --- ,spawnerRoom --- ,return $ connectRoom corridor --- ] + ++ [return $ connectRoom corridor + ,return $ connectRoom door] + ++ [randomiseLinks =<< pistolerRoom] + ++ [return $ connectRoom door] + ++ [randomiseLinks =<< shooterRoom] + ++ (replicate 3 $ randomiseLinks corridor) + ++ [return $ connectRoom (set rmPS [PS (20,40) 0 basicLS] corridor)] + ++ [return $ connectRoom corridor] + ++ (replicate 3 $ randomiseLinks corridor) + ++ [return $ connectRoom corridor] + ++[return $ connectRoom corridor,return $ connectRoom door] + ++ [shootingRange] + ++ (replicate 3 $ randomiseLinks corridor) + ++[roomMiniIntro] + ++ (replicate 3 $ randomiseLinks corridor) + ++ [return $ connectRoom corridor + ,return $ connectRoom door + ,slowDoorRoom] + ++ [return $ connectRoom corridor + ,spawnerRoom + ,return $ connectRoom corridor + ] ) $ randomiseLinks corridor diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index 438fe4aa7..e689693d3 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/src/Dodge/LevelGen/StaticWalls.hs @@ -25,8 +25,20 @@ type WallP = (Point2,Point2) -- | Cut out a polygon from a set of walls, and check for errors in the -- created walls. +-- If created walls are not consistent, expand poly and retry. cutWalls :: [Point2] -> [WallP] -> [WallP] cutWalls ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of + [] -> newWalls + _ -> cutWalls (expandPolyBy 0.01 ps) wls + where + newWalls = cutWalls' ps wls + errsL = mapMaybe (flip checkWallLeft newWalls) newWalls + +-- | Cut out a polygon from a set of walls, and check for errors in the +-- created walls. +-- Give error if created walls are not consistent. +cutWalls'' :: [Point2] -> [WallP] -> [WallP] +cutWalls'' ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of [] -> newWalls errs -> error $ "during level generation function cutWalls: when cutting poly:\n" ++ show ps ++ "\nRight corner errors:\n" @@ -73,13 +85,16 @@ checkWallLeft (x,y) wls -- (possibly three if the wall extends across the polygon), -- 2. remove any created walls that are inside the polygon, -- 3. create the required new walls along the polygon boundary. +-- 4. fuse wall endpoints that end up close to each or to polygon intersection points +-- 5. remove any walls that ended up zero length after fusing +-- 6. remove any duplicate walls -- Unclear behaviour if a line in the polygon is colinear with a wall. cutWalls' :: [Point2] -> [WallP] -> [WallP] cutWalls' qs walls = --- nub --- . filter (not.wallIsZeroLength) --- . fuseWallsWith zs - addPolyWalls rs + nub + . filter (not.wallIsZeroLength) + . fuseWallsWith zs + . addPolyWalls rs -- . removeWallsInPolygon ps -- . filter (not.wallIsZeroLength) -- . fuseWallsWith zs @@ -89,10 +104,14 @@ cutWalls' qs walls = (zs,cwals) = cutWallsWithPoints ps walls ps = orderPolygon qs rs = orderPolygon $ nub $ zs ++ qs --- unused steps: --- fuse wall endpoints that end up close to each or to polygon intersection points --- remove any walls that ended up zero length after fusing --- remove any duplicate walls + +-- | Given a value and a poly, pushes the poly points out from the center by the +-- value amount. +expandPolyBy :: Float -> [Point2] -> [Point2] +expandPolyBy x ps = map f ps + where + cp = (1/(fromIntegral (length ps))) *.* (foldr (+.+) (0,0) ps) + f p = p +.+ x *.* (p -.- cp) -- | Given a polygon expressed as a list of points and a collection of walls, -- returns: diff --git a/test/Spec.hs b/test/Spec.hs index 1344baae1..e6231f44e 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -41,7 +41,7 @@ shrinkTris (x:xs) = xs : map (x :) (shrinkTris xs) genTri = zip <$> trip <*> trip where - trip = vectorOf 3 $ fmap fromIntegral $ choose (0,5::Int) + trip = vectorOf 3 $ fmap fromIntegral $ choose (0,3::Int) genTris = listOf genTri @@ -49,9 +49,5 @@ genTris = listOf genTri --extractLoops [] = [] --extractLoops (x:xs) = ---[[(4.0,10.0),(6.0,2.0),(3.0,0.0)],[(9.0,3.0),(2.0,5.0),(0.0,6.0)]] -- ---[[(314.0,-396.0),(0.0,-223.71985),(-239.32773,357.25983)],[(0.0,0.0),(-84.0,-177.0),(237.0,-355.5366)]] --- --- ---[[(5.0,2.0),(3.0,5.0),(1.0,2.0)],[(3.0,2.0),(2.0,0.0),(4.0,0.0)],[(5.0,1.0),(3.0,0.0),(3.0,1.0)]] +--[[(0.0,1.0),(3.0,4.0),(5.0,5.0)],[(2.0,0.0),(2.0,4.0),(1.0,1.0)],[(5.0,5.0),(2.0,2.0),(1.0,3.0)]]