Room with doors and central ledge terminal

src/Dodge/Room/Tutorial.hs

@@ -1,6 +1,7 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Room.Tutorial where
 
+import Dodge.Room.Room
 import Dodge.Data.AmmoType
 import Dodge.Room.Path
 import Dodge.Room.Pillar
@@ -49,7 +50,7 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
-        , return $ tToBTree "cor" $ return $ cleatOnward corridor
+        , tToBTree "cor" . return <$> shuffleLinks (cleatOnward corridor)
         , tToBTree "sdr" . return . cleatOnward <$> 
                 (shuffleLinks =<< distributerRoom BulletAmmo 100000)
 --        , return $ tToBTree "cor" $ return $ cleatOnward corridor
@@ -67,6 +68,7 @@ tutAnoTree = do
         , return $ tToBTree "cor" $ return $ cleatOnward corridor
         , return $ tToBTree "door" $ return $ cleatOnward door
         , tutHub
+        , chasmSpitTerminal
         , tutLight
         , tutDrop
         , return $ tToBTree "cor" $ return $ cleatOnward corridor
@@ -179,7 +181,99 @@ midChasm = do
         return
             [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
 
---    dia x y = [sps0 $ PutChasm [V2 ]
+midChasmPlatform :: State LayoutVars Room
+midChasmPlatform = do
+    x <- state $ randomR (250, 300)
+    y <- state $ randomR (250, 300)
+    r <- roomRectAutoLinks x y
+    cs <- join $ takeOne [censquare x y]
+    shuffleLinks $
+        r
+            & rmLinks %~ setOutLinks (isMidEdgeLink r North)
+            & rmLinks %~ setInLinks (isMidEdgeLink r South)
+            & rmPmnts <>~ cs
+  where
+    censquare x y = do
+        z <- state $ randomR (40, 60)
+        let (chsms,clfs) = sqPlatformChasm 20 (min x y/2 - z)
+        --return [sps0 $ putConvexChasm (rectNSWE (y - z) z z (x - z))]
+        return [sps0 $ PutChasm
+            (fmap (fmap (+ V2 (x/2) (y/2))) chsms)
+            (fmap (fmap (+ V2 (x/2) (y/2))) clfs)
+            ]-- (rectNSWE (y - z) z z (x - z))]
+--    cenoct x y =
+--        return
+--            [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
+
+sqPlatformChasm :: Float -> Float -> ([[Point2]],[[Point2]])
+sqPlatformChasm b a = 
+    ( [[ibr,obr,otr,itr],[itr,otr,otl,itl],[itl,otl,obl,ibl],[ibl,obl,obr,ibr]]
+    , [[obr,otr,otl,obl], [ibr,ibl, itl, itr]]
+    )
+  where
+    obr = V2 a (-a)
+    obl = V2 (-a) (-a)
+    otl = V2 (-a) a
+    otr = V2 a a
+    ibr = V2 b (-b)
+    ibl = V2 (-b) (-b)
+    itl = V2 (-b) b
+    itr = V2 b b
+
+sqSpitChasm :: Float -> Float -> ([[Point2]],[[Point2]])
+sqSpitChasm b a = 
+    ( [[ibr,obr,otr,itr],[itr,otr,otl,itl],[itl,otl,obl,ibl]]
+    , [[ibr,obr,otr,otl,obl,ibl,itl,itr]]
+    )
+  where
+    obr = V2 a (-a)
+    obl = V2 (-a) (-a)
+    otl = V2 (-a) a
+    otr = V2 a a
+    ibr = V2 b (-a)
+    ibl = V2 (-b) (-a)
+    itl = V2 (-b) b
+    itr = V2 b b
+
+midChasmSpit :: State LayoutVars Room
+midChasmSpit = do
+    let x = 300
+        y = 300
+    r <- roomRectAutoLinks x y
+    cs <- join $ takeOne [censquare x y]
+    shuffleLinks $
+        r
+            & rmLinks %~ setOutLinks 
+                (\rl -> isMidEdgeLink r South rl 
+                    || isMidEdgeLink r West rl 
+                    || isMidEdgeLink r East rl 
+                )
+            & rmLinks %~ setInLinks (isMidEdgeLink r South)
+            & rmPmnts <>~ cs
+  where
+    censquare x y = do
+        z <- state $ randomR (40, 60)
+        let (chsms,clfs) = sqSpitChasm 20 (min x y/2 - z)
+        return [sps0 $ PutChasm
+            (fmap (fmap (+ V2 (x/2) (y/2))) chsms)
+            (fmap (fmap (+ V2 (x/2) (y/2))) clfs)
+            ]-- (rectNSWE (y - z) z z (x - z))]
+--    cenoct x y =
+--        return
+--            [sps0 $ putConvexChasm $ (V2 (x / 2) (y / 2) +) <$> polyOrthDist 8 (min x y / 2 - 25)]
+
+chasmSpitTerminal :: State LayoutVars MTRS
+chasmSpitTerminal = do
+    i1 <- nextLayoutInt
+    y <- midChasmSpit
+    l3 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnkNum 0 rp
+    l4 <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnkNum 1 rp
+    let y' = y & rmPmnts <>~ [l3,l4]
+    return $ tToBTree "chasmTerm" $ Node (addDoorToggleTerminal' i1 (PS 150 0) y')
+        [treePost [triggerDoorRoom i1, critDeadEnd]
+        ,treePost [triggerDoorRoom i1, critDeadEnd]
+        ,return $ cleatOnward $ triggerDoorRoom i1
+        ]
 
 polyChasm :: Int -> Float -> State LayoutVars Room
 polyChasm n x =
@@ -221,7 +315,7 @@ chasmSimpleMaze =
 tutLight :: State LayoutVars (MetaTree Room String)
 tutLight = do
     x <- shuffleRoomPos =<< chasmSimpleMaze
-    y <- chasmSimpleMaze
+    y <- midChasmSpit
     z <- chasmSimpleMaze
     return $
         tToBTree "TutLight" $
@@ -231,7 +325,7 @@ tutLight = do
                     ,sps g (PutFlIt battery)
                     ]
                 , corridor & rmPmnts .~ mempty
-                , removeLights y
+                , y
                 , corridor & rmPmnts .~ mempty
                 , removeLights z
                 , door