Implement various matchable features
[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 Control.Arrow (second)
8 import Data.Monoid
9
10 -- | A list of plants, together with their position in the garden, in the interval [0,1]
11 type Garden a = [ Planted a ]
12
13 -- | Named variants of a garden, for more expressive type signatures
14 type GrowingGarden = Garden (Maybe Double)
15 type AnnotatedGarden = Garden StipeInfo
16
17 -- | A plant with metainformatoin
18 data Planted a = Planted
19         { plantPosition :: Double -- ^ Position in the garden, interval [0,1]
20         , genome        :: LSystem  -- ^ Lsystem in use
21         , phenotype     :: Plant a -- ^ Actual current form of the plant
22         }
23
24 -- | Named variants of a Planted, for more expressive type signatures
25 type GrowingPlanted = Planted (Maybe Double)
26
27 -- | A plant, which is
28 data Plant a 
29         -- | a stipe with a length (factor of stipeLength)
30         --   and a list of plants sprouting at the end, at a given radial angle.
31         = Stipe a Double [ (Double, Plant a) ]
32         deriving (Show)
33
34 mapSprouts :: (Plant a -> Plant b) -> [ (Double, Plant a) ] -> [ (Double, Plant b) ]
35 mapSprouts = map . second
36
37 -- | Named variants of a Plant, for more expressive type signatures
38 type GrowingPlant = Plant (Maybe Double)
39
40 data StipeInfo = StipeInfo
41         { siLength    :: Double -- ^ a bit redundant, but what shells
42         , siSubLength :: Double
43         , siLight     :: Double
44         , siSubLight  :: Double
45         , siAngle     :: Angle
46         , siDirection :: Angle
47         }
48         deriving (Show)
49
50 type AnnotatedPlant = Plant StipeInfo
51
52 -- | Possible action to run on a Stipe in a Rule
53 data LRuleAction
54         = EnlargeStipe Double -- ^ Extend this Stipe to the given length
55         | ForkStipe Double [(Angle, Double)] -- ^ Branch this stipe at the given fraction and angles and let it grow to the given lengths
56         deriving (Show)
57
58 -- | A (compiled) rule of an L-system, with a matching function returning an action and weight
59 type LRule = (AnnotatedPlant -> Maybe (Int, LRuleAction))
60
61 -- | An complete LSystem 
62 type LSystem = [LRule]
63
64 -- | Representation of what is on screen
65 data ScreenContent = ScreenContent
66         { scGarden     :: Garden ()
67         , scLightAngle :: Double
68         , scTime       :: String
69         }
70
71 -- | Light angle
72 type Angle = Double
73
74 -- Instances
75 instance Functor Plant where
76         fmap f (Stipe x len ps) = Stipe (f x) len (map (second (fmap f)) ps)
77
78 instance Foldable Plant where
79         fold (Stipe x len ps) = x `mappend` (mconcat $ map (fold.snd) ps)
80
81 instance Traversable Plant where
82         sequenceA (Stipe x len ps) =
83                 Stipe <$> x <*> pure len <*> sequenceA (map (\(a,p) -> (,) a <$> sequenceA p) ps)
84
85 instance Functor Planted where
86         fmap f planted = planted { phenotype = fmap f (phenotype planted) }
87
88 instance Foldable Planted where
89         fold planted = fold (phenotype planted)
90
91 instance Traversable Planted where
92         sequenceA planted = (\x -> planted { phenotype = x }) <$> sequenceA (phenotype planted)