BROKEN partial redo of room tree composition
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user