Tweak wall cutting, removes inverse walls

src/Dodge/LevelGen/StaticWalls.hs

@@ -7,22 +7,38 @@ module Dodge.LevelGen.StaticWalls
 import Dodge.Data
 import Dodge.Base
 import Dodge.Default
-
 import Geometry
 
 import Control.Lens
-
 import Data.Function (on)
-
 import Data.Graph
 import Data.List
 import Data.Maybe
 import qualified Data.IntMap as IM
-
 import qualified Data.Set as S
 
 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)
+    | elem (b,a) ps = removeInverseWalls $ delete (b,a) ps
+    | otherwise     = (a,b) : (removeInverseWalls ps)
+removeInverseWalls ps = ps
+
 -- | 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.