Merge branch 'master' of git+ssh://gitosis@nomeata.de/L-seed
authorSven Hecht <sven@sven-laptop.(none)>
Fri, 26 Jun 2009 07:19:27 +0000 (09:19 +0200)
committerSven Hecht <sven@sven-laptop.(none)>
Fri, 26 Jun 2009 07:19:27 +0000 (09:19 +0200)
12 files changed:
L-seed.cabal
src/.gitignore
src/Lseed/DB.hs
src/Lseed/Data.hs
src/Lseed/Renderer/Cairo.hs
src/dbclient.hs
src/dbscorer.hs
src/renderAsPNG.hs [new file with mode: 0644]
web/js/communication.js
web/php/page/myplants.pg
web/php/page/nav.pg
web/php/page/season.pg

index 6da1e70..9c4c5c5 100644 (file)
@@ -89,6 +89,12 @@ Executable runGarden
   if ! flag(RendererCairo)
     Buildable:    False
 
+Executable renderAsPNG
+  Main-Is:        renderAsPNG.hs
+  Hs-Source-Dirs: src/
+  if ! flag(RendererCairo)
+    Buildable:    False
+
 Executable validate
   Main-Is:        validate.hs
   Hs-Source-Dirs: src/
index 8e61dbd..2544d5e 100644 (file)
@@ -7,3 +7,4 @@ dbclient
 dbscorer
 fastScorer
 tags
+renderAsPNG
index e28445a..c5c8df7 100644 (file)
@@ -23,16 +23,16 @@ data DBCode = DBCode
        }
        deriving (Show)
 
-withLseedDB ::  (Connection -> IO t) -> IO t
-withLseedDB what = do
-       dn <- readFile "../db.conf"
+withLseedDB :: FilePath -> (Connection -> IO t) -> IO t
+withLseedDB conf what = do
+       dn <- readFile conf
        conn <- connectODBC dn  
        res <- what conn
        disconnect conn
        return res
 
-getCodeToRun ::  IO [DBCode]
-getCodeToRun = withLseedDB $ \conn -> do
+getCodeToRun :: FilePath -> IO [DBCode]
+getCodeToRun conf = withLseedDB conf $ \conn -> do
        let getCodeQuery = "SELECT plant.ID AS plantid, user.ID AS userid, code, plant.Name AS plantname, user.Name AS username from plant, user WHERE user.NextSeed = plant.ID;"
        stmt <- prepare conn getCodeQuery
        execute stmt []
@@ -44,8 +44,8 @@ getCodeToRun = withLseedDB $ \conn -> do
                       (fromSql (m ! "plantid"))
                       (fromSql (m ! "code"))
 
-getUpdatedCodeFromDB :: Integer -> IO (Maybe DBCode)
-getUpdatedCodeFromDB userid = withLseedDB $ \conn -> do
+getUpdatedCodeFromDB :: FilePath -> Integer -> IO (Maybe DBCode)
+getUpdatedCodeFromDB conf userid = withLseedDB conf $ \conn -> do
        let query = "SELECT plant.ID AS plantid, user.ID AS userid, code, plant.Name AS plantname, user.Name AS username from plant, user WHERE user.NextSeed = plant.ID AND user.ID = ?;"
        stmt <- prepare conn query
        execute stmt [toSql userid]
@@ -57,10 +57,10 @@ getUpdatedCodeFromDB userid = withLseedDB $ \conn -> do
                       (fromSql (m ! "plantid"))
                       (fromSql (m ! "code"))
 
-addFinishedSeasonResults garden = withLseedDB $ \conn -> do 
+addFinishedSeasonResults conf garden = withLseedDB conf $ \conn -> do 
        let owernerscore = M.toList $ foldr go M.empty garden
                where go p = M.insertWith (+) (plantOwner p) (plantLength (phenotype p))
-       run conn "INSERT INTO SEASON VALUES (NULL, False)" []
+       run conn "INSERT INTO season VALUES (NULL, False)" []
        stmt <- prepare conn "SELECT LAST_INSERT_ID()"
        execute stmt []
        id <- (head . head) `fmap` fetchAllRows' stmt
index 75b1daf..6924527 100644 (file)
@@ -7,6 +7,7 @@ import Control.Applicative ((<$>),(<*>),pure)
 import Control.Arrow (second)
 import Data.Monoid
 import System.Time (ClockTime)
+import Data.Monoid
 
 -- | User Tag
 type UserTag = String
