Start creating explicit tutorial map

2025-08-21 16:31:04 +01:00
parent 21460ceaa8
commit befe24e038
15 changed files with 272 additions and 161 deletions
@@ -1,11 +1,16 @@
-module Dodge.Room.RezBox where
+module Dodge.Room.RezBox (
+    rezBox,
+    rezBoxesWpCrit,
+    rezColor,
+    rezBoxes,
+    rezBox',
+) where

-import Dodge.Default.Terminal
-import Dodge.Terminal
 import Control.Monad
 import qualified Data.Set as S
 import Dodge.Cleat
 import Dodge.Data.GenWorld
+import Dodge.Default.Terminal
 import Dodge.Item.Random
 import Dodge.LevelGen.PlacementHelper
 import Dodge.LightSource
@@ -16,6 +21,7 @@ import Dodge.Room.Link
 import Dodge.Room.Procedural
 import Dodge.Room.RoadBlock
 import Dodge.RoomLink
+import Dodge.Terminal
 import Dodge.Tree
 import Geometry
 import LensHelp
@@ -25,18 +31,17 @@ import RandomHelp
 rezBox :: LightSource -> Room
 rezBox ls =
    roomRect 40 60 1 1
-        & rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS ls
-            , putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ makeTermPara s <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdDeactivateTerminal)
-                & plSpot .~ PS (V2 20 0) 0
-            ]
+        & rmPmnts
+            .~ [ sPS (V2 20 1) 0 $ PutLS ls
+               , putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ makeTermPara s <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdDeactivateTerminal)
+                    & plSpot .~ PS (V2 20 0) 0
+               ]
        & restrictInLinks (\(V2 _ h, _) -> h < 1)
        & restrictOutLinks (\(V2 _ h, _) -> h > 59)
        & rmName .~ "rezBox"
  where
    s = "RESPAWN POINT SET AT THIS LOCATION."

-tutorialMessage1 :: String
-tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOVEMENT TEST 1 INITIATED [WASD]. INTERACTION TEST 1 IN QUEUE [SPACE]."

 rezBox' :: RandomGen g => State g (MetaTree Room String)
 rezBox' = do
@@ -48,39 +53,39 @@ rezBox' = do
                , cleatOnward door
                ]

-rezBoxesWp :: RandomGen g => State g (Tree Room)
-rezBoxesWp = do
-    w <- state $ randomR (100, 400)
-    h <- state $ randomR (40, 40)
-    theweapon <- randBlockBreakWeapon
-    thecol <- rezColor
-    let aroom = rezInvBox thecol -- & rmConnectsTo .~ S.singleton (OnEdge North)
-    let isnorth = S.member (OnEdge North) . _rlType
-    centralRoom <-
-        shuffleLinks $
-            (roomRectAutoLinks w h){_rmPmnts = []}
-                & rmLinks %~ setLinkType InLink isnorth
-    onwardpassage <- shootOutPassage
-    let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
-    let rezrooms =
-            map adddoor $
-                wpAdd theweapon aroom : replicate (n -2) aroom
-    return $
-        treeFromTrunk [rezBox thecol, door] $
-            Node centralRoom (rezrooms ++ [onwardpassage])
-  where
-    adddoor rm = treeFromPost [connectsToNorth door] rm
-    connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)
+--rezBoxesWp :: RandomGen g => State g (Tree Room)
+--rezBoxesWp = do
+--    w <- state $ randomR (100, 400)
+--    h <- state $ randomR (40, 40)
+--    theweapon <- randBlockBreakWeapon
+--    thecol <- rezColor
+--    let aroom = rezInvBox thecol -- & rmConnectsTo .~ S.singleton (OnEdge North)
+--    let isnorth = S.member (OnEdge North) . _rlType
+--    centralRoom <-
+--        shuffleLinks $
+--            (roomRectAutoLinks w h){_rmPmnts = []}
+--                & rmLinks %~ setLinkType InLink isnorth
+--    onwardpassage <- shootOutPassage
+--    let n = length $ getLinksOfType (OnEdge North) $ _rmLinks centralRoom
+--    let rezrooms =
+--            map adddoor $
+--                wpAdd theweapon aroom : replicate (n -2) aroom
+--    return $
+--        treeFromTrunk [rezBox thecol, door] $
+--            Node centralRoom (rezrooms ++ [onwardpassage])
+--  where
+--    adddoor rm = treeFromPost [connectsToNorth door] rm
+--    connectsToNorth = rmConnectsTo .~ S.member (OnEdge North)

 maybeBlockedPassage :: RandomGen g => State g (Tree Room)
 maybeBlockedPassage =
    fmap (pure . cleatOnward) $
        join $ takeOne [return corridor, blockedCorridorCloseBlocks]

