Improve doors

src/Dodge/Placement/Instance/Door.hs

@@ -14,75 +14,53 @@ import Dodge.LevelGen.PlacementHelper
 import Geometry
 import Linear
 
-putDoubleDoor :: Wall -> WdBl -> Point2 -> Point2 -> Float -> Placement
-putDoubleDoor wl cond a b speed =
-    putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
+putDoubleDoor :: Wall -> Point2 -> Point2 -> Door -> Placement
+putDoubleDoor wl a b dr =
+    putDoubleDoorThen wl 1 a b dr (const $ const Nothing)
 
 putDoubleDoorThen ::
     Wall ->
-    WdBl ->
     Float ->
     Point2 ->
     Point2 ->
-    Float ->
+    Door ->
     (Placement -> Placement -> Maybe Placement) ->
     Placement
-putDoubleDoorThen wl cond soff a b speed cont =
-    doorBetween wl cond soff a half speed $
-        \pl1 -> Just $
-            doorBetween wl cond soff b half speed $
-                \pl2 -> cont pl1 pl2
+putDoubleDoorThen wl soff a b dr cont =
+    doorBetween wl soff a half dr $
+        \pl1 -> Just $ doorBetween wl soff b half dr $ \pl2 -> cont pl1 pl2
   where
     half = 0.5 *^ (a + b)
 
 doorBetween ::
     Wall ->
-    WdBl ->
     Float ->
     Point2 ->
     Point2 ->
-    Float ->
+    Door ->
     (Placement -> Maybe Placement) ->
     Placement
-doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
---    [x, y] -> ptCont (putSlideDr adoor wl soff x y) g
+doorBetween wl soff pa pb dr g = case divideLine 40 pa pb of
     (x : y : zs) ->
-        divideDoorPane
-            Nothing
-            wl
-            cond
-            (soff - dist y pb)
-            speed
-            (zip (x : y : zs) (y : zs))
-            g
+        divideDoorPane Nothing wl (soff - dist y pb) dr (zip (x : y : zs) (y : zs)) g
     _ -> error "tried to create doorBetween with too few points"
---  where
---    adoor =
---        defaultDoor
---            & drTrigger .~ cond
---            & drUpdate .~ DoorLerp speed
 
 divideDoorPane ::
     Maybe Int ->
     Wall ->
-    WdBl ->
-    Float ->
     Float ->
+    Door ->
     [(Point2, Point2)] ->
     (Placement -> Maybe Placement) ->
     Placement
-divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
+divideDoorPane mid wl soff dr ppairs g = case ppairs of
     [p] -> ptCont (adoor p) g
     (p : ps) -> ptCont (adoor p) $
-        \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
+        \pl -> Just $ divideDoorPane (_plMID pl) wl soff dr ps g
     _ -> undefined
   where
     adoor (x, y) = putSlideDr thedoor wl soff x y
-    thedoor =
-        defaultDoor
-            & drUpdate . drLerpSpeed .~ speed
-            & drTrigger .~ cond
-            & drPushedBy .~ maybe PushesItself PushedBy mid
+    thedoor = dr & drPushedBy .~ maybe PushesItself PushedBy mid
 
 putAutoDoor :: Point2 -> Point2 -> Placement
 putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
@@ -93,7 +71,7 @@ putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
              in Just $
                     putDoubleDoor
                         defaultAutoWall
-                        (WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor)
                         a
                         b
-                        3
+                        (defaultDoor & drTrigger .~(WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrOpenAutoDoor)
+                            & drUpdate .~ DoorLerpWithTimer 0 3)