Implement moving mounted lights

src/Dodge/Placement/Instance/Door.hs

@@ -16,16 +16,18 @@ import qualified Data.IntMap.Strict as IM
 
 putDoubleDoor :: Bool -> Color -> (World -> Bool)  -> Point2 -> Point2 -> Float -> Placement
 putDoubleDoor pathing col cond a b speed 
-    = putDoubleDoorThen pathing col cond a b speed (const $ const Nothing)
+    = putDoubleDoorThen pathing col cond 1 a b speed (const $ const Nothing)
 
 putDoubleDoorThen :: Bool -> Color -> (World -> Bool) 
-    -> Point2 -> Point2 -> Float 
+    -> Float -> Point2 -> Point2 -> Float 
     -> (Placement -> Placement -> Maybe Placement)
     -> Placement
-putDoubleDoorThen pathing col cond a b speed cont = pt0 (PutSlideDr pathing col cond a half speed)
-    $ \pl1 -> Just $ Placement (PS (V2 0 0) 0) ( PutSlideDr pathing col cond b half speed) Nothing 
+putDoubleDoorThen pathing col cond soff a b speed cont 
+    = doorbetween a half
+    $ \pl1 -> Just $ doorbetween b half
     $ \pl2 -> cont pl1 pl2
   where
+    doorbetween pa pb = pt0 $ PutSlideDr pathing col cond soff pa pb speed
     half = 0.5 *.* (a +.+ b)
 
 putAutoDoor :: Point2 -> Point2 -> Placement
@@ -39,8 +41,9 @@ putAutoDoor a b = PlacementUsingPos (addZ 0 a)
 
 switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
 switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeSwitch col red id id)
-    $ \btid -> jsps0J (PutSlideDr False col (cond btid) dra drc 2)
-    $          sps0   (PutSlideDr False col (cond btid) drb drc 2)
+    $ \btid -> jsps0J (doorbetween btid dra drc)
+    $          sps0   (doorbetween btid drb drc)
   where
+    doorbetween btid a b = PutSlideDr False col (cond btid) 1 a b 2
     drc = 0.5 *.* (dra +.+ drb)
     cond btid w' = _btState (_buttons w' IM.! btid) == BtOn