Allow for more complex placement positioning

src/Dodge/Room/LongDoor.hs

@@ -5,10 +5,12 @@ module Dodge.Room.LongDoor where
 import Dodge.Data
 import Dodge.RoomLink
 import Dodge.Base
+import Dodge.Tree
 import Dodge.Default.Room
 import Dodge.LevelGen.Data
 import Dodge.Placement.Instance
 import Dodge.Room.Link
+import Dodge.Room.Door
 import Dodge.Room.Procedural
 --import Dodge.Layout.Tree.Either
 --import Dodge.LevelGen.Data
@@ -20,6 +22,8 @@ import Dodge.LightSource
 import Picture
 import Geometry
 
+import qualified Data.Set as S
+import Data.Tree
 import System.Random
 import Control.Lens
 import Control.Monad.State
@@ -106,7 +110,7 @@ addButtonSlowDoor x h rm = do
        ,( V2 (x/2+50) 5,0::Float)
        ]
     thePlacement <- takeOne [butDoor butPos butRot ]
-    shuffleLinks $ setOutLinks aboveH $ setInLinks belowH (rm 
+    shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH (rm 
         & rmPmnts %~ (thePlacement :)
         & rmBound %~ (openDoorBound :)
         )
@@ -116,9 +120,9 @@ addButtonSlowDoor x h rm = do
     aboveH y = (sndV2 . fst) y > h + 40
     butDoor _ _ = putLitButOnPos col butPosCond
         $  \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
-    butPosCond (UnusedLink (V2 x' y') a') | y' < 0.5 * h 
-                = Just (PS (V2 x' y') a' , PosPl (V2 x' y') a')
-    butPosCond _ = Nothing
+    butPosCond (UnusedLink (V2 x' y') a') _ | y' < 0.5 * h 
+                = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a')
+    butPosCond _ _ = Nothing
     --butPosCond _ = True -- y < h
     col = dim $ light red
     cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
@@ -141,3 +145,12 @@ slowDoorRoom = do
     proom <- southPillarsRoom x y h
     addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources)))
 
+slowDoorRoomRunPast :: RandomGen g => State g (SubCompTree Room)
+slowDoorRoomRunPast = do
+    r <- slowDoorRoom
+    return $ treeFromTrunk [PassDown door]
+        (Node (PassDown r)
+            [ singleUseAll door
+            , return (UseLabel 0 $ door & rmConnectsTo .~ S.singleton InLink)
+            ]
+        )