@@ -82,7 +83,7 @@ data ScreenContent = ScreenContent
 
 -- | Main loop observers
 data Observer = Observer {
-       -- | Called once, before the main loop starts
+       -- | Called once per season, before the main loop starts
          obInit :: IO ()
        -- | Called once per tick, with the current tick number and the current
        -- state of the garden
@@ -92,8 +93,10 @@ data Observer = Observer {
        , obGrowingState :: (ClockTime -> ScreenContent) -> IO ()
        -- | Called before the main loop quits, with the last state of the garden
        , obFinished :: GrowingGarden -> IO ()
+       -- | Called once before program termination
+       , obShutdown :: IO ()
        }
-nullObserver = Observer (return ()) (\_ _ -> return ()) (\_ -> return ()) (\_ -> return ())
+nullObserver = Observer (return ()) (\_ _ -> return ()) (\_ -> return ()) (\_ -> return ()) (return ())
 
 -- | Methods to get the initial garden and the updated code when a plant multiplies
 data GardenSource = GardenSource {
@@ -187,3 +190,14 @@ instance Foldable Planted where
 
 instance Traversable Planted where
        sequenceA planted = (\x -> planted { phenotype = x }) <$> sequenceA (phenotype planted)
+
+instance Monoid Observer where
+       mempty = nullObserver
+       obs1 `mappend` obs2 = nullObserver {
+               obInit = obInit obs1 >> obInit obs2,
+               obState = \d g -> obState obs1 d g >> obState obs2 d g,
+               obGrowingState = \f -> obGrowingState obs1 f >> obGrowingState obs2 f,
+               obFinished = \g -> obFinished obs1 g >> obFinished obs2 g,
+               obShutdown = obShutdown obs1 >> obShutdown obs2
+               }
+       
index db79dc9..bd52f9c 100644 (file)
@@ -10,12 +10,32 @@ import Lseed.Data
 import Lseed.Data.Functions
 import Lseed.Constants
 import Lseed.Geometry
+import Lseed.StipeInfo
 import Text.Printf
 import System.Time
 
 colors :: [ (Double, Double, Double) ]
 colors = cycle $ [ (r,g,b) | r <- [0.0,0.4], b <- [0.0, 0.4], g <- [1.0,0.6,0.8]]
 
+pngObserver :: IO Observer
+pngObserver = return $ nullObserver {
+       obFinished = \garden -> do
+               let (w,h) = (400,400)
+               withImageSurface FormatRGB24 w h $ \sur -> do
+                       renderWith sur $ do
+                               -- Set up coordinates
+                               translate 0 (fromIntegral h)
+                               scale 1 (-1)
+                               scale (fromIntegral w) (fromIntegral w)
+                               translate (-0.5) 0
+                               scale 2 2
+                               translate 0 groundLevel
+                               setLineWidth stipeWidth
+
+                               render (pi/3) (annotateGarden (pi/3) garden)
+                       surfaceWriteToPNG sur "/dev/fd/1"
+       }
+
 cairoObserver :: IO Observer
 cairoObserver = do
        initGUI
@@ -61,8 +81,7 @@ cairoObserver = do
                { obGrowingState = \scGen -> do
                        writeIORef currentGardenRef scGen
                        widgetQueueDraw canvas
-               , obFinished = \_ ->
-                       mainQuit
+               , obShutdown = mainQuit
                }
 
 render :: Double -> AnnotatedGarden -> Render ()
@@ -80,7 +99,7 @@ render angle garden = do
 
        renderGround
 
-       renderInfo angle garden
+       --renderInfo garden
 
 renderPlanted :: AnnotatedPlanted -> Render ()
 renderPlanted planted = preserve $ do
@@ -198,7 +217,7 @@ renderLightedPoly ((x1,y1),(x2,y2),(x3,y3),(x4,y4), intensity) = do
                setSourceRGB 0 0 intensity
                fill
 
-renderInfo angle garden = do
+renderInfo garden = do
        forM_ garden $ \planted -> do
                let x = plantPosition planted
                {-
index eaae6b5..db55d69 100644 (file)
@@ -7,9 +7,10 @@ import Lseed.Renderer.Cairo
 import Control.Applicative
 import Control.Monad
 import Text.Printf
+import System.Environment
+import Data.Monoid
 
-
-getDBGarden = spread <$> map compileDBCode <$> getCodeToRun
+getDBGarden conf = spread <$> map compileDBCode <$> getCodeToRun conf
   where spread gs = zipWith (\(u,n,g) p ->
                 Planted ((fromIntegral p + 0.5) / l)
                         u
@@ -25,9 +26,28 @@ compileDBCode dbc =
                Right grammarFile -> (dbcUserID dbc, dbcUserName dbc, grammarFile)
 dbc2genome = either (error.show) id . parseGrammar "" . dbcCode
 
-getDBUpdate planted = maybe (genome planted) dbc2genome <$>
-                      getUpdatedCodeFromDB (plantOwner planted)
+getDBUpdate conf planted = maybe (genome planted) dbc2genome <$>
+                      getUpdatedCodeFromDB conf (plantOwner planted)
+
+scoringObs conf = nullObserver {
+       obFinished = \garden -> do
+               forM_ garden $ \planted -> do
+                       printf "Plant from %d at %.4f: Total size %.4f\n"
+                               (plantOwner planted)
+                               (plantPosition planted)
+                               (plantLength (phenotype planted))
+               addFinishedSeasonResults conf garden
+       }
 
 main = do
-       obs <- cairoObserver
-       lseedMainLoop True obs (GardenSource getDBGarden getDBUpdate) 200
+       args <- getArgs
+       case args of
+         [conf] -> do
+               obs <- cairoObserver
+               forever $ lseedMainLoop True
+                             (obs `mappend` scoringObs conf)
+                             (GardenSource (getDBGarden conf) (getDBUpdate conf))
+                             30
+         _ -> do
+               putStrLn "L-Seed DB client application."
+               putStrLn "Please pass DB configuration file on the command line."
index bcf86a7..be86ede 100644 (file)
@@ -6,8 +6,9 @@ import Lseed.Mainloop
 import Control.Applicative
 import Control.Monad
 import Text.Printf
+import System.Environment
 
-getDBGarden = spread <$> map compileDBCode <$> getCodeToRun
+getDBGarden conf = spread <$> map compileDBCode <$> getCodeToRun conf
   where spread gs = zipWith (\(u,n,g) p ->
                 Planted ((fromIntegral p + 0.5) / l)
                         u
@@ -24,17 +25,27 @@ compileDBCode dbc =
 
 dbc2genome = either (error.show) id . parseGrammar "" . dbcCode
 
-getDBUpdate planted = maybe (genome planted) dbc2genome <$>
-                      getUpdatedCodeFromDB (plantOwner planted)
+getDBUpdate conf planted = maybe (genome planted) dbc2genome <$>
+                      getUpdatedCodeFromDB conf (plantOwner planted)
 
-scoringObs = nullObserver {
+scoringObs conf = nullObserver {
        obFinished = \garden -> do
                forM_ garden $ \planted -> do
                        printf "Plant from %d at %.4f: Total size %.4f\n"
                                (plantOwner planted)
                                (plantPosition planted)
                                (plantLength (phenotype planted))
-               addFinishedSeasonResults garden
+               addFinishedSeasonResults conf garden
        }
 
-main = lseedMainLoop False scoringObs (GardenSource getDBGarden getDBUpdate) 10
+main = do
+       args <- getArgs
+       case args of
+         [conf] -> do
+               lseedMainLoop False
+                             (scoringObs conf)
+                             (GardenSource (getDBGarden conf) (getDBUpdate conf))
+                             10
+         _ -> do
+               putStrLn "L-Seed DB client application."
+               putStrLn "Please pass DB configuration file on the command line."
diff --git a/src/renderAsPNG.hs b/src/renderAsPNG.hs
new file mode 100644 (file)
index 0000000..621d13e
--- /dev/null
@@ -0,0 +1,24 @@
+import Lseed.Data
+import Lseed.Data.Functions
+import Lseed.Grammar.Parse
+import Lseed.Constants
+import Lseed.Mainloop
+import Control.Monad
+import Debug.Trace
+import System.Environment
+import System.Time
+import System.Random
+import Lseed.Renderer.Cairo
+import Data.Maybe
+
+readArgs doit = do
+       args <- getArgs
+       let name = fromMaybe "Some Plant" $ listToMaybe args
+
+       file <- getContents
+       let genome = either (error.show) id $ parseGrammar name file 
+       doit $ [Planted 0.5 0 name genome inititalPlant]
+               
+main = readArgs $ \garden -> do
+       obs <- pngObserver
+       lseedMainLoop False obs (constGardenSource garden) 10
index 79451ff..9d27db4 100644 (file)
@@ -464,7 +464,7 @@ Lseed.Communication = function() {
        // === Season Managerment ===
        
        this.GetSeasonList = function() {
-               Ext.MessageBox.wait("Staffeln werden geladen.", "Wird geladen...");
+               Ext.MessageBox.wait("Saisons werden geladen.", "Wird geladen...");
                
                this.sendMessage(Lseed.MessageCommands.RPC, { func: 'GetSeasonList' });
        };
index 44e654a..8d9bca8 100644 (file)
@@ -6,7 +6,7 @@
        ,layout: 'fit'
        ,items: [{
                id: "plantlistgrid"
-               ,title: "Mein Pflanzen"
+               ,title: "Saisons"
                ,xtype: 'grid'
                ,autoExpandColumn: 'Code'
                ,plugins: [new Ext.ux.RowEditor({
index c973d87..408b176 100644 (file)
@@ -19,7 +19,7 @@
                ,leaf: true
        },{
                id: 'season'
-               ,text: "Aktuelle Staffel"
+               ,text: "Aktuelle Saison"
                ,leaf: true
        }]
 }
index 8145c61..16c86c2 100644 (file)
@@ -2,11 +2,11 @@
        id: 'ContentPanel_season'
        ,closable: true
        ,style: 'padding: 5px;'
-       ,title: 'Aktuelle Staffel'
+       ,title: 'Aktuelle Saison'
        ,layout: 'fit'
        ,items: [{
                id: "seasonlistgrid"
-               ,title: "Mein Pflanzen"
+               ,title: "Meine Pflanzen"
                ,xtype: 'grid'
                ,autoExpandColumn: 'User'
                ,view: new Ext.grid.GroupingView({