Allow for more complex placement positioning

src/Dodge/Placement/Instance/Button.hs

@@ -58,7 +58,7 @@ putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
     ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
 
 putLitButOnPos :: Color 
-    -> (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+    -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) 
     -> (Int -> Maybe Placement) -> Placement
 putLitButOnPos col f subpl 
     = plSpot .~ thePS $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
@@ -89,7 +89,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
     thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75}
 
 putLitButOnPosExtTrig :: Color 
-   -> (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+   -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) 
    -> Placement
 putLitButOnPosExtTrig col f 
     = psPtCont thePS (PutTrigger (const False))

src/Dodge/Placement/Instance/LightSource.hs

@@ -81,7 +81,7 @@ mntLS :: (Point2 -> Point3 -> Shape) -> Point2 -> Point3 -> Placement
 mntLS shp wallp lampp = mntLSOn shp Nothing defaultLS wallp lampp (const Nothing)
 
 mntLSCond :: (Point2 -> Point3 -> Shape) 
-    -> (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+    -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) 
     -> Placement
 mntLSCond shp shift = -- updatePSToLevel 1 (const $ PSLnk shift (const id) Nothing) $ 
     mntLS shp 0 (V3 0 (-40) 90)
@@ -93,15 +93,15 @@ mntLight a b = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
     return $ mntLS shp a (addZ 90 b)
 
-mntLightLnkCond :: (RoomPos -> Maybe (PlacementSpot,RoomPos)) 
+mntLightLnkCond :: (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) 
     -> Placement
 mntLightLnkCond f = RandomPlacement $ do
     shp <- takeOne [vShape,iShape,lShape,jShape,liShape]
     return $ mntLSCond shp f
 
-unusedLnkToPS :: RoomPos -> Maybe (PlacementSpot,RoomPos)
-unusedLnkToPS rp = case rp of
-    UnusedLink p a -> Just (PS p a,PosPl p a)
+unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
+unusedLnkToPS rp _ = case rp of
+    UnusedLink p a -> Just (PS p a,UsedSpot p a)
     _ -> Nothing
 
 spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement

src/Dodge/Placement/PlaceSpot.hs

@@ -33,7 +33,7 @@ import Data.Bifunctor
 -- to the placement
 placeSpot :: (World,Room) -> Placement -> ( (World,Room), [Placement] )
 placeSpot (w,rm) plmnt = case plmnt of
-    Placement{_plSpot = PSRoomRand i} -> placeSpotRoomRand rm i plmnt w
+    Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
     Placement{_plSpot = PSPos extract eff fallback} -> placeSpotUsingLink w rm plmnt extract eff fallback
     Placement{} ->
         let (i,w') = placeSpotID (shiftPSBy shift (_plSpot plmnt)) (_plType plmnt) w
@@ -52,7 +52,7 @@ placeSpot (w,rm) plmnt = case plmnt of
 
 -- this should be tidied up
 placeSpotUsingLink :: World -> Room -> Placement 
-    -> (RoomPos -> Maybe (PlacementSpot,RoomPos))
+    -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
     -> (RoomPos -> Room -> Room)
     -> Maybe Placement
     -> ((World, Room), [Placement])
@@ -63,14 +63,15 @@ placeSpotUsingLink w rm plmnt extract eff fallback = case searchedPoss (_rmPos r
         Just plmnt' -> placeSpot (w,rm) plmnt'
   where
     searchedPoss [] = Nothing
-    searchedPoss (pos:poss) = case extract pos of
+    searchedPoss (pos:poss) = case extract pos rm of
         Nothing -> second (pos:) <$> searchedPoss poss
         Just (ps,rmpos) -> Just ( ps,rmpos:poss)
 
-placeSpotRoomRand :: Room -> Int -> Placement -> World -> ((World,Room),[Placement])
-placeSpotRoomRand rm i plmnt w =
+placeSpotRoomRand :: Room -> Int -> ((Point2,Float) -> PlacementSpot) 
+    -> Placement -> World -> ((World,Room),[Placement])
+placeSpotRoomRand rm i f plmnt w =
     let (ps,g) = runState (_rmRandPSs rm !! i) $_randGen w
-    in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ uncurry PS ps)
+    in placeSpot (w & randGen .~ g,rm) (plmnt & plSpot .~ f ps)
 
 shiftPlacement :: (Point2,Float) -> Placement -> Placement
 shiftPlacement shift plmnt = case plmnt of