diff --git a/src/Dodge/Annotation.hs b/src/Dodge/Annotation.hs index d4b4ae787..1a5ef4eb3 100644 --- a/src/Dodge/Annotation.hs +++ b/src/Dodge/Annotation.hs @@ -13,7 +13,7 @@ import Dodge.Annotation.Data import LensHelp --import Control.Lens ---import Data.Maybe +import Data.Maybe {- | Add one corridor between each parent-child link of a tree of annotations. -} --padWithCorridors :: Annotation -> Annotation @@ -48,11 +48,19 @@ annoToRoomTree' an = case an of OnwardList ans -> do mts <- mapM annoToRoomTree' ans return $ foldr1 attachOnward mts - IntAnno' f -> do + IntAnno f -> do (g,i) <- get put (g,i+1) annoToRoomTree' (f i) PadWith r an -> annoToRoomTree' an + PassthroughLockKeyLists ls ks i -> zoom _1 $ do + (functionlockroom,randomitemidentity) <- takeOne ls + lr <- functionlockroom i + ii <- randomitemidentity + keyroom <- fromJust $ lookup ii ks + return $ MTree ("PassthroughLockKeyLists-"++show ii) + (MTree "" lr [MBranch "" (toLabel' i) keyroom]) + [] --annoToRoomTree :: Annotation -> State StdGen (MetaTree Room) --annoToRoomTree an = case an of diff --git a/src/Dodge/Annotation/Data.hs b/src/Dodge/Annotation/Data.hs index 2044fe1a4..6e61d2cfd 100644 --- a/src/Dodge/Annotation/Data.hs +++ b/src/Dodge/Annotation/Data.hs @@ -15,12 +15,13 @@ data Annotation PadWith Room Annotation | OnwardList [Annotation] -- | IntAnno Int (Int -> Annotation) - | IntAnno' (Int -> Annotation) + | IntAnno (Int -> Annotation) -- | OrAno [[Annotation]] | SpecificRoom (State StdGen (MetaTree Room)) | AnoApplyInt Int (Int -> State StdGen (LabTree Room)) - | PassthroughLockKeyLists Int - [(Int -> State StdGen (LabTree Room), State StdGen ItemBaseType)] - [(ItemBaseType, State StdGen (LabTree Room))] + | PassthroughLockKeyLists + [(Int -> State StdGen (MetaTree Room), State StdGen ItemBaseType)] + [(ItemBaseType, State StdGen (MetaTree Room))] + Int makeLenses ''Annotation diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index f1d82b12e..1b4613ff5 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -31,27 +31,31 @@ import RandomHelp --import Color --import Dodge.Wire +import Data.List (intersperse) --import Data.Sequence hiding (zipWith) --import Data.Maybe --import qualified Data.IntMap.Strict as IM initialAnoTree :: Annotation initialAnoTree = PadWith door $ OnwardList - [ IntAnno' $ SpecificRoom . startRoom --- , PassthroughLockKeyLists 2 keyCardRunPastRand itemRooms - , IntAnno' $ SpecificRoom . warningRooms + $ intersperse + (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) + [ IntAnno $ SpecificRoom . startRoom + , (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor]) + , IntAnno $ PassthroughLockKeyLists + [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms + , IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms + , IntAnno $ SpecificRoom . warningRooms , SpecificRoom $ rToOnward "chaseCrit+armourChaseCrit rectRoom" $ return . cleatOnward $ roomRectAutoLinks 400 400 & rmPmnts .++~ [ spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) , spNoID anyUnusedSpot (PutCrit armourChaseCrit) ] ---"-- , [AnoApplyInt 100 healthTest] ---" , PassthroughLockKeyLists 23 ---" [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms ---" , SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward) ---" , PassthroughLockKeyLists 222 lockRoomKeyItems itemRooms +--a-- , [AnoApplyInt 100 healthTest] +--a , SpecificRoom (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward) +--" , IntAnno $ PassthroughLockKeyLists lockRoomKeyItems itemRooms --" , SpecificRoom randomChallenges ---" , AnoApplyInt 1 lasSensorTurretTest +--" , IntAnno $ SpecificRoom . lasSensorTurretTest --"-- ,[SpecificRoom $ fmap pure roomCCrits] --"-- ,[AirlockAno] --"-- ,[Corridor] diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index dc911e1e9..0ccd5147a 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -63,7 +63,7 @@ sensorRoomRunPast dt n = do (++ [treePost [ door & rmConnectsTo .~ (\s -> S.member InLink s && not (S.member BlockedLink s)) - , cleatLabel 0 corridor ] + , cleatLabel n corridor ] ] ) diff --git a/src/Dodge/Tree/Compose.hs b/src/Dodge/Tree/Compose.hs index 9a37ac256..50443efa8 100644 --- a/src/Dodge/Tree/Compose.hs +++ b/src/Dodge/Tree/Compose.hs @@ -16,7 +16,7 @@ module Dodge.Tree.Compose , attachTree , composeTreeRand , composeAndLog - , cmpToMT +-- , cmpToMT -- , compTree ) where import Dodge.Data diff --git a/src/Dodge/UseAll.hs b/src/Dodge/UseAll.hs index 9b55cb916..2467460c9 100644 --- a/src/Dodge/UseAll.hs +++ b/src/Dodge/UseAll.hs @@ -16,6 +16,11 @@ toOnward s rm toOnward' :: Room -> Maybe Room toOnward' = fmap snd . toOnward "" +toLabel' :: Int -> Room -> Maybe Room +toLabel' i rm + | LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just rm + | otherwise = Nothing + rToOnward :: Monad m => String -> Tree Room -> m (MetaTree Room) rToOnward s t = return $ MTree s (tToBTree t) []