Files
loop/src/Dodge/Layout/Tree/GenerateStructure.hs
T

56 lines
1.3 KiB
Haskell

{-
Procedural generation of tree structures.
A /trunk/ refers to the successive first nodes in lists of children.
-}
module Dodge.Layout.Tree.GenerateStructure
where
import Dodge.RandomHelp
import Data.Tree
import Control.Monad.State
import System.Random
{-
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)
{-
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