diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs
index e80e45f6d..26e3a6174 100644
--- a/src/Dodge/Layout.hs
+++ b/src/Dodge/Layout.hs
@@ -11,6 +11,7 @@ import Dodge.RandomHelp
 import Dodge.Path
 import Dodge.Layout.Tree
 import Dodge.Room.Data
+import Dodge.Default
 
 import Geometry
 
@@ -60,8 +61,19 @@ generateFromTree t w = zoning $ placeSpots plmnts
 makePath :: Tree Room -> [(Point2,Point2)]
 makePath = concat . map _rmPath . flatten
 
+-- consider nubbing walls after dividing them
 wallsFromTree :: Tree Room -> IM.IntMap Wall
-wallsFromTree t = createInnerWalls $ nubWalls $ divideWalls $ foldr cutWalls IM.empty (concatMap _rmPolys $ flatten t)
+wallsFromTree t = 
+    createInnerWalls 
+    . divideWalls 
+    . assignKeys 
+    . foldr cutWalls [] -- $ map (map (g . roundPoint2)) 
+    . map (map roundPoint2)
+    $ (concatMap _rmPolys $ flatten t)
+  where
+    assignKeys = IM.fromList . zip [0..] . zipWith f [0..]
+    f i (x,y) = defaultWall {_wlLine = [x,y] , _wlID = i}
+    g (x,y) = (x-3855,y - 2613)
 
 divideWall :: Wall -> [Wall]
 divideWall wl
diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs
index 259f581fb..05bdeecd6 100644
--- a/src/Dodge/LevelGen.hs
+++ b/src/Dodge/LevelGen.hs
@@ -4,8 +4,6 @@ module Dodge.LevelGen
     ( module Dodge.LevelGen
     , cutWalls
     , createInnerWalls
---    , checkWalls
-    , nubWalls
     , pairsToGraph
     , makeButton
     , makeSwitch
diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs
index 95f4010ac..e68aba06b 100644
--- a/src/Dodge/LevelGen/StaticWalls.hs
+++ b/src/Dodge/LevelGen/StaticWalls.hs
@@ -16,18 +16,45 @@ import qualified Data.IntMap as IM
 
 import qualified Data.Set as S
 
+type WallP = (Point2,Point2)
+
+-- the following checks one of the corners of cut walls at each step
+cutWalls :: [Point2] -> [WallP] -> [WallP]
+cutWalls ps wls = case mapMaybe (flip checkWallRight newWalls) newWalls of
+    [] -> newWalls
+    errs -> error $ "cutWalls: when cutting poly:\n" ++ show ps 
+        ++ "\nRight corner errors:\n"
+        ++ unlines (map show errs)
+        ++ "\nStart walls:\n"
+        ++ unlines (map show wls)
+        ++ "\nEnd walls:\n"
+        ++ unlines (map show newWalls)
+        ++ "\nLeft corner errors:\n"
+        ++ unlines (map show errsL)
+  where
+    newWalls = cutWalls' ps wls
+    errsL = mapMaybe (flip checkWallLeft newWalls) newWalls
+
+checkWallRight :: WallP -> [WallP] -> Maybe (WallP,[WallP])
+checkWallRight (x,y) wls = case filter (\(a,b) -> a == y ) wls of
+    [w] -> Nothing
+    wls -> Just ((x,y), wls)
+checkWallLeft :: WallP -> [WallP] -> Maybe (WallP,[WallP])
+checkWallLeft (x,y) wls = case filter (\(a,b) -> b == x ) wls of
+    [w] -> Nothing
+    wls -> Just ((x,y),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
-cutWalls' :: [Point2] -> IM.IntMap Wall -> IM.IntMap Wall
+cutWalls' :: [Point2] -> [WallP] -> [WallP]
 cutWalls' qs walls = 
-    nubWalls
-    . IM.filter (not.wallIsZeroLength) 
+    nub
+    . filter (not.wallIsZeroLength) 
     . fuseWallsWith zs
     . createPolyWalls rs  
-    . IM.filter (not.wallIsZeroLength) 
 --    . removeWallsInPolygon ps 
---    $ fuseWallsWith zs cwals
-    . fuseWallsWith zs
+--    . filter (not.wallIsZeroLength) 
+--    . fuseWallsWith zs
     $ removeWallsInPolygon ps 
      cwals
   where 
@@ -37,96 +64,66 @@ cutWalls' qs walls =
 -- the overall procedure is: 
 -- split walls that intersect with the polygon into two 
 --      (possibly three if the wall extends across the polygon)
--- fuse wall endpoints that end up close to each or to polygon intersection points
--- remove the created walls that are inside the polygon
--- also remove any walls that ended up zero length
+-- remove any created walls that are inside the polygon
 -- draw the required new walls along the polygon boundary
-
--- the following checks one of the corners of cut walls at each step
-cutWalls :: [Point2] -> IM.IntMap Wall -> IM.IntMap Wall
-cutWalls ps wls = case mapMaybe (flip checkWallRight newWalls) newWallsList of
-    [] -> newWalls
-    errs -> error $ "cutWalls: when cutting poly:\n" ++ show ps ++ "\nRight corner errors:\n"
-        ++ unlines (map (show . f) errs)
-        ++ "\nStart walls:\n"
-        ++ unlines (map (show . g) (IM.elems wls))
-        ++ "\nEnd walls:\n"
-        ++ unlines (map (show . g) (IM.elems newWalls))
-  where
-    newWalls = cutWalls' ps wls
-    newWallsList = IM.elems newWalls
-    g v = (_wlID v, _wlLine v)
-    f (v,vs) = (g v, map g vs)
-
-checkWallRight :: Wall -> IM.IntMap Wall -> Maybe (Wall,[Wall])
-checkWallRight wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsRight (_wlLine wl !! 0) wls of
-    [w] -> Nothing
-    wls -> Just (wl, wls)
-checkWallLeft :: Wall -> IM.IntMap Wall -> Maybe (Wall,[Wall])
-checkWallLeft wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsLeft (_wlLine wl !! 1) wls of
-    [w] -> Nothing
-    wls -> Just (wl,wls)
-
-createPolyWalls :: [Point2] -> IM.IntMap Wall -> IM.IntMap Wall
-createPolyWalls (q:qs) walls = foldr createPolyWall walls (zip (q:qs) (qs++[q]))
-
--- creates a wall if there is not already a wall on the clockwise normal to this wall
--- such that this existing wall faces towards the new wall
-createPolyWall :: (Point2, Point2) -> IM.IntMap Wall -> IM.IntMap Wall
-createPolyWall (p1,p2) walls = 
-    case maybeW of Just w -> if isLHS (_wlLine w !! 0) (_wlLine w !! 1) p3
-                                 then walls
-                                 else IM.insert k newWall walls
-                   Nothing -> IM.insert k newWall walls
-    where p3 = 0.5 *.* (p1 +.+ p2)
-          p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
-          maybeW = wallOnLine p3 p4 walls
-          k = newKey walls
-          newWall = defaultWall {_wlLine = [p1,p2], _wlID = k}
-
--- given a segment and a wall, adds a cut point to the wall if it intersects the
--- segment
-cutWall :: Point2 -> Point2 -> Wall -> Wall
-cutWall p1 p2 wall = case maybeCP of
-                            Nothing -> wall
-                            Just cp -> wall {_wlLine = [cp,w0,w1]}
-    where wl = _wlLine wall
-          w0 = wl !! 0
-          w1 = wl !! 1
-          maybeCP = intersectExtendedSegSeg p1 p2 w0 w1
-
--- intersects two segments, each extended by one unit in both directions
-intersectExtendedSegSeg p1 p2 a1 a2 = myIntersectSegSeg p1' p2' a1' a2'
-    where p1' = p1 +.+ normalizeV (p1 -.- p2)
-          p2' = p2 +.+ normalizeV (p2 -.- p1)
-          a1' = a1 +.+ normalizeV (a1 -.- a2)
-          a2' = a2 +.+ normalizeV (a2 -.- a1)
-
--- given a segment and a collection of walls, cuts each wall where it intersects
--- with the segment, adds the two cut walls
-addCutWalls :: Point2 -> Point2 -> IM.IntMap Wall -> IM.IntMap Wall
-addCutWalls p1 p2 ws = foldr addTwoWallsIfCut ws $ IM.map (cutWall p1 p2) ws
-    where addTwoWallsIfCut w ws 
-            = case _wlLine w of
-                (cp:w0:w1:[]) -> IM.insert (newKey ws) (w {_wlLine = [cp,w1]
-                                                          ,_wlID = newKey ws})
-                                    $ IM.insert (_wlID w) (w {_wlLine = [w0,cp]}) ws
-                (x:y:[]) -> ws
-
--- lists the points of intersection between a segment and collection of walls
-cutWallsPoints :: Point2 -> Point2 -> IM.IntMap Wall -> [Point2]
-cutWallsPoints p1 p2 ws = mapMaybe (\(x:y:_) -> intersectExtendedSegSeg p1 p2 x y)
-                                   $ map _wlLine $ IM.elems ws
+-- 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 polygon expressed as a list of points and a collection of walls,
 -- returns: fst: points of the polygon's intersection with walls
 --          snd: the collection of walls after cutting by the polygon
-cutWallsWithPoints :: [Point2] -> IM.IntMap Wall -> ([Point2], IM.IntMap Wall)
+cutWallsWithPoints :: [Point2] -> [WallP] -> ([Point2], [WallP] )
 cutWallsWithPoints (p:ps) ws = foldr f ([],ws) (zip (p:ps) (ps++[p]))
-    where f (p1,p2) (as,ws') = ( as ++ cutWallsPoints p1 p2 ws'
-                               , addCutWalls p1 p2 ws'
-                               )
+  where 
+    f (p1,p2) (as,ws') = 
+        ( as ++ cutWallsPoints p1 p2 ws'
+        , concatMap (cutWall p1 p2) ws'
+        )
 
+-- lists the points of intersection between a segment and collection of walls
+cutWallsPoints :: Point2 -> Point2 -> [WallP] -> [Point2]
+--cutWallsPoints p1 p2 ws = mapMaybe (\(x:y:_) -> intersectExtendedSegSeg p1 p2 x y)
+cutWallsPoints p1 p2 ws = mapMaybe (uncurry $ myIntersectSegSeg p1 p2) ws
+
+-- given a segment and a wall, adds a cut point to the wall if it intersects the
+-- segment
+cutWall :: Point2 -> Point2 -> WallP -> [WallP]
+cutWall p1 p2 (x,y) = case myIntersectSegSeg p1 p2 x y of
+    Nothing -> [(x,y)]
+    Just cp -> [(x,cp),(cp,y)]
+
+createPolyWalls :: [Point2] -> [WallP] -> [WallP]
+createPolyWalls (q:qs) walls = foldr createPolyWall walls (zip (q:qs) (qs++[q]))
+
+-- adds a wall if there is not already a wall on the clockwise normal to this wall
+-- such that this existing wall faces towards the new wall
+createPolyWall :: WallP -> [WallP] -> [WallP]
+createPolyWall (p1,p2) walls = 
+    case maybeW of Just (x,y) -> if isLHS x y p3
+                                 then walls
+                                 else (p1,p2) : walls
+                   Nothing -> ((p1,p2) : walls)
+  where 
+    p3 = 0.5 *.* (p1 +.+ p2)
+    p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
+    maybeW = listToMaybe 
+              . fst
+              . unzip
+              . sortBy (compare `on` (dist p3 . snd))
+              . catMaybes
+              $ zipWith f walls maybes
+    f a (Just b) = Just (a,b)
+    f _ Nothing  = Nothing
+    maybes = map (uncurry $ myIntersectSegSeg p3 p4) walls
+
+-- intersects two segments, each extended by one unit in both directions
+intersectExtendedSegSeg p1 p2 a1 a2 = myIntersectSegSeg p1' p2' a1' a2'
+  where 
+    p1' = p1 +.+ normalizeV (p1 -.- p2)
+    p2' = p2 +.+ normalizeV (p2 -.- p1)
+    a1' = a1 +.+ normalizeV (a1 -.- a2)
+    a2' = a2 +.+ normalizeV (a2 -.- a1)
 
 -- given a list of points and a point, returns a point in the list if any is close
 -- enough to the point
@@ -145,32 +142,24 @@ fusePoint ps p = fromMaybe p $ findClosePoint ps p
 -- given a list of points and wall, moves the wall to be on the points if it is
 -- close to any of the points
 -- if either wall point is not moved, this point gets added to the list
-fuseWall :: ([Point2], Wall) -> ([Point2], Wall)
-fuseWall (ps, w) = ( rs
-                   , w Control.Lens.& wlLine .~ [w0,w1]
-                   )
-    where qs = catMaybes [pointIfNotClose ps (_wlLine w !! 0)] ++ ps
-          rs = catMaybes [pointIfNotClose qs (_wlLine w !! 1)] ++ qs
-          w0 = fusePoint ps (_wlLine w !! 0)
-          w1 = fusePoint qs (_wlLine w !! 1)
+fuseWall :: ([Point2], WallP) -> ([Point2], WallP)
+fuseWall (ps, (x,y)) = ( nub (x':y':ps) , (x',y') )
+    where x' = fusePoint ps x
+          y' = fusePoint (x':ps) 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] -> IM.IntMap Wall -> IM.IntMap Wall
-fuseWallsWith zs ws = snd $ IM.foldr fuseWalls' (zs, IM.empty) ws
+fuseWallsWith :: [Point2] -> [WallP] -> [WallP]
+fuseWallsWith zs ws = snd $ foldr fuseWalls' (zs, []) ws
     where fuseWalls' w (ps, ws) = let (qs, w') = fuseWall (ps, w)
