Differentiate between obFinished and obShutdown
[L-seed.git] / src / Lseed / Data.hs
1 -- | Data definitions for L-seed
2 module Lseed.Data where 
3
4 import Data.Foldable (Foldable, foldMap)
5 import Data.Traversable (Traversable, sequenceA)
6 import Control.Applicative ((<$>),(<*>),pure)
7 import Control.Arrow (second)
8 import Data.Monoid
9 import System.Time (ClockTime)
10 import Data.Monoid
11
12 -- | User Tag
13 type UserTag = String
14
15 -- | Light angle
16 type Angle = Double
17
18 -- | A list of plants, together with their position in the garden, in the interval [0,1]
19 type Garden a = [ Planted a ]
20
21 -- | Named variants of a garden, for more expressive type signatures
22 type GrowingGarden = Garden GrowthState
23 type AnnotatedGarden = Garden StipeInfo
24
25 -- | A plant with metainformatoin
26 data Planted a = Planted
27         { plantPosition :: Double -- ^ Position in the garden, interval [0,1]
28         , plantOwner    :: Integer -- ^ Id of the user that owns this plant
29         , plantOwnerName:: String -- ^ Name of the owner of the plant
30         , genome        :: GrammarFile -- ^ Lsystem in use
31         , phenotype     :: Plant a -- ^ Actual current form of the plant
32         }
33         deriving (Show)
34
35 -- | Named variants of a Planted, for more expressive type signatures
36 type GrowingPlanted = Planted GrowthState
37 type AnnotatedPlanted = Planted StipeInfo
38
39 -- | A plant, which is
40 data Plant a 
41         -- | a stipe with a length (factor of stipeLength), an angle relative
42         -- to the parent stipe and a list of plants sprouting at the end
43         = Plant { pData :: a
44                 , pLength :: Double
45                 , pAngle :: Angle
46                 , pUserTag :: UserTag
47                 , pBranches :: [ Plant a ]
48                 }
49         deriving (Show)
50
51 -- | A straight, untagged plant with length zero and no branches.
52 inititalPlant = Plant () 0 0 "" []
53
54 data StipeInfo = StipeInfo
55         { siLength    :: Double -- ^ a bit redundant, but what shells
56         , siSubLength :: Double
57         , siLight     :: Double
58         , siSubLight  :: Double
59         , siAngle     :: Angle
60         , siDirection :: Angle
61         , siGrowth    :: GrowthState
62         , siOffset    :: Double -- ^ Sideways position, relative to Plant origin
63         , siHeight    :: Double -- ^ Vertical distance from bottom
64         }
65         deriving (Show)
66
67 -- | A GrowingPlant can be growing in one of these three ways:
68 data GrowthState = NoGrowth
69                  | EnlargingTo Double -- ^ value indicates the growth target 
70                  | GrowingSeed Double -- ^ value indicates the current state [0..1]
71         deriving (Show)
72
73 -- | Named variants of a Plant, for more expressive type signatures
74 type GrowingPlant = Plant GrowthState
75 type AnnotatedPlant = Plant StipeInfo
76
77 -- | Representation of what is on screen
78 data ScreenContent = ScreenContent
79         { scGarden     :: AnnotatedGarden
80         , scLightAngle :: Double
81         , scTime       :: String
82         }
83
84 -- | Main loop observers
85 data Observer = Observer {
86         -- | Called once per season, before the main loop starts
87           obInit :: IO ()
88         -- | Called once per tick, with the current tick number and the current
89         -- state of the garden
90         , obState :: Integer -> GrowingGarden -> IO ()
91         -- | Also called once per tick, with a function that calculates the
92         -- information that should be displayed given a point in time
93         , obGrowingState :: (ClockTime -> ScreenContent) -> IO ()
94         -- | Called before the main loop quits, with the last state of the garden
95         , obFinished :: GrowingGarden -> IO ()
96         -- | Called once before program termination
97         , obShutdown :: IO ()
98         }
99 nullObserver = Observer (return ()) (\_ _ -> return ()) (\_ -> return ()) (\_ -> return ()) (return ())
100
101 -- | Methods to get the initial garden and the updated code when a plant multiplies
102 data GardenSource = GardenSource {
103         -- | Called at the beginning of a season, to aquire the garden
104           getGarden :: IO (Garden ())
105         -- | Given a plant, returns the genome to be used for a seedling.
106         , getUpdatedCode :: Planted () -> IO GrammarFile
107         }
108 constGardenSource :: Garden () -> GardenSource
109 constGardenSource garden = GardenSource (return garden) (return . genome)
110
111 -- | A complete grammar file
112 type GrammarFile = [ GrammarRule ]
113
114 type Priority = Int
115 type Weight = Int
116
117 defaultPriority :: Priority
118 defaultPriority = 0
119
120 defaultWeight :: Weight
121 defaultWeight = 1
122
123 -- | A single Rule. For now, only single branches
124 --   can be matched, not whole subtree structures
125 data GrammarRule = GrammarRule
126         { grName :: String
127         , grPriority :: Priority
128         , grWeight :: Weight
129         , grCondition :: Condition
130         , grAction :: GrammarAction
131         }
132         deriving (Read,Show)
133
134 data Matchable
135         = MatchLight
136         | MatchSubLight
137         | MatchLength
138         | MatchSubLength
139         | MatchDirection
140         | MatchAngle
141         deriving (Read,Show)
142
143 data Cmp
144         = LE
145         | Less
146         | Equals
147         | Greater
148         | GE 
149         deriving (Read,Show)
150
151 data Condition
152         = Always Bool -- constant conditions
153         | Condition `And` Condition
154         | Condition `Or` Condition
155         | UserTagIs String
156         | NumCond Matchable Cmp Double
157         deriving (Read,Show)
158          
159 data GrammarAction
160         = SetLength (Maybe UserTag) LengthDescr
161         | AddBranches (Maybe UserTag) Double [(Angle, Double, Maybe UserTag)]
162         | Blossom (Maybe UserTag)
163         deriving (Read,Show)
164
165 data LengthDescr = Absolute Double
166                  | Additional Double
167                  | AdditionalRelative Double -- ^ in Percent
168         deriving (Read,Show)
169
170
171 -- Instances
172 instance Functor Plant where
173         fmap f p = p { pData = f (pData p)
174                      , pBranches = map (fmap f) (pBranches p)
175                      }
176
177 instance Foldable Plant where
178         foldMap f p = mconcat $ f (pData p) : map (foldMap f) (pBranches p)
179
180 instance Traversable Plant where
181         sequenceA (Plant x len ang ut ps) =
182                 Plant <$> x <*> pure len <*> pure ang <*> pure ut <*>
183                         sequenceA (map sequenceA ps)
184
185 instance Functor Planted where
186         fmap f planted = planted { phenotype = fmap f (phenotype planted) }
187
188 instance Foldable Planted where
189         foldMap f planted = foldMap f (phenotype planted)
190
191 instance Traversable Planted where
192         sequenceA planted = (\x -> planted { phenotype = x }) <$> sequenceA (phenotype planted)
193
194 instance Monoid Observer where
195         mempty = nullObserver
196         obs1 `mappend` obs2 = nullObserver {
197                 obInit = obInit obs1 >> obInit obs2,
198                 obState = \d g -> obState obs1 d g >> obState obs2 d g,
199                 obGrowingState = \f -> obGrowingState obs1 f >> obGrowingState obs2 f,
200                 obFinished = \g -> obFinished obs1 g >> obFinished obs2 g,
201                 obShutdown = obShutdown obs1 >> obShutdown obs2
202                 }
203