1 -- | Data definitions for L-seed
2 module Lseed.Data where
4 import Data.Foldable (Foldable, fold)
5 import Data.Traversable (Traversable, sequenceA)
6 import Control.Applicative ((<\$>),(<*>),pure)
7 import Data.Monoid
9 -- | A list of plants, together with their position in the garden, in the interval [0,1]
10 type Garden a = [ Planted a ]
12 -- | A plant with metainformatoin
13 data Planted a = Planted
14         { plantPosition :: Double -- ^ Position in the garden, interval [0,1]
15         , genome :: LSystem  -- ^ Lsystem in use
16         , phenotype :: Plant a -- ^ Actual current form of the plant
17         }
19 -- | A plant, which is
20 data Plant a
21         -- | a bud, i.e. the end of a sprout
22         = Bud a
23         -- | a stipe with a length (factor of stipeLength)
24         --   and more of the plant next
25         | Stipe a Double (Plant a)
26         -- ^ a fork with a sidewise offspring at a radial angle,
27         --   and a straight continuation
28         | Fork a Double (Plant a) (Plant a)
29         deriving (Show)
31 -- | A (compiled) rule of an L-system, with a matching function and a weight
32 type LRule = (Int, Plant () -> Maybe (Plant ()))
34 -- | An complete LSystem
35 type LSystem = [LRule]
37 -- Instances
38 instance Functor Plant where
39         fmap f (Bud x) = Bud (f x)
40         fmap f (Stipe x len p1) = Stipe (f x) len (fmap f p1)
41         fmap f (Fork x angle p1 p2) = Fork (f x) angle (fmap f p1) (fmap f p2)
43 instance Foldable Plant where
44         fold (Bud x) = x
45         fold (Stipe x len p1) = x `mappend` fold p1
46         fold (Fork x angle p1 p2) = x `mappend` fold p1 `mappend` fold p2
48 instance Traversable Plant where
49         sequenceA (Bud x) =
50                 Bud <\$> x
51         sequenceA (Stipe x len p1) =
52                 Stipe <\$> x <*> pure len <*> sequenceA p1
53         sequenceA (Fork x angle p1 p2) =
54                 Fork <\$> x <*> pure angle <*> sequenceA p1 <*> sequenceA p2
57 instance Functor Planted where
58         fmap f planted = planted { phenotype = fmap f (phenotype planted) }
60 instance Foldable Planted where
61         fold planted = fold (phenotype planted)
63 instance Traversable Planted where
64         sequenceA planted = (\x -> planted { phenotype = x }) <\$> sequenceA (phenotype planted)