Cleanup

2021-10-31 16:51:54 +00:00
parent e3a8417f07
commit 3efdb9e4f8
5 changed files with 28 additions and 87 deletions
@@ -1,4 +1,7 @@
 module Dodge.LevelGen.Pathing
+    ( removePathsCrossing
+    , pairsToGraph
+    )
    where
 import Dodge.Data
 import Dodge.Base
@@ -19,10 +22,11 @@ pairsToGraph f pairs =
    in undir $ run_ Data.Graph.Inductive.empty $ insMapNodesM nodes' >> insMapEdgesM pairs'

 removePathsCrossing :: Point2 -> Point2 -> World -> World
-removePathsCrossing a b w = set pathGraph newGraph $ set pathGraphP pg'
-    $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
-    w
+removePathsCrossing a b w = w
+    & pathGraph  .~ newGraph 
+    & pathGraphP .~ pg'
+    & pathPoints .~ (foldr insertPoint IM.empty (labNodes newGraph))
  where 
    pg' = filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
-    insertPoint  pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
+    insertPoint pp@(_,V2 x y) = insertInZoneWith (floorHun x) (floorHun y) (++) [pp]
    newGraph = pairsToGraph dist pg'
@@ -3,6 +3,11 @@ Module      : Dodge.LevelGen.StaticWalls
 Description : Concerns carving out of static walls to create the general room plan of the level.
 -}
 module Dodge.LevelGen.StaticWalls 
+    ( cutWalls
+    , removeInverseWalls
+    , expandPolyByFixed
+    , cutPoly
+    )
    where
 import Geometry
 import Geometry.ConvexPoly
@@ -14,17 +19,6 @@ import Data.Maybe
 -- Order is important: the wall face is to the left of the line going from 
 -- 'fst' to 'snd'.
 type WallP = (Point2,Point2)
-- | Test whether lines are near parallel.
-- Assumes non-zero length lines.
-nearParallel :: WallP -> WallP -> Bool
-nearParallel (a,b) (x,y)
-    = dotV (a -.- b) (vNormal (x -.- y)) < 0.01
-- | Test for near collinearity.
-- Assumes non-zero length lines.
-nearCollinear :: WallP -> WallP -> Bool
-nearCollinear (a,b) (x,y)
-    | a /= x = nearParallel (a,b) (x,y) && nearParallel (a,b) (a,x)
-    | otherwise = nearParallel (a,b) (x,y) && nearParallel (a,b) (a,y)
 -- | Remove inverse walls.
 removeInverseWalls :: [WallP] -> [WallP]
 removeInverseWalls ((a,b):ps)
@@ -50,24 +44,6 @@ cutWallsRetry i ps wls = case mapMaybe (`checkWallRight` newWalls) newWalls of
    x = fromIntegral i / 100
    a | even i    = 0.001
      | otherwise = negate 0.001
-- | 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 (`checkWallRight` newWalls) newWalls of
-    [] -> newWalls
-    errs -> error $ "during level generation function cutWalls: when cutting poly:\n" ++ show ps 
-        ++ "\nRight corner errors:\n"
-        ++ unlines (map show errs)
-        ++ "\nLeft corner errors:\n"
-        ++ unlines (map show errsL)
-        ++ "\nWalls before cut:\n"
-        ++ unlines (map show wls)
-        ++ "\nWalls after cut:\n"
-        ++ unlines (map show newWalls)
-  where
-    newWalls = cutPoly ps wls
-    errsL = mapMaybe (`checkWallLeft` newWalls) newWalls
 -- | Given a specific wall and list of walls, checks that the number of walls leaving the
 -- second point is the same as the number of walls entering the second point of
 -- the specific wall.
@@ -80,18 +56,6 @@ checkWallRight (x,y) wls
  where
    ins     = filter (\(_,b) -> b == y) wls
    outs    = filter (\(a,_) -> a == y) wls
