Use Grammar (testwise)
[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 -- | Named variants of a garden, for more expressive type signatures
13 type GrowingGarden = Garden (Maybe Double)
14
15 -- | A plant with metainformatoin
16 data Planted a = Planted
17         { plantPosition :: Double -- ^ Position in the garden, interval [0,1]
18         , genome        :: LSystem  -- ^ Lsystem in use
19         , phenotype     :: Plant a -- ^ Actual current form of the plant
20         }
21
22 -- | Named variants of a Planted, for more expressive type signatures
23 type GrowingPlanted = Planted (Maybe Double)
24
25 -- | A plant, which is
26 data Plant a 
27         -- | a bud, i.e. the end of a sprout
28         = Bud
29         -- | a stipe with a length (factor of stipeLength)
30         --   and more of the plant next
31         | Stipe a Double (Plant a)
32         -- ^ a fork with a sidewise offspring at a radial angle,
33         --   and a straight continuation 
34         | Fork Double (Plant a) (Plant a)
35         deriving (Show)
36
37 -- | Named variants of a Plant, for more expressive type signatures
38 type GrowingPlant = Plant (Maybe Double)
39
40 -- | Possible action to run on a Stipe in a Rule
41 data LRuleAction
42         = EnlargeStipe Double -- ^ Extend this Stipe to the given length
43         | ForkStipe Double [(Angle, Double)] -- ^ Branch this stipe at the given fraction and angle and let it grow to the given lengths
44         deriving (Show)
45
46 -- | A (compiled) rule of an L-system, with a matching function returning an action and weight
47 type LRule = (Plant () -> Maybe (Int, LRuleAction))
48
49 -- | An complete LSystem 
50 type LSystem = [LRule]
51
52 -- | Representation of what is on screen
53 data ScreenContent = ScreenContent
54         { scGarden     :: Garden ()
55         , scLightAngle :: Double
56         , scTime       :: String
57         }
58
59 -- | Light angle
60 type Angle = Double
61
62 -- Instances
63 instance Functor Plant where
64         fmap f Bud = Bud
65         fmap f (Stipe x len p1) = Stipe (f x) len (fmap f p1)
66         fmap f (Fork angle p1 p2) = Fork angle (fmap f p1) (fmap f p2)
67
68 instance Foldable Plant where
69         fold Bud  = mempty
70         fold (Stipe x len p1) = x `mappend` fold p1
71         fold (Fork angle p1 p2) = fold p1 `mappend` fold p2
72
73 instance Traversable Plant where
74         sequenceA Bud =
75                 pure Bud
76         sequenceA (Stipe x len p1) =
77                 Stipe <$> x <*> pure len <*> sequenceA p1
78         sequenceA (Fork angle p1 p2) =
79                 Fork <$> pure angle <*> sequenceA p1 <*> sequenceA p2
80         
81
82 instance Functor Planted where
83         fmap f planted = planted { phenotype = fmap f (phenotype planted) }
84
85 instance Foldable Planted where
86         fold planted = fold (phenotype planted)
87
88 instance Traversable Planted where
89         sequenceA planted = (\x -> planted { phenotype = x }) <$> sequenceA (phenotype planted)