45 lines
1.3 KiB
Haskell
45 lines
1.3 KiB
Haskell
{-
|
|
Procedural generation of tree structures.
|
|
|
|
A /trunk/ refers to the successive first nodes in lists of children.
|
|
-}
|
|
module Dodge.Tree.GenerateStructure
|
|
where
|
|
import RandomHelp
|
|
|
|
import Data.Tree
|
|
{- Single branched tree (a trunk). -}
|
|
treePath :: Int -> Tree ()
|
|
treePath 0 = Node () []
|
|
treePath x = Node () [treePath (x-1)]
|
|
|
|
{- Adds a branch at a certain point down a trunk. -}
|
|
addBranchAt
|
|
:: Int -- ^ Depth to add branch at
|
|
-> Tree () -- ^ Branch to add
|
|
-> Tree () -- ^ Starting tree
|
|
-> Tree ()
|
|
addBranchAt 0 b (Node () xs) = Node () (xs ++ [b])
|
|
addBranchAt i b (Node () (x:xs))
|
|
= Node () (addBranchAt (i-1) b x : xs)
|
|
addBranchAt _ _ _ = error "Trying to add a branch too far along a tree"
|
|
|
|
{- Randomly generate a tree containing a maximum of three nodes. -}
|
|
smallBranch :: RandomGen g => State g (Tree ())
|
|
smallBranch = takeOne
|
|
[ treePath 0
|
|
, treePath 1
|
|
, treePath 2
|
|
, addBranchAt 0 (treePath 0) (treePath 1)
|
|
]
|
|
|
|
{- Randomly generate a small tree. -}
|
|
aTreeStrut :: RandomGen g => State g (Tree ())
|
|
aTreeStrut = do
|
|
d <- state $ randomR (9,11:: Int)
|
|
nbs <- state $ randomR (2,4)
|
|
bds <- takeN nbs [1 .. d - 1]
|
|
bs <- replicateM nbs smallBranch
|
|
let trunk = treePath d
|
|
return $ foldr (uncurry addBranchAt) trunk $ zip bds bs
|