Work on room generation/laser run past

src/Dodge/Room/LasTurret.hs

@@ -14,11 +14,17 @@ module Dodge.Room.LasTurret (
     lasCenRunClose1,
     lasCenRunCloseLongCor,
     lasRunRand,
+    setRoomInt,
 ) where
 
-import Control.Monad
-import Data.Foldable (fold)
+import Data.Foldable
+import Data.Maybe
+import Color
+import Shape
+import Dodge.Placement.Instance.LightSource
 import Dodge.Room.Path
+import Control.Monad
+--import Data.Foldable (fold)
 import Dodge.Room.Procedural
 import qualified Data.Set as S
 import Dodge.Cleat
@@ -40,9 +46,13 @@ import Geometry
 import LensHelp
 import RandomHelp
 
+-- no lights!
 cenLasTur :: (RandomGen g) => State g Room
 cenLasTur = do
-    thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
+--    lshape <- takeOne [vShape, lShape, jShape, liShape]
+--    let lightn i = mntLSCond (fmap (fmap $ colorSH black) lshape) 
+--            $ rprBool $ const . (\rp -> PolyEdge i `S.member` (fold (rp ^? rpType . rplsType)))
+--    thelight <- mntLightLnkCond $ rprBool $ const . isInLnk
     roomNgon 8 200
         <&> rmPmnts
         .~ [ putLasTurret 0.02
@@ -50,8 +60,11 @@ cenLasTur = do
                 (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100 <&> (,S.singleton UsedPosLow)))
                 30
                 covershape
-           , thelight
+--           , lightn 0
+--           , lightn 3
+--           , lightn 6
            ]
+        <&> rmPath %~ addNodesCrossingCirc 0 30
   where
     covershape = rectNSWE 10 (-10) (-20) 20
 
@@ -131,24 +144,57 @@ healthTest n = do
             , cleatOnward door
             ]
 
-lasSensorTurretTest :: (RandomGen g) => Int -> State g (MetaTree Room String)
-lasSensorTurretTest n = do
-    cenroom <- shuffleLinks . lightSensInsideDoor n =<< cenLasTur
+lasSensorTurretTest :: State LayoutVars (MetaTree Room String)
+lasSensorTurretTest = do
+    n <- nextLayoutInt
+    cenroom' <- shuffleLinks . lightSensInsideDoor n =<< cenLasTur
+    (i,cenroom'') <- setRoomInt cenroom'
+    lshape <- takeOne [vShape, lShape, jShape, liShape]
+    let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a +_rpDir rp))
+    let cenroom = cenroom''
+            & rmInPmnt <>~ 
+                [(0, alight pi . f i)
+                ,(0, alight (0.5*pi) . f i)
+                ,(0, alight (1.5*pi) . f i)]
     rToOnward "lasSensorTurretTest" $
         treePost
             [door, cenroom, triggerDoorRoom n, cleatOnward door]
+  where
+    f i gw = fromJust $ find (isused ._rpType) (gw ^?! genRooms . ix (gw ^?! genInts . ix i) . rmPos)
+    isused UsedOutLink{_rplsChildNum = 0} = True 
+    isused _ = False 
 
-lasCenSensEdge :: (RandomGen g) => Int -> State g (MetaTree Room String)
+-- note the double usage of the int, shouldn't cause a problem
+lasCenSensEdge :: Int -> State LayoutVars (MetaTree Room String)
 lasCenSensEdge n = do
-    cenroom <- shuffleLinks . lightSensByDoor n =<< cenLasTur
+    cenroom' <- (shuffleLinks . lightSensByDoor n =<< cenLasTur)
+    (i,cenroom'') <- setRoomInt cenroom'
+    lshape <- takeOne [vShape, lShape, jShape, liShape]
+    let alight a rp = mntLSCond (fmap (fmap $ colorSH black) lshape) (PS (rotateV a $ _rpPos rp) (a +_rpDir rp))
+    let cenroom = cenroom''
+            & rmInPmnt <>~ 
+                [(0, alight pi . f i)
+                ,(0, alight (0.5*pi) . f i)
+                ,(0, alight (1.5*pi) . f i)]
     let doorroom = triggerDoorRoom n
     rToOnward "lasCenSensEdge" $
         treeFromTrunk [door] $
             Node
                 cenroom
                 [ treePost [doorroom, cleatOnward door]
-                , treePost [door, cleatLabel 0 corridor]
+                , treePost [door, cleatLabel n corridor]
                 ]
+  where
+    f i gw = fromJust $ find (isused ._rpType) (gw ^?! genRooms . ix (gw ^?! genInts . ix i) . rmPos)
+    isused UsedOutLink{_rplsChildNum = 0} = True 
+    isused _ = False 
+
+setRoomInt :: Room -> State LayoutVars (Int, Room)
+setRoomInt x = do
+    i <- nextLayoutInt
+    return (i, x & rmPmnts .:~ sps0 (PutWorldUpdate (f i)))
+  where
+    f i rid _ gw = gw & genInts . at i ?~ (gw ^?! genRooms . ix rid . rmMID . _Just)
 
 lasRunYinYang :: (RandomGen g) => State g (MetaTree Room String)
 lasRunYinYang = do