Move towards unifying RoomPos constructors

src/Dodge/Room/LongDoor.hs

@@ -9,6 +9,7 @@ import Dodge.Tree
 import Dodge.Default.Room
 import Dodge.LevelGen.Data
 import Dodge.Placement.Instance
+import Dodge.PlacementSpot
 import Dodge.Room.Link
 import Dodge.Room.Door
 import Dodge.Room.Procedural
@@ -92,7 +93,7 @@ southPillarsRoom x y h = do
         pillarsc = putBlockRect (x/3-20) (x/3+20) (h/2-20) (h/2+20)
            ++ putBlockRect (2*x/3-20) (2*x/3+20) (h/2-20) (h/2+20)
     pillars <- takeOne [pillarsa, pillarsb, pillarsc]
-    return $ roomRectAutoLinks x y & rmPmnts .~ pillars
+    return $ roomRectAutoLinks x y & rmPmnts .~ (pillars ++ [mntLightLnkCond usedInLnkToPS])
 
 addSouthPillars :: RandomGen g => Float -> Float -> Room -> State g Room
 addSouthPillars x h r = do
@@ -118,21 +119,21 @@ addButtonSlowDoor x h rm = do
     openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
     belowH y = (sndV2 . fst) y < h - 40
     aboveH y = (sndV2 . fst) y > h + 40
+    amountedlight dr xoff = Just . moveLSThen (getdoorpos (fromJust $ _plMID dr)) 
+                (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) . const . const
+    -- TODO make the height of this light source and of other mounted lights
+    -- be taken from a single consistent source
     butDoor _ _ = putLitButOnPos col butPosCond
         $  \btid -> Just $ putDoubleDoorThen False col (cond' btid) 30 (V2 0 h) (V2 x h) 2
-        $ \dr1 dr2 -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1)) 
-                (V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90))
-        $ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2)) 
-                (V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90))
-        $ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2)) 
-                (V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90))
-        $ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1)) 
-                (V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90))
-        $ \_ _ ->Nothing
+        $ \dr1 dr2 -> amountedlight dr1 50
+        $ amountedlight dr1 (-50)
+        $ amountedlight dr2   50
+        $ amountedlight dr2 (-50)
+        $ Nothing
     getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
         in (b, argV (a-.-b))
-    butPosCond (UnusedLink (V2 x' y') a' _) _ | y' < 0.5 * h 
-                = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink))
+    butPosCond (UnusedLink (V2 x' y') a' _ rpls) _ | y' < 0.5 * h 
+                = Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink) rpls)
     butPosCond _ _ = Nothing
     --butPosCond _ = True -- y < h
     col = dim $ light red

src/Dodge/Room/Procedural.hs

@@ -53,8 +53,8 @@ roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
     , _rmPath  = concatMap doublePair pth
-    , _rmPos   = map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOnPath) posps
-        ++ map (\pd -> UnusedSpot pd 0 $ S.singleton RoomPosOffPath) interposps
+    , _rmPos   = map (\pd -> UnusedSpot pd 0 (S.singleton RoomPosOnPath) NotLink) posps
+        ++ map (\pd -> UnusedSpot pd 0 (S.singleton RoomPosOffPath) NotLink) interposps
     , _rmPmnts    = []
     , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
     , _rmFloor = Tiled [Tile 
@@ -147,8 +147,8 @@ quarterRoomTri w = do
             , sPS (V2 (w-15) (w-25)) pi PutNothing 
             ]
         , _rmPos = 
-            [ UnusedSpot (V2 (w-20) (w-20)) pi S.empty 
-            , UnusedSpot (V2 (w-15) (w-25)) pi S.empty 
+            [ UnusedSpot (V2 (w-20) (w-20)) pi S.empty NotLink
+            , UnusedSpot (V2 (w-15) (w-25)) pi S.empty NotLink
             ]
         , _rmBound  = [[V2 0 0,V2 w w,V2 (-w) w]]
         }
@@ -188,8 +188,8 @@ quarterRoomSquare w = do
             , sPS (V2 20 (2*w-40)) pi PutNothing
             , sPS (V2 25 (2*w-45)) pi PutNothing
             ]
-        , _rmPos = [UnusedSpot (V2 20 (2*w-40)) pi S.empty
-                , UnusedSpot (V2 25 (2*w-45)) pi S.empty
+        , _rmPos = [UnusedSpot (V2 20 (2*w-40)) pi S.empty NotLink
+                , UnusedSpot (V2 25 (2*w-45)) pi S.empty NotLink
                 ]
         , _rmBound = [map toV2 [(w,w),(0,2*w),(-w,w)]]
         }

src/Dodge/Room/Room.hs

@@ -83,7 +83,8 @@ glassSwitchBack = do
     hgt <- state $ randomR (400,600)
     wllen <- state $ randomR (60,wth/2-40)
     let hf = hgt/5
-        con1 cond (UnusedLink (V2 x y) a _) _ | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a $ S.singleton RoomPosExLink)
+        con1 cond (UnusedLink (V2 x y) a _ rpls) _ 
+            | cond y = Just (PS (V2 x y) a , UsedSpot (V2 x y) a (S.singleton RoomPosExLink) rpls)
         con1 _ _ _ = Nothing
         plmnts = 
             [ mntLightLnkCond $ con1 (< 0.5 * hgt)