diff --git a/src/Dodge/LevelGen/MoveDoor.hs b/src/Dodge/LevelGen/MoveDoor.hs
new file mode 100644
index 000000000..c49ae5d86
--- /dev/null
+++ b/src/Dodge/LevelGen/MoveDoor.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE BangPatterns #-}
+module Dodge.LevelGen.MoveDoor
+    where
+import Dodge.Data
+import Dodge.Base
+import Geometry
+
+import qualified Data.IntMap.Strict as IM
+import Control.Lens
+-- This deserves a clean up
+mvP :: Point2 -> Point2 -> Point2
+{-# INLINE mvP #-}
+mvP !ep !p = mvPointTowardAtSpeed 2 ep p
+
+mvPs :: (Point2,Point2) -> (Point2,Point2) -> (Point2,Point2)
+{-# INLINE mvPs #-}
+mvPs !(!ex,!ey) !(!sx,!sy) = (mvP ex sx,mvP ey sy)
+
+moveDoorToward :: (Point2,Point2) -> Wall -> Wall
+{-# INLINE moveDoorToward #-}
+moveDoorToward (ex,ey) wls = wls & wlLine %~ mvPs (ex,ey)
+
+zoneps :: (Point2, Point2) -> [(Int,Int)]
+zoneps (a,b)
+    | dist a b <= 2 * zoneSize = [zoneOfPoint $ pHalf a b]
+    | otherwise = map zoneOfPoint $ divideLine (2*zoneSize) a b
+
+doorMechan 
+    :: Int
+    -> [(Int,Int)]
+    -> (Wall -> Wall) 
+    -> (Wall -> Wall) 
+    -> (World -> Bool) 
+    -> World 
+    -> World
+doorMechan n zonePs openEff closeEff cond w
+    | cond w = flip (foldr $ changeZonedWall'' openEff n) zonePs
+                $ over walls (IM.adjust openEff n) w
+    | otherwise = flip (foldr $ changeZonedWall'' closeEff n) zonePs
+                $ over walls (IM.adjust closeEff n) w
+
+changeZonedWall''
+    :: (Wall -> Wall)
+    -> Int
+    -> (Int,Int)
+    -> World
+    -> World
+changeZonedWall'' eff n (x,y) = over wallsZone $ adjustIMZone eff x y n