Store light information in original Garden, using ST. Use that for drawing
[L-seed.git] / src / Lseed / Data.hs
1 -- | Data definitions for L-seed
2 module Lseed.Data where 
3
4 import Data.Foldable (Foldable, fold)
5 import Data.Traversable (Traversable, sequenceA)
6 import Control.Applicative ((<$>),(<*>),pure)
7 import Data.Monoid
8
9 -- | A list of plants, together with their position in the garden, in the interval [0,1]
10 type Garden a = [ Planted a ]
11
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         }
18
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)
30
31 -- | A (compiled) rule of an L-system, with a matching function and a weight
32 type LRule = (Int, Plant () -> Maybe (Plant ()))
33
34 -- | An complete LSystem 
35 type LSystem = [LRule]
36
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)
42
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
47
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
55         
56
57 instance Functor Planted where
58         fmap f planted = planted { phenotype = fmap f (phenotype planted) }
59
60 instance Foldable Planted where
61         fold planted = fold (phenotype planted)
62
63 instance Traversable Planted where
64         sequenceA planted = (\x -> planted { phenotype = x }) <$> sequenceA (phenotype planted)