Commit before adding more debugging control

src/Dodge/Placement/Instance/Door.hs

@@ -4,12 +4,12 @@ module Dodge.Placement.Instance.Door (
     putDoubleDoorThen,
 ) where
 
-import Dodge.Door.PutSlideDoor
 import Control.Lens
 import Dodge.Data.CreatureEffect
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Wall
+import Dodge.Door.PutSlideDoor
 import Dodge.LevelGen.PlacementHelper
 import Geometry
 import Linear
@@ -51,15 +51,22 @@ doorBetween ::
     (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
-    (x : y : zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x : y : zs) (y : zs)) g
+--    [x, y] -> ptCont (putSlideDr adoor wl soff x y) g
+    (x : y : zs) ->
+        divideDoorPane
+            Nothing
+            wl
+            cond
+            (soff - dist y pb)
+            speed
+            (zip (x : y : zs) (y : zs))
+            g
     _ -> error "tried to create doorBetween with too few points"
-  where
-    adoor =
-        defaultDoor
-            & drTrigger .~ cond
-            & drUpdate .~ DoorLerp speed
-
+--  where
+--    adoor =
+--        defaultDoor
+--            & drTrigger .~ cond
+--            & drUpdate .~ DoorLerp speed
 
 divideDoorPane ::
     Maybe Int ->
@@ -72,12 +79,15 @@ divideDoorPane ::
     Placement
 divideDoorPane mid wl cond soff speed 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
+    (p : ps) -> ptCont (adoor p) $
+        \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
     _ -> undefined
   where
     adoor (x, y) = putSlideDr thedoor wl soff x y
     thedoor =
-        defaultDoor & drUpdate . drLerpSpeed .~ speed & drTrigger .~ cond
+        defaultDoor
+            & drUpdate . drLerpSpeed .~ speed
+            & drTrigger .~ cond
             & drPushedBy .~ maybe PushesItself PushedBy mid
 
 putAutoDoor :: Point2 -> Point2 -> Placement

src/Dodge/Placement/Instance/LightSource.hs

@@ -11,6 +11,7 @@ module Dodge.Placement.Instance.LightSource (
     spanColLightBlackI,
     moveLSThen,
     spanLightI,
+    spanLightY,
     mntLightLnkCond',
     spanLS,
 ) where
@@ -27,6 +28,7 @@ import Geometry
 import RandomHelp
 import Shape
 import ShapePicture
+import Linear
 
 propLSThen ::
     PropUpdate ->
@@ -215,6 +217,16 @@ spanColLightBlackI col h a b =
 spanLightI :: Point2 -> Point2 -> Placement
 spanLightI = spanColLightI 0.75 50
 
+spanLightY :: Point2 -> Point2 -> Point2 -> Point2 -> Placement
+spanLightY l x y z = 
+    ps0j (PutLS $ lsColPos 0.75 (addZ (h -5) l)) $
+        ps0j (f x) $
+        ps0j (f y) $
+        sps0 $ f z
+  where
+    f p = putShape $ thinHighBar h p (l + normalize (l-p))
+    h = 50
+
 --extendAway :: Point2 -> Point2 -> Point2
 --extendAway p x = p +.+ squashNormalizeV (p -.- x)