65 lines
2.2 KiB
Haskell
65 lines
2.2 KiB
Haskell
{-
|
|
Annotating tree structures with desired properties for rooms.
|
|
-}
|
|
module Dodge.Layout.Tree.Annotate
|
|
where
|
|
import Dodge.RandomHelp
|
|
import Dodge.Layout.Tree.Polymorphic
|
|
import Dodge.Layout.Tree.Either
|
|
import Dodge.Room.Procedural
|
|
import Dodge.Room.Link
|
|
import Dodge.Room.Data
|
|
import Dodge.Room
|
|
import Dodge.Room.Teleport
|
|
--import Dodge.Floor
|
|
|
|
import Data.Tree
|
|
import Control.Monad.State
|
|
import System.Random
|
|
|
|
data Annotation
|
|
= Lock Int
|
|
| Key Int
|
|
| Corridor
|
|
| DoorAno
|
|
| FirstWeapon
|
|
| StartRoom
|
|
| EndRoom
|
|
| OrAno [[Annotation]]
|
|
|
|
addLock :: RandomGen g => Int -> Tree [Annotation] -> State g (Tree [Annotation])
|
|
addLock i t = do
|
|
(beforeLock, afterLock) <- splitTrunk t
|
|
newBefore <- applyToRandomNode (Key i :) beforeLock
|
|
return $ addToTrunk newBefore [Node [Lock i] afterLock]
|
|
|
|
padCorridors :: Tree [Annotation] -> Tree [Annotation]
|
|
padCorridors (Node x xs) = Node [Corridor] [Node x (map padCorridors xs)]
|
|
|
|
randomPadCorridors :: RandomGen g => Tree [Annotation] -> State g (Tree [Annotation])
|
|
randomPadCorridors (Node x xs) = do
|
|
n <- state $ randomR (1, 3)
|
|
xs' <- mapM randomPadCorridors xs
|
|
return $ treeTrunk (replicate n [Corridor]) (Node x xs')
|
|
|
|
annoToRoomTree :: RandomGen g => [Annotation] -> State g (Tree (Either Room Room))
|
|
annoToRoomTree [OrAno as] = do
|
|
a <- takeOne as
|
|
annoToRoomTree a
|
|
annoToRoomTree [Corridor] = fmap (pure . Right) $ randomiseOutLinks corridor
|
|
annoToRoomTree [DoorAno] = fmap (\r -> Node (Left door) [(pure . Right) r]) (randomiseOutLinks corridor)
|
|
annoToRoomTree [FirstWeapon] = do
|
|
branchWP <- branchRectWith weaponRoom
|
|
blockedC <- blockedCorridor
|
|
firstWeapon <- takeOne $ [return $ appendEitherTree branchWP [blockedC]] ++ replicate 5 weaponRoom
|
|
firstWeapon
|
|
annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1)
|
|
annoToRoomTree [StartRoom] = do
|
|
w <- state $ randomR (100,400)
|
|
h <- state $ randomR (200,400)
|
|
fmap (pure . Right) $ return (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h) >>= randomiseOutLinks
|
|
annoToRoomTree _ = do
|
|
w <- state $ randomR (100,400)
|
|
h <- state $ randomR (200,400)
|
|
fmap (pure . Right) $ return (roomRectAutoLinks w h) >>= randomiseOutLinks
|