-                                  in  (qs, IM.insert (_wlID w') w' ws)
+                                  in  (qs, w' :  ws)
 
-wallIsZeroLength w = l !! 0 == l !! 1
-    where l = _wlLine w
+wallIsZeroLength (x,y) = x == y
 
-wallLengthGT x w = dist (l !! 0) (l !! 1) > x
-    where l = _wlLine w
-
-removeWallsInPolygon :: [Point2] -> IM.IntMap Wall -> IM.IntMap Wall
-removeWallsInPolygon ps walls = IM.filter (not . cond) walls
-    where cond wall = pointInsidePolygon (_wlLine wall !! 0) ps
-                        && pointInsidePolygon (_wlLine wall !! 1) ps
+removeWallsInPolygon :: [Point2] -> [WallP] -> [WallP]
+removeWallsInPolygon ps walls = filter (not . cond) walls
+    where cond wall = pointInsidePolygon (fst wall) ps
+                        && pointInsidePolygon (snd wall) ps
 
 pointInsidePolygon :: Point2 -> [Point2] -> Bool
 pointInsidePolygon p (x:xs) = all (\l -> not (uncurry isRHS l (p +.+ normalizeV s))) pairs
@@ -178,24 +167,8 @@ pointInsidePolygon p (x:xs) = all (\l -> not (uncurry isRHS l (p +.+ normalizeV
     where pairs = zip (x:xs) (xs ++ [x])
           s = ((1/fromIntegral (length (x:xs))) *.* (foldr1 (+.+) (x:xs)))
                 -.- p
-------------------------------------------------------
-finalFuse :: IM.IntMap Wall -> IM.IntMap Wall
-finalFuse = IM.filter (not.wallIsZeroLength) . fuseWallsWith []
-
-------------------------------------------------------
-
-nubWalls :: IM.IntMap Wall -> IM.IntMap Wall
-nubWalls wls = IM.fromList $ nubBy ((==) `on` _wlLine . snd) $ IM.assocs wls
-
---checkWalls' :: IM.IntMap Wall -> IM.IntMap Wall
---checkWalls' wls = case find (\wl -> dist (_wlLine wl !! 0) (_wlLine wl !! 1) < 1) wls of
---    Just wl -> error $ show $ _wlLine wl
---    _       -> wls
---
---checkWalls wls | (nub $ map _wlLine $ IM.elems wls)
---                   == (map _wlLine $ IM.elems wls) = wls
---               | otherwise = error "hasdup"
 
+------------------------------------------------------------------------------------
 -- idea: create inner walls to draw and to cast shadows
 createInnerWalls :: IM.IntMap Wall -> IM.IntMap Wall
 createInnerWalls wls = IM.map (createInnerWall wls) wls