-- | Given a specific wall and list of walls, checks that the number of walls leaving the
-- first point is the same as the number of walls entering the first point of
-- the specific wall.
-- On success returns Nothing, on failure returns Just the specific wall and the
-- list of walls leaving the first point.
-checkWallLeft :: WallP -> [WallP] -> Maybe (WallP,[WallP])
-checkWallLeft (x,y) wls
-    | length ins == length outs = Nothing
-    | otherwise                 = Just ((x,y), outs)
-  where
-    ins     = filter (\(a,_) -> a == x) wls
-    outs    = filter (\(_,b) -> b == x) wls
 -- | Given a polygon of points and collection of walls, cuts out the polygon.
 -- Ie returns a new set of walls with a hole determined by anticlockwise ordering of the points.
 -- The overall procedure is: 
@@ -109,8 +73,7 @@ checkWallLeft (x,y) wls
 -- collided with
 -- Be aware that we do not remove all colinear walls; this may still cause bugs
 cutPoly :: [Point2] -> [WallP] -> [WallP]
-cutPoly qs wls = 
-    nubOrd
+cutPoly qs wls = nubOrd
    . removeInverseWalls
    . filter (not . wallIsZeroLength) 
    . fuseWallsWith zs
@@ -126,15 +89,13 @@ cutPoly qs wls =
 expandPolyBy :: Float -> [Point2] -> [Point2]
 expandPolyBy x ps = map f ps
  where
-    cp = centroid ps
-    f p = p +.+ x *.* (p -.- cp)
+    f p = p +.+ x *.* (p -.- centroid ps)
 -- | Given a value and a poly, pushes the poly points out from the center by the
 -- fixed amount.
 expandPolyByFixed :: Float -> [Point2] -> [Point2]
 expandPolyByFixed x ps = map f ps
  where
-    cp = centroid ps
-    f p = p +.+ x *.* safeNormalizeV (p -.- cp)
+    f p = p +.+ x *.* safeNormalizeV (p -.- centroid ps)
 -- | Given a polygon expressed as a list of points and a collection of walls,
 -- returns: 
 -- fst: points of the polygon's intersection with walls
@@ -184,12 +145,6 @@ addPolyWall wls (p1,p2) =
 -- to the point.
 findClosePoint :: [Point2] -> Point2 -> Maybe Point2
 findClosePoint ps p = find (\q -> dist p q < 5) ps
-- | Given a list of points and a point, returns the point if none in the list
-- is close to the point.
-pointIfNotClose :: [Point2] -> Point2 -> Maybe Point2
-pointIfNotClose ps p = case findClosePoint ps p of
-    Nothing -> Just p
-    _       -> Nothing
 -- | Fuses a point with one in a list if any are close enough.
 fusePoint :: [Point2] -> Point2 -> ([Point2],Point2)
 fusePoint ps p = case findClosePoint ps p of
@@ -219,17 +174,3 @@ removeWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
 removeWallsInPolygon ps = filter (not . cond)
  where 
    cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
-
-----------------------DEBUG CODE:
-- | Given a polygon and list of walls, finds walls inside the polygon.
-findWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
-findWallsInPolygon ps = filter cond
-  where 
-    cond wall = pointInOrOnPolygon (0.5 *.* uncurry (+.+) wall) ps
-
-expandToSquare :: (Point2,Point2) -> [(Point2,Point2)]
-expandToSquare (a,b) = [(a,b),(b,c),(c,d),(d,a)]
-  where
-    v = a -.- b
-    c = b +.+ vNormal v
-    d = a +.+ vNormal v
@@ -1,5 +1,7 @@
 module Dodge.LevelGen.Switch
-    where
+    ( makeSwitch
+    , makeButton
+    ) where
 import Dodge.Data
 import Dodge.Default
 import Dodge.Data.SoundOrigin
@@ -75,4 +77,3 @@ makeSwitch col1 col2 effOn effOff = Button
        { _btState = BtOff
        , _btText = "SWITCH/"
        }
-