Move inner wall creation

src/Dodge/Layout.hs

@@ -64,8 +64,8 @@ makePath = concat . map _rmPath . flatten
 -- consider nubbing walls after dividing them
 wallsFromTree :: Tree Room -> IM.IntMap Wall
 wallsFromTree t = 
-    createInnerWalls 
-    . divideWalls 
+--    createInnerWalls 
+    divideWalls 
     . assignKeys 
     . foldr cutWalls [] -- $ map (map (g . roundPoint2)) 
 --    . map (map roundPoint2)

src/Dodge/LevelGen.hs

@@ -3,7 +3,7 @@
 module Dodge.LevelGen 
     ( module Dodge.LevelGen
     , cutWalls
-    , createInnerWalls
+--    , createInnerWalls
     , pairsToGraph
     , makeButton
     , makeSwitch

src/Dodge/LevelGen/InnerWalls.hs

@@ -0,0 +1,46 @@
+module Dodge.LevelGen.InnerWalls
+  where
+import Dodge.Data
+import Dodge.Base
+
+import Geometry
+
+import Control.Lens
+import qualified Data.IntMap as IM
+
+------------------------------------------------------------------------------------
+-- idea: create inner walls to draw and to cast shadows
+createInnerWalls :: IM.IntMap Wall -> IM.IntMap Wall
+createInnerWalls wls = IM.map (createInnerWall wls) wls
+
+createInnerWall :: IM.IntMap Wall -> Wall -> Wall
+createInnerWall walls wl = wl & wlLine %~ \l -> l ++ [wlL,wlR]
+  where wl0 = _wlLine wl !! 0
+        wl1 = _wlLine wl !! 1
+        wlLeft = findWallLeft wl walls
+        wlRight = findWallRight wl walls
+        wlN = normalizeV $ vNormal $ wl1 -.- wl0
+        rN = normalizeV $ vNormal $ (_wlLine wlRight !! 1) -.- (_wlLine wlRight !! 0)
+        lN = normalizeV $ vNormal $ (_wlLine wlLeft  !! 1) -.- (_wlLine wlLeft  !! 0)
+        wlR = wl0 +.+ 20 *.* normalizeV (wlN +.+ rN)
+        wlL = wl1 +.+ 20 *.* normalizeV (wlN +.+ lN)
+
+findWallLeft :: Wall -> IM.IntMap Wall -> Wall
+findWallLeft wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsLeft (_wlLine wl !! 1) wls of
+    [w] -> w
+    wls   -> error $ "findWallLeft: " ++ show (map _wlID wls)
+                                                                 ++ " wlLines: "++ show (map _wlLine wls)
+
+findWallRight :: Wall -> IM.IntMap Wall -> Wall
+findWallRight wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsRight (_wlLine wl !! 0) wls of
+    [w] -> w
+    wls   -> error $ "findWallRight: wall with ID " ++ show (_wlID wl) ++ " and points " ++
+                    show (_wlLine wl) ++ "\nhas a right corner with and only with the walls "
+                    ++ show (map _wlID wls) ++ "\nwlLines "++ show (map _wlLine wls)
+                    ++ "\nUnless a wall has a corner with exactly one other wall, there is a problem"
+
+findWallsLeft :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
+findWallsLeft x wls = IM.filter (\wl -> dist x (_wlLine wl !! 0) < 1) wls
+
+findWallsRight :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
+findWallsRight x wls = IM.filter (\wl -> dist x (_wlLine wl !! 1) < 1) wls

src/Dodge/LevelGen/StaticWalls.hs

@@ -164,39 +164,3 @@ removeWallsInPolygon ps walls = filter (not . cond) walls
     cond wall = pointInsidePolygon (fst wall) ps
                         && pointInsidePolygon (snd wall) ps
 
-------------------------------------------------------------------------------------
--- idea: create inner walls to draw and to cast shadows
-createInnerWalls :: IM.IntMap Wall -> IM.IntMap Wall
-createInnerWalls wls = IM.map (createInnerWall wls) wls
-
-createInnerWall :: IM.IntMap Wall -> Wall -> Wall
-createInnerWall walls wl = wl & wlLine %~ \l -> l ++ [wlL,wlR]
-  where wl0 = _wlLine wl !! 0
-        wl1 = _wlLine wl !! 1
-        wlLeft = findWallLeft wl walls
-        wlRight = findWallRight wl walls
-        wlN = normalizeV $ vNormal $ wl1 -.- wl0
-        rN = normalizeV $ vNormal $ (_wlLine wlRight !! 1) -.- (_wlLine wlRight !! 0)
-        lN = normalizeV $ vNormal $ (_wlLine wlLeft  !! 1) -.- (_wlLine wlLeft  !! 0)
-        wlR = wl0 +.+ 20 *.* normalizeV (wlN +.+ rN)
-        wlL = wl1 +.+ 20 *.* normalizeV (wlN +.+ lN)
-
-findWallLeft :: Wall -> IM.IntMap Wall -> Wall
-findWallLeft wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsLeft (_wlLine wl !! 1) wls of
-    [w] -> w
-    wls   -> error $ "findWallLeft: " ++ show (map _wlID wls)
-                                                                 ++ " wlLines: "++ show (map _wlLine wls)
-
-findWallRight :: Wall -> IM.IntMap Wall -> Wall
-findWallRight wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsRight (_wlLine wl !! 0) wls of
-    [w] -> w
-    wls   -> error $ "findWallRight: wall with ID " ++ show (_wlID wl) ++ " and points " ++
-                    show (_wlLine wl) ++ "\nhas a right corner with and only with the walls "
-                    ++ show (map _wlID wls) ++ "\nwlLines "++ show (map _wlLine wls)
-                    ++ "\nUnless a wall has a corner with exactly one other wall, there is a problem"
-
-findWallsLeft :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
-findWallsLeft x wls = IM.filter (\wl -> dist x (_wlLine wl !! 0) < 1) wls
-
-findWallsRight :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
-findWallsRight x wls = IM.filter (\wl -> dist x (_wlLine wl !! 1) < 1) wls