diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs
index 9106b3139..5b19c2617 100644
--- a/src/Dodge/Base.hs
+++ b/src/Dodge/Base.hs
@@ -125,6 +125,10 @@ mvPointToward !ep !p
     | dist p ep < 1 = ep
     | otherwise     = p +.+ normalizeV (ep -.- p)
 
+vecBetweenSpeed :: Float -> Point2 -> Point2 -> Point2
+vecBetweenSpeed s sp ep
+    | dist sp ep < s = ep -.- sp
+    | otherwise = s *.* normalizeV (ep -.- sp)
 
 sigmoid :: Floating a => a -> a
 sigmoid x = x/sqrt(1+x^(2::Int))
diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs
index 0add8af5e..20aff343b 100644
--- a/src/Dodge/Initialisation.hs
+++ b/src/Dodge/Initialisation.hs
@@ -41,5 +41,5 @@ initialWorld = defaultWorld
     }
 
 testStringInit :: World -> [String]
-testStringInit = map show . M.toList . _mouseButtons
+testStringInit = map (show . _drStatus) . IM.elems . _doors
 --testStringInit = const [] 
diff --git a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
index 5bec5cd73..17f91433d 100644
--- a/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
+++ b/src/Dodge/Placement/PlaceSpot/TriggerDoor.hs
@@ -75,18 +75,20 @@ doorMechanismStepwise nsteps drid wlids pss dr w
         newps = uncurry (rectanglePairs 9) (pss !! n)
 -- it is not at all clear that the zoning selects the correct walls
 
-doorMechanism :: [(Int,(Point2,Point2),(Point2,Point2))] -> Door -> World -> World
-doorMechanism wlidOpCps dr w 
-    | toOpen     && dstatus /= DoorOpen   = moveUpdate $ foldl' doOpen  w wlidOpCps
-        & doors . ix drid . drPos %~ mvPs speed (_drOpenPos dr)
-    | not toOpen && dstatus /= DoorClosed = moveUpdate $ foldl' doClose w wlidOpCps
-        & doors . ix drid . drPos %~ mvPs speed (_drClosePos dr)
-    | otherwise = w
+-- TODO sort out why DoorClosed status does not update correctly 22/06/23
+doorMechanism :: Door -> World -> World
+doorMechanism dr w = case mvDir of
+    Just d -> w
+        & flip (IS.foldr (`translateWallID` d)) (_drWallIDs dr)
+        & moveUpdate 
+        & doors . ix drid . drPos . each %~ (+.+ d)
+    Nothing -> w
   where
-    toOpen  = _drTrigger dr w
-    mvDir 
-        | toOpen && dist dpos dop > 1 = Just $ mvPointTowardAtSpeed speed dop dpos
-        | dist dpos dcp > 1 = Just $ mvPointTowardAtSpeed speed dcp dpos
+    toOpen = _drTrigger dr w
+    mvDir
+        | toOpen && _drStatus dr == DoorOpen = Nothing -- Not sure why necessary
+        | toOpen && dist dpos dop > 0.5 = Just $ vecBetweenSpeed speed dpos dop
+        | dist dpos dcp > 0.5           = Just $ vecBetweenSpeed speed dpos dcp
         | otherwise = Nothing
     speed = _drSpeed dr
     drid = _drID dr
@@ -99,9 +101,6 @@ doorMechanism wlidOpCps dr w
         | dist dpos dop < 1 = doors . ix drid . drStatus .~ DoorOpen
         | dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
         | otherwise                       = doors . ix drid . drStatus .~ DoorHalfway
-    dstatus = _drStatus dr
-    doOpen  w' (wlid,opp, _) = moveWallIDToward wlid speed opp w'
-    doClose w' (wlid,_ ,clp) = moveWallIDToward wlid speed clp w'
 
 -- TODO cut pathing if not pathable, reset when opened
 plSlideDoor 
@@ -123,7 +122,7 @@ plSlideDoor isPathable col cond shiftOffset a b speed gw
         , _drWallIDs = IS.fromList wlids
         , _drStatus = DoorClosed
         , _drTrigger = cond
-        , _drMech   = doorMechanism (zip3 wlids shiftedPairs pairs)
+        , _drMech   = doorMechanism
         , _drPos = (a,b)
         , _drOpenPos = (shiftLeft a,shiftLeft b)
         , _drClosePos = (a,b)
@@ -131,7 +130,6 @@ plSlideDoor isPathable col cond shiftOffset a b speed gw
         }
     addDoorWalls w' = foldl' (addDoorWall drid col isPathable) w' $ zip wlids pairs
     pairs = rectanglePairs 9 a b
-    shiftedPairs = map (bimap shiftLeft shiftLeft) pairs
     shiftLeft  = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
     wlids = take 4 [IM.newKey $ _walls gw ..]
 -- old code that may help with pathing