{- | Annotating tree structures with desired properties for rooms. -} module Dodge.Annotation ( module Dodge.Annotation.Data , module Dodge.Annotation ) where import Dodge.RandomHelp import Dodge.Tree import Dodge.Room import Dodge.Annotation.Data import Data.Tree import Control.Monad.State import System.Random --import Control.Lens import Data.Maybe addLock :: RandomGen g => Int -> Tree [Annotation g] -> State g (Tree [Annotation g]) addLock i t = do (beforeLock, afterLock) <- splitTrunk t newBefore <- applyToRandomNode (Key i :) beforeLock return $ addToTrunk newBefore [Node [Lock i] afterLock] {- | Add one corridor between each parent-child link of a tree of annotations. -} padWithCorridors :: Tree [Annotation g] -> Tree [Annotation g] padWithCorridors = padWithAno [Corridor] padWithAno :: [Annotation g] -> Tree [Annotation g] -> Tree [Annotation g] padWithAno ano (Node x xs) = Node ano [Node x (map (padWithAno ano) xs)] padSucWithCorridors :: Tree [Annotation g] -> Tree [Annotation g] padSucWithCorridors (Node x xs) = Node x (map padWithCorridors xs) {- Add one to three corridors between each parent-child link of a tree of annotations. -} randomPadCorridors :: RandomGen g => Tree [Annotation g] -> State g (Tree [Annotation g]) randomPadCorridors (Node x xs) = do n <- state $ randomR (1, 3) xs' <- mapM randomPadCorridors xs return $ treeFromTrunk (replicate n [Corridor]) (Node x xs') {- | Add a corridor to a random out-link of a room. -} roomThenCorridor :: RandomGen g => Room -> State g (SubCompTree Room) roomThenCorridor theRoom = fmap (\r -> Node (PassDown theRoom) [(pure . UseAll) r]) (randomiseOutLinks corridor) {- | Create a random room tree structure from a list of annotations. -} anoToRoomTree :: RandomGen g => [Annotation g] -> State g (SubCompTree Room) anoToRoomTree anos = case anos of [AnoApplyInt i f] -> f i -- [SetLabel i randrm] -> do -- rm <- randrm -- return . singleUseAll $ rm & rmLabel ?~ i -- [UseLabel i randrm] -> do -- rm <- randrm -- return $ singleUseAll $ rm & rmTakeFrom ?~ i [ChainAnos ass] -> do rms <- mapM anoToRoomTree ass return $ chainUses rms [PassthroughLockKeyLists i ls ks] -> do (functionlockroom,randomitemidentity) <- takeOne ls lr <- functionlockroom i ii <- randomitemidentity keyroom <- fromJust $ lookup ii ks return $ overwriteLabel 0 UseNone lr [keyroom] [OrAno as] -> do a <- takeOne as anoToRoomTree a [Corridor] -> pure . UseAll <$> randomiseOutLinks corridor [AirlockAno] -> airlock >>= roomThenCorridor [FirstWeapon] -> do branchWP <- branchRectWith weaponRoom blockedC <- longBlockedCorridor 3 join $ takeOne $ return (passUntilUseAll branchWP [blockedC]) : replicate 5 weaponRoom [EndRoom] -> fmap (pure . UseAll) (telRoomLev 1) (SpecificRoom rt:_) -> rt (BossAno cr : _) -> do br <- bossRoom cr branchRectWith . pure . fmap PassDown $ treeFromPost [corridor,corridor] br (TreasureAno crs loot : _) -> branchRectWith . fmap (pure . PassDown) $ lootRoom crs loot _ -> do w <- state $ randomR (100,400) h <- state $ randomR (200,400) fmap (pure . UseAll) . randomiseOutLinks $ roomRectAutoLinks w h