arbitrary angles and lengths
authorJoachim Breitner <mail@joachim-breitner.de>
Fri, 6 Feb 2009 23:07:25 +0000 (00:07 +0100)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 6 Feb 2009 23:07:25 +0000 (00:07 +0100)
src/Lseed/Data.hs
src/Lseed/Geometry.hs
src/Lseed/LSystem.hs
src/Lseed/Renderer/Cairo.hs
src/main.hs

index 890c3ba..2f46e74 100644 (file)
@@ -14,8 +14,10 @@ data Planted = Planted
 -- | A plant, which is
 data Plant 
        = Bud -- ^ a bud, i.e. the end of a sprout
-       | Stipe Plant -- ^ a stipe with more of the plant next
-       | Fork Plant Plant -- ^ a fork with two successing pieces of a plant
+       | Stipe Double Plant -- ^ a stipe with a length (factor of stipeLength)
+                             --   and more of the plant next
+       | Fork Double Plant Plant -- ^ a fork with a sidewise offspring at a radial angle,
+                                  --   and a straing continuation 
        deriving (Show)
 
 -- | A (compiled) rule of an L-system, with a matching function and a weight
index 6a4d7c7..8103a54 100644 (file)
@@ -46,10 +46,10 @@ plantedToLines planted = runGeometryGenerator (plantPosition planted, 0) 0 $
 
 plantToGeometry :: Plant -> GeometryGenerator ()
 plantToGeometry Bud = return ()
-plantToGeometry (Stipe p) = addLine ((0,0),(0,stipeLength)) >>
-                           translated (0,stipeLength) (plantToGeometry p)
-plantToGeometry (Fork p1 p2) = rotated (-pi/4) (plantToGeometry p1) >>
-                               rotated ( pi/4) (plantToGeometry p2)
+plantToGeometry (Stipe len p) = addLine ((0,0),(0,len * stipeLength)) >>
+                               translated (0,len * stipeLength) (plantToGeometry p)
+plantToGeometry (Fork angle p1 p2) = rotated angle (plantToGeometry p1) >>
+                                                   (plantToGeometry p2)
 
 -- | Lines are annotated with its plant, identified by the position
 gardenToLines :: Garden -> [(Line, Double)]
index 6724703..4a03873 100644 (file)
@@ -12,11 +12,12 @@ applyLSystem rgen rules plant = if null choices
   where choices = go plant id
         applyLocal p prev = mapMaybe (\(w,r) -> fmap (\p' -> (w,prev p')) (r p)) rules
 
-       go p prev = applyLocal p prev `mappend` case p of
-                               Bud -> mempty
-                               Stipe p' -> go p' (prev . Stipe)
-                               Fork p1 p2 -> go p1 (prev . (\x -> Fork x p2)) `mappend`
-                                              go p2 (prev . (\x -> Fork p1 x))
+       go p prev = applyLocal p prev `mappend`
+                   case p of
+                       Bud -> mempty
+                       Stipe len p' -> go p' (prev . (Stipe len))
+                       Fork angle p1 p2 -> go p1 (prev . (\x -> Fork angle x p2)) `mappend`
+                                           go p2 (prev . (\x -> Fork angle p1 x))
 
 chooseWeighted rgen list = replicated !! (c-1)
   where replicated = concatMap (\(w,e) -> replicate w e) list
index 78d0a60..27f98fb 100644 (file)
@@ -66,15 +66,15 @@ renderPlant :: Plant -> Render ()
 renderPlant Bud = do
        arc 0 0 budSize 0 (2*pi)
        fill
-renderPlant (Stipe p) = do
+renderPlant (Stipe len p) = do
        moveTo 0 0
-       lineTo 0 stipeLength
+       lineTo 0 (len * stipeLength)
        stroke
-       translate 0 stipeLength
+       translate 0 (len * stipeLength)
        renderPlant p
-renderPlant (Fork p1 p2) = do
-       preserve $ rotate (-pi/4) >> renderPlant p1
-       preserve $ rotate (pi/4) >> renderPlant p2
+renderPlant (Fork angle p1 p2) = do
+       preserve $ rotate angle >> renderPlant p1
+       renderPlant p2
                
 renderLine (l@((x1,y1),(x2,y2)), _) = do
        setSourceRGB 0 1 0 
index 5081821..5a3383b 100644 (file)
@@ -14,7 +14,7 @@ main = do
                garden' <- forM garden $ \planted ->  do
                        rgen <- newStdGen
                        return $ growPlanted rgen planted
-               threadDelay (500*1000)
+               threadDelay (2*1000*1000)
                nextStep garden'
        nextStep testGarden
 
@@ -22,16 +22,27 @@ growPlanted rgen planted =
        planted { phenotype = applyLSystem rgen (genome planted) (phenotype planted) }
 
 testGarden =
-       [ Planted 0.3 testLSystem1 Bud
+       [ Planted 0.1 testLSystem1 Bud
+       , Planted 0.3 testLSystem2 Bud
+       , Planted 0.5 testLSystem3 Bud
        , Planted 0.7 testLSystem2 Bud
-       , Planted 0.5 testLSystem2 Bud
-       , Planted 0.9 testLSystem2 Bud
+       , Planted 0.9 testLSystem1 Bud
        ]
 
 testLSystem1 = [
-       (1, \x -> case x of Bud -> Just (Stipe Bud); _ -> Nothing )
+       (1, \x -> case x of Bud -> Just (Stipe Bud); _ -> Nothing )
        ]
 testLSystem2 = [
-       (3, \x -> case x of Bud -> Just (Stipe Bud); _ -> Nothing ),
-       (2, \x -> case x of Bud -> Just (Fork (Stipe Bud ) (Stipe Bud)); _ -> Nothing )
+       (3, \x -> case x of Bud -> Just (Stipe 2 Bud); _ -> Nothing ),
+       (2, \x -> case x of Bud -> Just (Fork ( pi/3) (Stipe 1 Bud) (Stipe 1 Bud)); _ -> Nothing ),
+       (1, \x -> case x of Bud -> Just (Fork (-pi/3) (Stipe 1 Bud) (Stipe 1 Bud)); _ -> Nothing )
+       ]
+testLSystem3 = [
+       (1, \x -> case x of Bud -> Just (Stipe 3 Bud); _ -> Nothing ),
+       (1, \x -> case x of Bud -> Just (
+                                       Fork (-2*pi/5) (Stipe 1 Bud) $
+                                       Fork (-1*pi/5) (Stipe 1 Bud) $
+                                       Fork ( 1*pi/5) (Stipe 1 Bud) $
+                                       Fork ( 2*pi/5) (Stipe 1 Bud) $
+                                       Stipe 1 Bud); _ -> Nothing )
        ]