80 lines
3.1 KiB
Haskell
80 lines
3.1 KiB
Haskell
{- | 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)
|
|
|
|
padSucWithDoors :: RandomGen g => Tree [Annotation g] -> Tree [Annotation g]
|
|
padSucWithDoors (Node x xs) = Node x (map (padWithAno [SpecificRoom thetree]) xs)
|
|
where
|
|
thetree = do
|
|
thecor <- shuffleLinks corridor
|
|
takeOne
|
|
[ return (UseAll door)
|
|
, treeFromPost [PassDown door, PassDown thecor] (UseAll door)
|
|
]
|
|
|
|
{- 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])
|
|
(shuffleLinks 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
|
|
[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 <$> shuffleLinks corridor
|
|
(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) . shuffleLinks $ roomRectAutoLinks w h
|