Improve level generation speed

src/Dodge/LevelGen/StaticWalls.hs

@@ -6,11 +6,12 @@ module Dodge.LevelGen.StaticWalls
     where
 import Dodge.Data
 import Geometry
+import Geometry.ConvexPoly
 --import Geometry.Data
 import FoldableHelp
 
 --import Control.Lens
-import Data.List
+import Data.List.Extra
 import Data.Maybe
 import Data.Bifunctor
 -- | Describe a wall as two points.
@@ -119,26 +120,24 @@ checkWallLeft (x,y) wls
 -- Be aware that we do not remove all colinear walls; this may still cause bugs
 cutPoly :: [Point2] -> [WallP] -> [WallP]
 cutPoly qs wls = 
-    nub
+    nubOrd
     . removeInverseWalls
     . filter (not . wallIsZeroLength) 
     . fuseWallsWith zs
     . addPolyWalls rs  
---    . removeWallsInPolygon ps 
---    . filter (not.wallIsZeroLength) 
---    . fuseWallsWith zs
     $ removeWallsInPolygon ps 
      cwals
   where 
     (zs,cwals) = cutWallsWithPoints ps wls
     ps = orderPolygon qs
-    rs = orderPolygon $ nub $ zs ++ qs
+    rs = orderPolygon $ nubOrd $ zs ++ qs
 -- | 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 (+.+) (V2 0 0) ps
+    --cp = 1/fromIntegral (length ps) *.* foldl' (+.+) (V2 0 0) ps
+    cp = centroid ps
     f p = p +.+ x *.* (p -.- cp)
     --f p = p +.+ x *.* normalizeV (p -.- cp)
 -- | Given a polygon expressed as a list of points and a collection of walls,
@@ -146,10 +145,10 @@ expandPolyBy x ps = map f ps
 -- fst: points of the polygon's intersection with walls
 -- snd: the collection of walls after cutting by the polygon.
 cutWallsWithPoints :: [Point2] -> [WallP] -> ([Point2], [WallP] )
-cutWallsWithPoints (p:ps) ws = foldr f ([],ws) (zip (p:ps) (ps++[p]))
+cutWallsWithPoints (p:ps) ws = foldl' f ([],ws) (zip (p:ps) (ps++[p]))
   where 
-    f (p1,p2) (as,ws') = 
-        ( nub $ as ++ cutWallsPoints p1 p2 ws'
+    f (as,ws') (p1,p2) = 
+        ( nubOrd $ as ++ cutWallsPoints p1 p2 ws'
         , concatMap (cutWall p1 p2) ws'
         )
 cutWallsWithPoints _ _ = error "Trying to cut empty polygon"
@@ -167,7 +166,7 @@ addPolyWalls
     :: [Point2] -- ^ Multiple walls described as a polygon.
     -> [WallP] 
     -> [WallP]
-addPolyWalls (q:qs) wls = foldr addPolyWall wls (zip (q:qs) (qs++[q]))
+addPolyWalls (q:qs) wls = foldl' addPolyWall wls (zip (q:qs) (qs++[q]))
 addPolyWalls _ _ = error "Trying to add empty poly walls"
 -- | Add a new wall to a list of walls only if either
 -- 1. no wall already exists on the normal line from the new wall
@@ -175,8 +174,8 @@ addPolyWalls _ _ = error "Trying to add empty poly walls"
 -- face away from the new wall.
 -- The normal line is the line from the center point of the new wall outwards 
 -- along the clockwise normal of the new wall (currently 10000 units along)
-addPolyWall :: WallP -> [WallP] -> [WallP]
-addPolyWall (p1,p2) wls =
+addPolyWall :: [WallP] -> WallP -> [WallP]
+addPolyWall wls (p1,p2) =
     case maybeWs of 
         Just ws -> if uncurry isLHS ws p3
             then wls
@@ -213,9 +212,9 @@ fuseWall ps (x,y) = ( rs , (x',y') )
 -- | Given list of points and collection of walls, fuses the wall ends if
 -- they are close to the list of points or each other.
 fuseWallsWith :: [Point2] -> [WallP] -> [WallP]
-fuseWallsWith zs ws = snd $ foldr fuseWalls (zs, []) ws
+fuseWallsWith zs ws = snd $ foldl' fuseWalls (zs, []) ws
   where 
-    fuseWalls w (ps, ws') = 
+    fuseWalls (ps, ws') w = 
         let (qs, w') = fuseWall ps w
         in  (qs, w' :  ws')
 -- | Test if fst p == snd p.