Work on laser run past rooms

src/Dodge/Room/LasTurret.hs

@@ -9,6 +9,9 @@ module Dodge.Room.LasTurret (
     lasSensorTurretTest,
     healthTest,
     lasCenRunClose,
+    lasCenRunClose',
+    lasCenRunClose1,
+    lasCenRunCloseLongCor,
 ) where
 
 import Data.Foldable (fold)
@@ -267,6 +270,49 @@ lasCenRunCloseLongCor = do
 
 lasCenRunClose1 :: (RandomGen g) => State g (MetaTree Room String)
 lasCenRunClose1 = do
+    --(alinks,blinks) <- shufflePair (bllinks,brlinks)
+    (alinks,blinks) <- shufflePair (bllinks,tmllink)
+    outwall <- takeOne [awall (V2 185 25) (rectWH 10 50) 
+               , awall (V2 200 50) (rectWH 50 10) ]
+    r <- roomRectAutoLights 250 200
+            <&> rmPmnts
+            <>~ [ putLasTurret 0.02 & plSpot .~ PS (V2 125 100) 0
+               , awall (V2 65 25) (rectWH 10 50) 
+                , outwall
+               , awall (V2 95 150) (rectWH 10 10) 
+               --, awall (V2 105 150) (rectWH 20 10) 
+               , awall (V2 155 150) (rectWH 10 10) 
+                , sps0 $ putConvexChasm $ rectNSWE 200 110 105 145
+--               , awall (V2 150 215) (rectWH 60 10)
+               ]
+            <&> rmLinks %~ setInLinks alinks
+--            <&> rmLinks %~ setOutLinks (memtest (OnEdge South) (FromEdge West 3))
+            <&> rmLinks %~ setOutLinks blinks
+            <&> rmLinks . each %~ mvlinks
+            <&> rmPath %~ S.map (both %~ mvpath)
+    rToOnward "lasCenRunClose" $ return $ cleatOnward r
+  where
+    mvlinks lnk | tmllink lnk = lnk & rlPos -~ V2 20 0
+        | tmrlink lnk = lnk & rlPos +~ V2 20 0
+        | otherwise = lnk
+    mvpath (V2 x y) | y > 190 , x > 50 , x < 125 = V2 (x- 20) y
+        | y > 190 , x > 125 , x < 200 = V2 (x+ 20) y
+        | otherwise = V2 x y
+    tmllink = memtest (FromEdge West 1) (OnEdge North)
+    tmrlink = memtest (FromEdge West 2) (OnEdge North)
+    bllinks = etest 
+                    (memtest (FromEdge West 0) (OnEdge South))
+                    (memtest (FromEdge South 0) (OnEdge West))
+    brlinks = etest
+                    (memtest (FromEdge East 0) (OnEdge South))
+                    (memtest (FromEdge South 0) (OnEdge East))
+    awall x v = heightWallPS (PS x 0) 30 v
+    etest f g x = f x || g x
+    memtest a b x = let y = _rlType x
+        in a `S.member` y && b `S.member` y
+
+lasCenRunClose2 :: (RandomGen g) => State g (MetaTree Room String)
+lasCenRunClose2 = do
     (alinks,blinks) <- shufflePair (bllinks,trlinks)
     a <- takeOne [3*pi/2,3*pi/4]
     laspos <- takeOne [V2 60 190, V2 65 185]

src/Dodge/Room/Tutorial.hs

@@ -55,7 +55,7 @@ tutAnoTree = do
 --        , return . tToBTree "door" $ treePost [corridor, cleatOnward door]
         , corDoor
 --        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
-        , lasCenRunClose
+        , lasCenRunClose1
 --        , passthroughLockKeyLists lockRoomKeyItems itemRooms
         , tToBTree "door" . return <$> return (cleatOnward door)
         , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)

src/Dodge/RoomLink.hs

@@ -26,7 +26,6 @@ module Dodge.RoomLink (
 
 import Dodge.Base.CardinalPoint
 import Control.Lens
-import Data.List (partition)
 import qualified Data.Set as S
 import Dodge.Data.GenWorld
 import Geometry
@@ -104,12 +103,11 @@ swapInOutLinks = rmLinks %~ map (rlType %~ S.map f)
     f OutLink = InLink
     f x = x
 
-overLnkType :: RoomLinkType -> ([RoomLink] -> [RoomLink]) -> Room -> Room
-overLnkType lt f = rmLinks %~ g
+overLnkType :: RoomLinkType -> (RoomLink -> RoomLink) -> [RoomLink] -> [RoomLink]
+overLnkType lt f = each %~ g
   where
-    g lnks =
-        let (xs, ys) = partition (S.member lt . _rlType) lnks
-         in f xs ++ ys
+    g lnk | lt `S.member` _rlType lnk = f lnk
+        | otherwise = lnk
 
 rlPosDir :: RoomLink -> (Point2, Float)
 rlPosDir rl = (_rlPos rl, _rlDir rl)