Merge branch 'master' of git+ssh://gitosis@nomeata.de/L-seed
[L-seed.git] / src / dbclient.hs
1 import Lseed.Data
2 import Lseed.Data.Functions
3 import Lseed.DB
4 import Lseed.Grammar.Parse
5 import Lseed.Mainloop
6 import Lseed.Renderer.Cairo
7 import Control.Applicative
8 import Control.Monad
9 import Text.Printf
10
11
12 getDBGarden = spread <$> map compileDBCode <$> getCodeToRun
13   where spread gs = zipWith (\(u,n,g) p ->
14                  Planted ((fromIntegral p + 0.5) / l)
15                          u
16                          n
17                          g
18                          inititalPlant
19                 ) gs [0..]
20           where l = fromIntegral (length gs)
21
22 compileDBCode dbc =
23         case  parseGrammar "" (dbcCode dbc) of
24                 Left err          -> error (show err)
25                 Right grammarFile -> (dbcUserID dbc, dbcUserName dbc, grammarFile)
26 dbc2genome = either (error.show) id . parseGrammar "" . dbcCode
27
28 getDBUpdate planted = maybe (genome planted) dbc2genome <$>
29                       getUpdatedCodeFromDB (plantOwner planted)
30
31 main = do
32         obs <- cairoObserver
33         lseedMainLoop True obs (GardenSource getDBGarden getDBUpdate) 200