Safe Haskell	Safe-Inferred
Language	Haskell2010

Geometry.Processes.PoissonDiscForest

Synopsis

poissonDiscForest :: (PrimMonad m, HasBoundingBox boundingBox) => Gen (PrimState m) -> boundingBox -> Double -> Int -> [Vec2] -> m (Map Vec2 (Set Vec2))

Documentation

poissonDiscForest Source #

Arguments

:: (PrimMonad m, HasBoundingBox boundingBox)
=> Gen (PrimState m)	RNG from mwc-random. `create` yields the default (static) RNG.
-> boundingBox	Region to generate points in
-> Double	Radius around each point no other points are genereted. Smaller values yield more points.
-> Int	\(k\) parameter: per point, how many attempts should be made to find an empty spot? Typical values: 3-10. Higher values are slower, but increase result quality.
-> [Vec2]	Initial points to start sampling from.
-> m (Map Vec2 (Set Vec2))	Map of parent to children.

poissonDisc, but keeps track of which parent spawned which children. While this algorithm does a bit more processing to reassemble the trees, it allows specifying the starting points explicitly. (poissonDisc would also allow this, but since it’s mostly used for simply sampling, this additional config option would just clutter the API.)

(image code)

Expand

>>> :{
haddockRender "Geometry/Algorithms/Sampling/PoissonDisc/poisson_disc_forest.svg" 300 300 $ \_ -> do
    let initialPoints = [Vec2 50 50, Vec2 150 150, Vec2 250 250]
        forest = runST $ do
            gen <- MWC.create
            poissonDiscForest gen (shrinkBoundingBox 30 [zero, Vec2 300 300]) 7 10 initialPoints
    let paint color i parent = do
            let parentRadius = 2.5
            cairoScope $ do
                setColor (color (sin (lerpID (0,20) (0,pi) i)^2))
                sketch (Circle parent parentRadius)
                fill
            case M.lookup parent forest of
                Nothing -> pure () -- Should never happen: only the roots have no parents
                Just children -> for_ children $ \child -> do
                    cairoScope $ do
                        setColor black
                        sketch (resizeLineSymmetric (\l -> l-2*parentRadius) (Line parent child))
                        stroke
                    paint color (i+1) child
    for_ (zip [flare, crest, flare] initialPoints) $ \(color, p0) -> paint color 0 p0
:}
Generated file: size 474KB, crc32: 0x28fe4a90