BROKEN partial redo of room tree composition

This commit is contained in:
2022-06-09 19:17:27 +01:00
parent d8174c7ccc
commit 8fb80f9691
7 changed files with 68 additions and 65 deletions
+10 -10
View File
@@ -1,5 +1,6 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.GlassLesson where
import Dodge.UseAll
import Dodge.RoomLink
import Dodge.Creature
import Dodge.LevelGen.Data
@@ -18,19 +19,18 @@ import LensHelp
import qualified Data.Set as S
--import Control.Monad.Loops
glassLesson :: RandomGen g => State g (SubCompTree Room)
glassLesson :: RandomGen g => State g (Tree Room)
glassLesson = do
i <- takeOne [1,2,3]
corridors <- replicateM i $ PassDown <$> shuffleLinks corridor
return $ Node (PassDown botRoom)
[ singleUseNone $ door & rmConnectsTo .~ fromWest North 1
corridors <- replicateM i $ shuffleLinks corridor
return $ Node botRoom
[ pure $ door & rmConnectsTo .~ fromWest North 1
, uppers
, treeFromPost (PassDown (door & rmConnectsTo .~ S.member (OnEdge East))
: corridors) $ UseAll door]
, treeFromPost ( (door & rmConnectsTo .~ S.member (OnEdge East))
: corridors) $ useAll door]
where
fromWest edge i s = S.member (OnEdge edge) s && S.member (FromWest i) s
uppers = Node (PassDown $ door & rmConnectsTo .~ fromWest North 0)
[singleUseNone topRoom]
uppers = Node (door & rmConnectsTo .~ fromWest North 0) [pure topRoom]
botRoom = roomRect 200 200 1 1
& rmPmnts .~ botplmnts
& rmLinks %~ setInLinksByType (OnEdge West)
@@ -54,6 +54,6 @@ glassLesson = do
]
]
glassLessonRunPast :: RandomGen g => State g (LabSubCompTree Room)
glassLessonRunPast = (f <$> glassLesson) <&> (,TreeSubLabelling "glassLessonRunPast" Nothing)
glassLessonRunPast = (f <$> glassLesson) <&> (toOnward "glassLessonRunPast",)
where
f (Node r rs) = Node r $ return (UseLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs
f (Node r rs) = Node r $ return (useLabel 0 $ door & rmConnectsTo .~ S.member (OnEdge West)) : rs