Work on placements

This commit is contained in:
2025-09-24 22:16:38 +01:00
parent da8230fe00
commit 91e67e37dc
7 changed files with 99 additions and 406 deletions
+2 -2
View File
@@ -52,8 +52,8 @@ layoutLevelFromSeed i seed = do
putStrLnAppend "log/attemptedSeeds" $ "Generating level with seed " ++ show seed
appendFile "log/attemptedSeeds" "\n"
let g = mkStdGen seed
--let treecluster = evalState tutRoomTree (LayVars g 0)
let treecluster = evalState initialRoomTree (LayVars g 0)
let treecluster = evalState tutRoomTree (LayVars g 0)
-- let treecluster = evalState initialRoomTree (LayVars g 0)
let labts = decomposeSelfTree $ numSelfTree $ combineTree _rmName treecluster
appendFile "log/treeCluster" ("Seed: " ++ show seed ++ "\n")
putStrLn "MetaTree clusters:"
+21 -29
View File
@@ -44,6 +44,7 @@ lightSensInsideDoor i rm =
, psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
, sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100) & plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100)
lightSensByDoor :: Int -> Room -> Room
@@ -53,10 +54,11 @@ lightSensByDoor i rm =
.++~ [ psPt atFstLnkOut $ PutForeground $ verticalWire (V2 20 0) 0 80
, heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
, heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
, sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift) & plExternalID ?~ i
, sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift) & plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift)
where
-- & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift)
covershape = rectNSWE 10 (-10) (-20) 20
sensorshift (p, a) = (p +.+ rotateV a (V2 60 (-20)), a)
@@ -83,38 +85,28 @@ analyserByNthLink n proxreq i rm =
rm
& rmPmnts
.++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
, analyser
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n sensorshift)
, analyser
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n sensorshift)
& plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~
-- analyser
-- (SensorWithRequirement proxreq)
-- (atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-- (atNthLnkOutShiftBy n sensorshift)
where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
analyserByNthLinkWithPrompt
:: Int -> [TerminalLine] -> ProximityRequirement -> Int -> Room -> Room
analyserByNthLinkWithPrompt n l proxreq i rm =
rm
& rmPmnts
.++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
,
analyserWithPrompt l
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n sensorshift)
analyserByNthLinkWithPrompt ::
Int -> [TerminalLine] -> ProximityRequirement -> Int -> Placement
analyserByNthLinkWithPrompt n l proxreq i =
-- rm
-- & rmPmnts
-- .++~ [-- psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
analyserWithPrompt
l
(SensorWithRequirement proxreq)
(atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(atNthLnkOutShiftBy n sensorshift)
& plExternalID ?~ i
]
-- & rmOutPmnt . at i ?~
-- analyserWithPrompt l
-- (SensorWithRequirement proxreq)
-- (atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
-- (atNthLnkOutShiftBy n sensorshift)
-- ]
where
sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
@@ -122,7 +114,7 @@ analyserByDoor :: ProximityRequirement -> Int -> Room -> Room
analyserByDoor = analyserByNthLink 0
analyserByDoorWithPrompt :: [TerminalLine] -> ProximityRequirement -> Int -> Room -> Room
analyserByDoorWithPrompt = analyserByNthLinkWithPrompt 0
analyserByDoorWithPrompt s x i = rmPmnts .:~ analyserByNthLinkWithPrompt 0 s x i
healthTest :: RandomGen g => Int -> State g (Tree Room)
healthTest n = do
+17 -6
View File
@@ -37,13 +37,14 @@ import TreeHelp
--import Data.List (intersperse)
tutAnoTree :: State LayoutVars MTRS
tutAnoTree =
tutAnoTree = do
(is,wbp) <- setTreeInts =<< weaponBehindPillar
foldMTRS
[ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, corDoor
, tutRooms
, tutRooms is
, corDoor
, tToBTree "critroom" <$> weaponBehindPillar
, tToBTree "critroom" <$> return wbp
, corDoor
, tutDrop
, return $ tToBTree "cor" $ return $ cleatOnward corridor
@@ -64,6 +65,11 @@ setRoomInt x = do
where
f i rm _ = genInts . at i ?~ (rm ^?! rmMID . _Just)
setTreeInts :: Tree Room -> State LayoutVars ([Int],Tree Room)
setTreeInts x = do
y <- traverse setRoomInt x
return (foldMap ((:[]) . fst) y, fmap snd y)
tutDrop :: State LayoutVars (MetaTree Room String)
tutDrop = do
x <- shuffleLinks =<< roomNgon 6 100
@@ -97,12 +103,16 @@ tutDrop = do
, makeTermLine "-------------------------------------------"
]
tutRooms :: State LayoutVars (MetaTree Room String)
tutRooms = do
tutRooms :: [Int] -> State LayoutVars (MetaTree Room String)
tutRooms is = do
i <- nextLayoutInt
j <- nextLayoutInt
k <- nextLayoutInt
let a gw = analyserByNthLinkWithPrompt 3 sensorTut (RequireEquipment (AMMOMAG DRUMMAG)) k
x <-
shuffleLinks . analyserByDoorWithPrompt sensorTut (RequireEquipment (AMMOMAG DRUMMAG)) i
shuffleLinks
. analyserByDoorWithPrompt sensorTut (RequireEquipment (AMMOMAG DRUMMAG)) i
. (rmInPmnt .:~ a)
=<< addDoorAtNthLinkToggleTerminal 1 ss j
<$> roomNgon 6 100
bcor <- blockedCorridor
@@ -115,6 +125,7 @@ tutRooms = do
[ treeFromPost [triggerDoorRoom i] r1
, treeFromPost [triggerDoorRoom j] r2
, bcor
-- , treeFromPost [triggerDoorRoom k] r2
]
where
ss =