Working inter-room placements

src/Dodge/Room/Data.hs

@@ -25,7 +25,7 @@ data Room = Room
     , _rmPos    :: [RoomPos]
     , _rmPath   :: [(Point2, Point2)]
     , _rmPmnts  :: [Placement]
-    , _rmPartialPmnt    :: Maybe (Int -> Placement)
+    , _rmPartialPmnt    :: Maybe ([Placement] -> Placement)
     , _rmExtendedPmnt   :: Maybe Placement
     , _rmBound  :: [ [Point2] ]
     , _rmFloor  :: [Tile]

src/Dodge/Room/Door.hs

@@ -2,12 +2,16 @@
 module Dodge.Room.Door
     where
 import Geometry
+import Dodge.Data
 import Dodge.Room.Data
 import Dodge.Default.Room
 import Dodge.Placements
---import Color
+import Color
 
---import qualified Data.IntMap.Strict as IM
+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
+import Dodge.LevelGen.Data
+import Control.Lens
 
 door :: Room
 door = defaultRoom
@@ -23,12 +27,12 @@ door = defaultRoom
         ,(V2 20  5,pi)
         ]
 
-
-switchDoor :: Room
-switchDoor = defaultRoom
+switchDoorRoom :: Room
+switchDoorRoom = defaultRoom
     { _rmPolys = [rectNSWE 40 0 0 40]
     , _rmLinks = lnks
     , _rmPath  = [(V2 20 35,V2 20 5)]
+    , _rmPartialPmnt = Just f
 -- door extends into side walls (for shadows as rendered 12/03)
 -- note no bounds
     }
@@ -36,4 +40,7 @@ switchDoor = defaultRoom
     lnks = [(V2 20 35,0)
         ,(V2 20  5,pi)
         ]
+    f (pmnt:_) = putDoubleDoor False red (cond pmnt) (V2 0 20) (V2 40 20) 2
+    f _ = error "tried to put a door using an empty placement list"
+    cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt)