From d340fd73c3143c0b966c14e186aa27e33fc6bf2b Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Sat, 12 Mar 2022 10:35:14 +0000
Subject: [PATCH] Improve placementspots

---
 src/Dodge/Layout.hs                         |  3 +-
 src/Dodge/Placement/Instance/LightSource.hs |  1 -
 src/Dodge/PlacementSpot.hs                  | 32 +++++++++++++++------
 src/Dodge/Room/LasTurret.hs                 |  4 ++-
 4 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs
index 8273dbd41..b0d4226ad 100644
--- a/src/Dodge/Layout.hs
+++ b/src/Dodge/Layout.hs
@@ -128,7 +128,8 @@ doAfterPlacement pmntis gw = gRandify gw $ do
     return $ newgw & gRooms . ix i .~ rm
 
 doInPlacements :: ( IM.IntMap [Placement],GenWorld) -> GenWorld
-doInPlacements (im,w) = let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_gRooms w)
+doInPlacements (im,w) = 
+    let (gw,rms) = mapAccumR (doRoomInPlacements im) w (_gRooms w)
     in gw {_gRooms = rms}
 
 doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
diff --git a/src/Dodge/Placement/Instance/LightSource.hs b/src/Dodge/Placement/Instance/LightSource.hs
index 4bfd551dd..2e896daf1 100644
--- a/src/Dodge/Placement/Instance/LightSource.hs
+++ b/src/Dodge/Placement/Instance/LightSource.hs
@@ -49,7 +49,6 @@ moveLSThen posf off sh = propLSThen propupdate lsupdate thels theprop
         , _prToggle = True
         }
     
-
 -- | mount a light source on a shape
 mntLSOn
     :: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs
index e621261a6..8b7b239d4 100644
--- a/src/Dodge/PlacementSpot.hs
+++ b/src/Dodge/PlacementSpot.hs
@@ -8,6 +8,7 @@ module Dodge.PlacementSpot
     , anyUnusedSpot
     , unusedSpotAwayFromLink
     , isUnusedLnk
+    , isInLnk
     , unusedLnkToPS
     , unusedSpotNearInLink
     , randDirPS
@@ -20,6 +21,8 @@ module Dodge.PlacementSpot
     , setFallback
     , twoRoomPoss
     , isUnusedLinkType
+    , roomPosRoomBoolShift 
+    , shiftInBy
     ) where
 import Dodge.LevelGen.Data
 import Geometry
@@ -52,6 +55,17 @@ anyUnusedSpot = roomPosBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacement
 roomPosRoomBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
 roomPosRoomBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
 
+roomPosRoomBoolShift :: (RoomPos -> Room -> Bool) 
+    -> ((Point2,Float) -> (Point2,Float))
+    -> PlacementSpot
+roomPosRoomBoolShift t shift = PSPos f (const id) Nothing
+  where
+    f rp r
+        | t rp r    = Just (PS p a, rp & rpPlacementUse +~ 1)
+        | otherwise = Nothing
+      where
+        (p,a) = shift (_rpPos rp, _rpDir rp)
+
 unusedSpotAwayFromLink :: Float -> PlacementSpot
 unusedSpotAwayFromLink x = roomPosRoomBool $ \rp r -> _rpLinkStatus rp == NotLink 
     && _rpPlacementUse rp == 0 
@@ -88,6 +102,11 @@ isUnusedLnk rp = case _rpLinkStatus rp of
     UnusedLink {} -> _rpPlacementUse rp == 0
     _ -> False
 
+isInLnk :: RoomPos -> Bool
+isInLnk rp = case _rpLinkStatus rp of
+    UsedInLink {} -> _rpPlacementUse rp == 0
+    _ -> False
+
 useUnusedLnk :: PlacementSpot
 useUnusedLnk = roomPosBool isUnusedLnk
 
@@ -99,19 +118,13 @@ isUsedLnkUnplaced  rp = case _rpLinkStatus rp of
 
 useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosCond t rp _
-    | t rp = Just (PS p a, rp & rpPlacementUse +~ 1)
+    | t rp = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
     | otherwise = Nothing
-  where
-    p = _rpPos rp
-    a = _rpDir rp
 
 useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosRoomCond t rp r
-    | t rp r = Just (PS p a, rp & rpPlacementUse +~ 1)
+    | t rp r = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
     | otherwise = Nothing
-  where
-    p = _rpPos rp
-    a = _rpDir rp
 
 unusedLnkToPS :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 unusedLnkToPS = useRoomPosCond $ \rp -> case _rpLinkStatus rp of
@@ -172,6 +185,9 @@ atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n f
   where
     f (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
 
+shiftInBy :: Float -> (Point2,Float) -> (Point2,Float)
+shiftInBy x (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
+
 --anyLnkInPS :: Float -- ^ amount to shift inward
 --    -> PlacementSpot
 --anyLnkInPS x = PSPos f (const id) Nothing
diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs
index f4df3677b..e9bbf165a 100644
--- a/src/Dodge/Room/LasTurret.hs
+++ b/src/Dodge/Room/LasTurret.hs
@@ -33,9 +33,11 @@ import System.Random
 cenLasTur :: Room
 cenLasTur = roomNgon 8 200 & rmPmnts .~
     [ putLasTurret 0.02
-    , heightWall 30 (rectNSEW (-90) (-110) 20 (-20))
+    , heightWallPS (roomPosRoomBoolShift (\rp _ -> isInLnk rp) (shiftInBy 100)) 30 covershape
     , mntLightLnkCond unusedLnkToPS
     ]
+  where
+    covershape = rectNSEW 10 (-10) 20 (-20)
 
 lightSensInsideDoor :: Int -> Room -> Room
 lightSensInsideDoor outplid rm = rm