diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index c8e7f952d..ed702f585 100644
--- a/src/Dodge/Floor.hs
+++ b/src/Dodge/Floor.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-unused-imports #-}
 {- |
 The tree of rooms that make up a level. -}
 module Dodge.Floor
@@ -49,27 +50,28 @@ initialRoomTree = do
     let t' = padCorridors struct
         t = treeFromTrunk 
             [[StartRoom]
+--            ,[Corridor]
+--            ,[Corridor]
+--            ,[SpecificRoom roomCCrits]
+--            ,[Corridor]
+--            ,[Corridor]
+--            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+--                & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
+--                            ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
+--                            ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
+--                            ]++)
+--             ]
+--            --,[Corridor]
+--            --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+--            --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
+--            -- ]
+--            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
+--                & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
+--             ]
             ,[Corridor]
             ,[Corridor]
-            ,[SpecificRoom roomCCrits]
-            ,[Corridor]
-            ,[Corridor]
-            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-                & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit armourChaseCrit 
-                            ,sPS (V2 50 25) 0 $ PutCrit armourChaseCrit 
-                            ,sPS (V2 50 0) 0 $ PutCrit armourChaseCrit 
-                            ]++)
-             ]
-            --,[Corridor]
-            --,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-            --    & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
-            -- ]
-            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-                & rmPS %~ ([sPS (V2 0 50) 0 $ PutCrit pistolCrit ]++)
-             ]
-            ,[Corridor]
-            ,[Corridor]
-            ,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30]
+            --,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30]
+            ,[SpecificRoom $ pure . Right <$> pure (twinSlowDoorRoom 30 80 200 40)]
             ,[Corridor]
             ,[DoorAno]
             ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50]
diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs
index b51eda76e..b7a0c742c 100644
--- a/src/Dodge/LevelGen.hs
+++ b/src/Dodge/LevelGen.hs
@@ -80,15 +80,19 @@ placeSpot ps w = case _psType ps of
     PutDoor col f pss -> putDoor col f (map (mapBoth $ shiftPointBy (p,rot)) pss) w
       where 
         mapBoth fn (x,y) = (fn x, fn y) 
-    PutDoubleDoor col f a b -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
-    PutSingleDoor col f a b -> putSingleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
+    PutDoubleDoor col f a b speed 
+        -> putDoubleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) speed w
+    PutSingleDoor col f a b speed 
+        -> putSingleDoor col f (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) speed w
     PutAutoDoor a b -> addAutoDoor (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
     PutBlock (hp:hps) col ps' -> putBlock (map (shiftPointBy (p,rot)) ps') hp col False hps w
     PutBlock{} -> error "messed up block placement somehow"