-shootOutPassage :: RandomGen g => State g (Tree Room)
-shootOutPassage =
-    fmap (pure . cleatOnward) $
-        join $ takeOne [blockedCorridorCloseBlocks]
+--shootOutPassage :: RandomGen g => State g (Tree Room)
+--shootOutPassage =
+--    fmap (pure . cleatOnward) $
+--        join $ takeOne [blockedCorridorCloseBlocks]

 rezBoxesWpCrit :: RandomGen g => State g (Tree Room)
 rezBoxesWpCrit = do
@@ -5,6 +5,7 @@ module Dodge.Room.Start (
    randomChallenges,
 ) where

+import Dodge.Room.RezBox
 import Dodge.Item.Held.Cane
 import Dodge.Item.Held.Launcher
 import Dodge.Cleat
@@ -14,7 +15,7 @@ import Dodge.Room.Containing
 import Dodge.Room.Corridor
 import Dodge.Room.Door
 import Dodge.Room.Link
-import Dodge.Room.RezBox
+--import Dodge.Room.RezBox
 import Dodge.Room.Room
 import Dodge.Room.RunPast
 import Dodge.Tree
@@ -0,0 +1,68 @@
+module Dodge.Room.Tutorial (tutAnoTree) where
+
+import Dodge.Room.Room
+import Dodge.Annotation.Data
+import Dodge.Room.Link
+import Dodge.Room.Ngon
+import Dodge.Room.Door
+import TreeHelp
+import Dodge.Tree.Compose
+import Dodge.Room.RezBox
+--import Control.Monad
+--import qualified Data.Set as S
+--import Dodge.Cleat
+import Dodge.Data.GenWorld
+import Dodge.Default.Terminal
+--import Dodge.Item.Random
+import Dodge.LevelGen.PlacementHelper
+--import Dodge.LightSource
+import Dodge.Placement.Instance
+--import Dodge.Room.Corridor
+--import Dodge.Room.Door
+--import Dodge.Room.Link
+import Dodge.Room.Procedural
+--import Dodge.Room.RoadBlock
+import Dodge.RoomLink
+import Dodge.Terminal
+--import Dodge.Tree
+import Geometry
+import LensHelp
+--import Padding
+import RandomHelp
+import Data.List (intersperse)
+
+tutAnoTree :: Annotation
+tutAnoTree = OnwardList $
+        intersperse
+            (AnTree corDoor)
+            [AnTree tutRooms]
+
+tutRooms :: State StdGen (MetaTree Room String)
+tutRooms = do
+    x <- tutRezBox
+    ys <- toggleDoorTest
+    return $ tToBTree "TutStartRez" $ treePost $ [x,door] <> ys
+
+tutRezBox :: State StdGen Room
+tutRezBox = do
+    ls <- rezColor
+    return $
+        roomRect 40 60 1 1
+            & rmPmnts
+                .~ [ sPS (V2 20 1) 0 $ PutLS ls
+                   , putImmediateMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ makeTermPara s <> tlSetStatus (TerminalPressTo "QUIT") <> tlDoEffect TmWdWdDeactivateTerminal)
+                        & plSpot .~ PS (V2 20 0) 0
+                   ]
+            & restrictInLinks (\(V2 _ h, _) -> h < 1)
+            & restrictOutLinks (\(V2 _ h, _) -> h > 59)
+            & rmName .~ "tutRezBox"
+  where
+    s = tutorialMessage1
+
+tutorialMessage1 :: String
+tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOVEMENT TEST 1 INITIATED [WASD]. INTERACTION TEST 1 IN QUEUE [SPACE]."
+
+toggleDoorTest :: State StdGen [Room]
+toggleDoorTest = do
+    x <- shuffleLinks $ roomNgon 6 100
+    return [x,door]