-    PutBtDoor c bp f a b -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot) 
-                            (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
-    PutSwitchDoor c bp f a b -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot) 
-                            (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
+    PutBtDoor c bp f a b speed 
+        -> addButtonDoor c (shiftPointBy (p,rot) bp) (f + rot) 
+                            (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) speed w
+    PutSwitchDoor c bp f a b speed 
+        -> addSwitchDoor c (shiftPointBy (p,rot) bp) (f + rot) 
+                            (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) speed w
     PutLineBlock wl width depth a b
         -> putLineBlock wl width depth (shiftPointBy (p,rot) a) (shiftPointBy (p,rot) b) w
     PutWall { _pwPoly = ps', _pwWall = wl } -> rmCrossPaths $ over walls (addWalls (q:qs) wl) w
diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs
index 48332cab3..db0b4f226 100644
--- a/src/Dodge/LevelGen/AutoDoor.hs
+++ b/src/Dodge/LevelGen/AutoDoor.hs
@@ -41,6 +41,6 @@ mkAutoDoor
     -> Point2   -- ^ Right point (though the two points should be symmetric)
     -> [Int]    -- ^ Wall ids
     -> [Wall]
-mkAutoDoor pl pr = mkDoubleDoor (dim yellow) True cond pl pr
+mkAutoDoor pl pr = mkDoubleDoor (dim yellow) True cond pl pr 3
   where
     cond = any (crNearSeg 40 pl pr) . IM.filter isAnimate . _creatures
diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs
index c6ee39126..b754cd024 100644
--- a/src/Dodge/LevelGen/Data.hs
+++ b/src/Dodge/LevelGen/Data.hs
@@ -33,11 +33,11 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutBlock [Int] Color [Point2]
     | PutLineBlock Wall Float Float Point2 Point2
     | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
-    | PutDoubleDoor Color (World -> Bool) Point2 Point2
-    | PutSingleDoor Color (World -> Bool) Point2 Point2
+    | PutDoubleDoor Color (World -> Bool) Point2 Point2 Float
+    | PutSingleDoor Color (World -> Bool) Point2 Point2 Float
     | PutDoor Color (World -> Bool) [(Point2,Point2)]
-    | PutBtDoor Color Point2 Float Point2 Point2
-    | PutSwitchDoor Color Point2 Float Point2 Point2
+    | PutBtDoor Color Point2 Float Point2 Point2 Float
+    | PutSwitchDoor Color Point2 Float Point2 Point2 Float
     | RandPS (State StdGen PSType)
     | PutForeground [Polyhedra]
     | PutNothing
diff --git a/src/Dodge/LevelGen/DoorPane.hs b/src/Dodge/LevelGen/DoorPane.hs
index c19c518f7..67d6e481f 100644
--- a/src/Dodge/LevelGen/DoorPane.hs
+++ b/src/Dodge/LevelGen/DoorPane.hs
@@ -9,17 +9,20 @@ import Picture
 import qualified DoubleStack as DS
 import Geometry.Vector
 
+import Data.Bifunctor
+
 -- | A door pane that moves linearly between open and closed positions using a
 -- boolean trigger.
 linearPane 
     :: Color 
     -> Bool             -- ^ Pathable flag
     -> (World -> Bool)  -- ^ Opening condition
+    -> Float            -- ^ speed
     -> Int              -- ^ Wall id
     -> (Point2,Point2)  -- ^ Closed position
     -> (Point2,Point2)  -- ^ Open position
     -> Wall
-linearPane c isPathable cond n closedPos openPos = Door
+linearPane c isPathable cond speed n closedPos openPos = Door
     { _wlLine = closedPos
     , _wlID = n
     , _doorMech = dm
@@ -31,34 +34,40 @@ linearPane c isPathable cond n closedPos openPos = Door
     }
   where 
     dm = doorMechan n (zoneps closedPos) openDoor closeDoor cond 
-    openDoor = moveDoorToward openPos
-    closeDoor = moveDoorToward closedPos
+    openDoor  = moveDoorToward speed openPos
+    closeDoor = moveDoorToward speed closedPos
 
-mkSingleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
-mkSingleDoor c isPathable cond pl hw is 
-    = addSoundToDoor (head is) pld hwd $ zipWith3 (linearPane c isPathable cond)
-    is
-    leftDoor
-    (map shiftLeft leftDoor)
+rectanglePairs :: Float -> Point2 -> Point2 -> [(Point2,Point2)]
+rectanglePairs wdth a b =
+    [ (aup, ad)
+    , (ad, bd)
+    , (bd, bu)
+    , (bu, aup)
+    ]
+  where
+    aup = a +.+ norm
+    ad = a -.- norm
+    bu = b +.+ norm
+    bd = b -.- norm
+    norm = wdth *.* normalizeV ( vNormal (b -.- a))
+
+mkSingleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> Float -> [Int] -> [Wall]
+mkSingleDoor c isPathable cond hingep hw speed is 
+    = addSoundToDoor (head is) pld hwd 
+    $ zipWith3 (linearPane c isPathable cond speed)
+        is
+        theDoor
+        (map (bimap shiftLeft shiftLeft) theDoor)
   where 
-    leftDoor = 
-        [ (pld +.+ perp,hwd)
-        , (hwd,         hwu)
-        , (hwu,         plu +.+ perp)
-        , (plu +.+ perp,pld +.+ perp)
-        ]
-    shiftLeft  = h (+.+ (pl -.- hw))
-    h func (x,y) = (func x,func y)
-    norm = 9 *.* normalizeV ( vNormal (hw -.- pl))
-    perp = 5 *.* normalizeV (pl -.- hw)
-    plu = pl +.+ norm
-    pld = pl -.- norm
-    hwu = hw +.+ norm
+    theDoor = rectanglePairs 9 hingep hw
+    shiftLeft  = (+.+ (hingep -.- hw))
+    norm = 9 *.* normalizeV ( vNormal (hw -.- hingep))
+    pld = hingep -.- norm
     hwd = hw -.- norm
 
-mkDoubleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
-mkDoubleDoor c isPathable cond pl pr is 
-    = addSoundToDoor (head is) pld hwd $ zipWith3 (linearPane c isPathable cond)
+mkDoubleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> Float -> [Int] -> [Wall]
+mkDoubleDoor c isPathable cond pl pr speed is 
+    = addSoundToDoor (head is) pld hwd $ zipWith3 (linearPane c isPathable cond speed)
     is
     (leftDoor ++ rightDoor)
     (map shiftLeft leftDoor ++ map shiftRight rightDoor)
diff --git a/src/Dodge/LevelGen/MoveDoor.hs b/src/Dodge/LevelGen/MoveDoor.hs
index b98af5362..408cb6515 100644
--- a/src/Dodge/LevelGen/MoveDoor.hs
+++ b/src/Dodge/LevelGen/MoveDoor.hs
@@ -24,9 +24,12 @@ 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
+moveDoorToward :: Float -> (Point2,Point2) -> Wall -> Wall
 {-# INLINE moveDoorToward #-}
-moveDoorToward (ex,ey) wls = wls & wlLine %~ mvPs (ex,ey)
+--moveDoorToward speed (ex,ey) wls = wls & wlLine %~ mvPs (ex,ey)
+moveDoorToward speed (ex,ey) wls = wls & wlLine %~ bimap (f ex) (f ey)
+  where
+    f !p = mvPointTowardAtSpeed speed p
 
 zoneps :: (Point2, Point2) -> [(Int,Int)]
 {-# INLINE zoneps #-}
diff --git a/src/Dodge/LevelGen/TriggerDoor.hs b/src/Dodge/LevelGen/TriggerDoor.hs
index 61954e927..950ae9b03 100644
--- a/src/Dodge/LevelGen/TriggerDoor.hs
+++ b/src/Dodge/LevelGen/TriggerDoor.hs
@@ -24,12 +24,13 @@ import Control.Lens
 import Data.Graph.Inductive hiding ((&))
 
 -- probably don't have to rebuild the entire graph, oh well
-addButtonDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> World -> World
-addButtonDoor c btp btr a b w = over buttons (IM.insert bid bt) 
+addButtonDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World -> World
+addButtonDoor c btp btr a b speed w 
+    = over buttons (IM.insert bid bt) 
     $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
     $ set pathGraph newGraph
     $ set pathGraph' newGraphPairs
-    $ putDoubleDoor c cond a b w
+    $ putDoubleDoor c cond a b speed w
   where 
     bid = IM.newKey $ _buttons w
     cond w' = BtNoLabel == _btState (_buttons w' IM.! bid)
@@ -42,12 +43,12 @@ addButtonDoor c btp btr a b w = over buttons (IM.insert bid bt)
              . over pathGraph (flip run_ $ insMapEdgesM $ map f removedPairs) $ w'
     f (x,y) = (x,y,dist x y)
 -- this has been repeated at least three times: TO BE UNIFIED, REFACTORED
-addSwitchDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> World -> World
-addSwitchDoor c btp btr a b w = over buttons (IM.insert bid bt) 
+addSwitchDoor :: Color -> Point2 -> Float -> Point2 -> Point2 -> Float -> World -> World
+addSwitchDoor c btp btr a b speed w = over buttons (IM.insert bid bt) 
     $ set pathPoints (foldr insertPoint IM.empty (labNodes newGraph))
     $ set pathGraph newGraph
     $ set pathGraph' newGraphPairs
-    $ putDoubleDoor c cond a b w
+    $ putDoubleDoor c cond a b speed w
   where 
     bid = IM.newKey $ _buttons w
     cond w' = BtOn == _btState (_buttons w' IM.! bid)
@@ -75,17 +76,17 @@ putDoor c cond pss = over walls triggerDoor
       where
         is = [IM.newKey wls..]
 
-putDoubleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> World -> World
-putDoubleDoor c cond a b = over walls triggerDoubleDoor
+putDoubleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World -> World
+putDoubleDoor c cond a b speed = over walls triggerDoubleDoor
   where
-    triggerDoubleDoor wls = IM.union wls $ IM.fromList $ zip is $ mkDoubleDoor c False cond a b is
+    triggerDoubleDoor wls = IM.union wls $ IM.fromList $ zip is $ mkDoubleDoor c False cond a b speed is
       where
         is = [IM.newKey wls..]
 
-putSingleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> World -> World
-putSingleDoor c cond a b = over walls putTheDoor
+putSingleDoor :: Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> World -> World
+putSingleDoor c cond a b speed = over walls putTheDoor
   where
-    putTheDoor wls = IM.union wls $ IM.fromList $ zip is $ mkSingleDoor c False cond a b is
+    putTheDoor wls = IM.union wls $ IM.fromList $ zip is $ mkSingleDoor c False cond a b speed is
       where
         is = [IM.newKey wls..]
 
diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs
index 0ef329b30..b3aef9625 100644
--- a/src/Dodge/Room/Airlock.hs
+++ b/src/Dodge/Room/Airlock.hs
@@ -23,8 +23,8 @@ airlockOneWay n = defaultRoom
     { _rmPolys = [rectNSWE 90 0 0 40]
     , _rmLinks = lnks
     , _rmPath  = []
-    , _rmPS    = [sPS (V2 0 15) 0 $ PutDoubleDoor col (not . cond) (V2 0 0) (V2 0 40)
-                 ,sPS (V2 0 75) 0 $ PutDoubleDoor col cond         (V2 0 0) (V2 0 40)
+    , _rmPS    = [sPS (V2 0 15) 0 $ PutDoubleDoor col (not . cond) (V2 0 0) (V2 0 40) 2
+                 ,sPS (V2 0 75) 0 $ PutDoubleDoor col cond         (V2 0 0) (V2 0 40) 2
                  ,sPS (V2 35 45) (pi/2) $ PutButton $ makeButton col (over worldState 
                                                                  (M.insert (DoorNumOpen n) True))
                  ]
@@ -60,8 +60,8 @@ airlock0 n = defaultRoom
                  ,(V2 20 45,V2 20  5)
                  ]
     , _rmPS    = 
-        [sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0)
-        ,sPS (V2 0 80) 0 $ PutDoubleDoor col cond         (V2 1 0) (V2 39 0)
+        [sPS (V2 0 20) 0 $ PutDoubleDoor col (not . cond) (V2 1 0) (V2 39 0) 2
+        ,sPS (V2 0 80) 0 $ PutDoubleDoor col cond         (V2 1 0) (V2 39 0) 2
         ,sPS (V2 35 50) (pi/2) $ PutButton $ makeSwitch col 
                            (over worldState (M.insert (DoorNumOpen n) True))
                            (over worldState (M.insert (DoorNumOpen n) False))
diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs
index 774009d17..0bb44995c 100644
--- a/src/Dodge/Room/LongDoor.hs
+++ b/src/Dodge/Room/LongDoor.hs
@@ -42,10 +42,11 @@ twinSlowDoorRoom drID w h x = defaultRoom
         [ sPS (V2 0 (h/2)) 0 putLamp
         , sPS (V2 25 5) 0 putLamp
         , sPS (V2 (negate 25) 5) 0 putLamp
-        , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2   x  1) (V2   x  h)
-        , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h)
-        , sPS (V2 0 (h-5)) pi $ PutButton $ makeButton col 
+        , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2   x  1) (V2   x  h) 1
+        , sPS (V2 0 0) 0 $ PutSingleDoor col cond (V2 (-x) 1) (V2 (-x) h) 1
+        , sPS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col 
             (over worldState (M.insert (DoorNumOpen drID) True))
+            (over worldState (M.insert (DoorNumOpen drID) False))
         ]
     , _rmBound  = ps
     , _rmName   = "twinSlowDoorRoom"
@@ -98,7 +99,7 @@ slowDoorRoom = do
      pillars <- takeOne [pillarsa, pillarsb, pillarsc]
      let cond x'  = (sndV2 . fst) x' > h + 40
          cond2 x' = (sndV2 . fst) x' < h - 40
-     but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h)
+     but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h) 2
                   --  ,PutSwitchDoor (dim $ light red) butPos butRot (0,h) (x,h)
                     ]
      fmap connectRoom 
diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs
index bfc398a10..421838f5e 100644
--- a/src/Dodge/Room/Procedural.hs
+++ b/src/Dodge/Room/Procedural.hs
@@ -245,7 +245,7 @@ centerVaultRoom n w h d = do
   where
     col = dim $ dim $ bright red
     theDoor i = 
-        [ sPS (V2 0  (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-19) 0) (V2 19 0)
+        [ sPS (V2 0  (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-19) 0) (V2 19 0) 2
         , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col 
                            (over worldState (M.insert (DoorNumOpen i) True))
                            (over worldState (M.insert (DoorNumOpen i) False))
diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs
index d3affd705..7578d2d27 100644
--- a/src/Geometry/Vector.hs
+++ b/src/Geometry/Vector.hs
@@ -41,6 +41,7 @@ a *.* V2 x2 y2 =
 normalizeV :: Point2 -> Point2
 {-# INLINE normalizeV #-}
 normalizeV p = (1 / magV p) *.* p
+
 {- | Angle between two vectors.  Always positive.  -}
 angleVV :: Point2 -> Point2 -> Float
 {-# INLINE angleVV #-}