[Haskell-cafe] Lindenmayer Systems, WAS: (no subject)

[Gwern Branwen]

On 2008.06.15 16:50:28 +0200, Adrian Neumann <aneumann at inf.fu-berlin.de> scribbled 6.9K characters:
> I screwed up the email, sorry about that. What I wanted to say was:
>
> Hello,
>
> as homework I was assigned to "design and draw an image" using the SOE
> Graphics library [1]. In order to impress my classmates I decided to draw
> a bush-like thingy using a Lindenmayer-System. It turns out quite nice
> [2], and so I thought I might share my code with you. Of course criticism
> is very welcome.
>
> Ok, here we go:
>
>> {- I downloaded the source and put my file in the same directory
>>    You may need to adjust the imports -}
>> module Main where
>> import Picture
>> import Draw -- change xWin to 1000 and yWin to 700 for this to work
>> import EnableGUI -- I use a Mac
>> import SOE hiding (Region)
>> import qualified SOE as G (Region)
>> import Data.List
>> import Random
>>
>> -- lines are not Shapes unfortunately
>> linie = ((Shape $ Polygon [(-0.1,-0.01),(-0.1,0.01),(0.1,0.01),
>> (0.1,-0.01)]), (-0.1,0), (0.1,0))
>>
>> main = enableGUI >> do
>>     w <- openWindow "Lindenmayer System" (xWin, yWin)
>>     newStdGen
>>     g <- getStdGen
>>     drawPic w (aufgabe2 g)
>>     k <- getKey w
>>     if (k=='q') then do
>>         closeWindow w
>>         return () else do
>>             clearWindow w
>>             main
>>
>> -- one big ugly line of code, not that interesting though
>> aufgabe2 g= dasBild where
>>     r = rotateRegion (pi/2) $ Translate (-2.5,0) $ renderLSystem linie
>> (lSystem 20 g)
>>     dasBild = Region White r `Over` Region Black ( Translate (0,-1.8) $
>> Scale (1,0.3)$ Translate (0,-2.6) $ rotateRegion (pi/2+pi/3) $
>> Translate (0,2.6) $ r) `Over` Region Green (Shape $ Polygon
>> [(-5,-3.5),(-5,-1.5),(5,-1.5),(5,-3.5)]) `Over` Region Yellow
>> (Translate (4,1.5) (Shape $ circle (0.5))) `Over`
>>             Region Blue (Shape $ Rectangle 14 7)
>>
>> -- start of the interesting part:
>> -- A - Axiom, the base shape we use for rendering later
>> --F - Forward
>> --Branch - what it says
>>
>> data LSys = A LSys | F LSys | Branch StdGen [LSys] LSys | Done
>> deriving Show
>>
>> -- a Axiom is a region with two connector points
>> type Axiom = (Region, Vertex, Vertex)
>>
>> -- this seems not to be used anymore?
>>
>> scaleAxiom :: Float -> Axiom -> Axiom
>> scaleAxiom f (r,u,v) = (Scale (f,f) r, f .*. u, f .*. v)
>>
>> -- just for testing purposes
>> testLSys = A (Branch (mkStdGen 5) [A (F ((Branch (mkStdGen 5) [A
>> (Branch (mkStdGen 5) [A (F ((Branch (mkStdGen 5) [A (F Done), A (F
>> Done)] Done))), A (F Done)] Done), A (F Done)] Done))), A (F Done)]
>> Done)
>>
>> -- a 2D rotation matrix
>> drehM :: Float -> (Float, Float, Float, Float)
>> drehM w = (cos w, -sin w, sin w, cos w)
>>
>> -- matrix vector multiplication
>> (.**.) :: (Float, Float, Float, Float) -> Vertex -> Vertex
>> (.**.) (a,b,c,d) (px,py) = (a*px+b*py, c* px+d*py)
>>
>> -- other vector stuff
>> (.-.) (a,b) (c,d) = (a-c,b-d)
>> (.+.) (a,b) (c,d) = (a+c,b+d)
>> (.*.) l (c,d) = (c*l,d*l)
>> abs' (a,b) = (abs a, abs b)
>> betr (a,b) = sqrt (a*a+b*b)
>>
>> -- SOE doesn't come with a way to rotate Regions, so I wrote my own
>> rotateRegion :: Float -> Region -> Region
>> rotateRegion f (Shape s) = Shape (rotateS f s)
>> rotateRegion f (Translate v r) = Translate ((drehM f).**.v)
>> (rotateRegion f r)
>>
>> -- the scaling part is not right I think. Everything seems to break if
>> I try to incorporate scaling
>> -- into the rendering
>>
>> rotateRegion f (Scale v r) = Scale ((betr v/ betr nv) .*. nv)
>> (rotateRegion f r) where
>>     x = ((drehM f).**. (fst v,0))
>>     y = ((drehM f) .**. (0,snd v))
>>     nv = (abs' x) .+. (abs' y)
>> rotateRegion f (Complement r) =Complement (rotateRegion f r)
>> rotateRegion f (Union r1 r2) = Union (rotateRegion f r1) (rotateRegion
>> f r2)
>> rotateRegion f (Intersect r1 r2) = Intersect (rotateRegion f r1)
>> (rotateRegion f r2)
>> rotateRegion f (Xor r1 r2) = Xor (rotateRegion f r1) (rotateRegion f
>> r2)
>> rotateRegion _ s=s
>>
>> rotateS f (Polygon pts) = Polygon (map ((drehM f) .**.) pts)
>> rotateS f x = x
>>
>> -- nondeterministically generate a word in our LSys language
>> -- lots of copy&paste here, any way to do this better?
>>
>> lSystem :: Int -> StdGen -> LSys
>> lSystem n g = f n g (A undefined) where
>>     f :: Int -> StdGen -> LSys -> LSys
>>     f 0 _ _ = Done
>>     f (n+1) g (A _)
>>         | choose >= 1 = A (f n ng (F undefined))
>>         | choose == 0 = A (f n ng (Branch ng [f n ng' (A undefined), f
>> n ng'' (A undefined)] undefined)) where
>>             (choose, ng) = randomR (0::Int,3::Int) g
>>             (ng', ng'') = split ng
>>     f (n+1) g (F _)
>>         | choose >= 1 = F (f n ng (F undefined))
>>         | choose == 0 = F (f n ng (Branch ng [f n ng' (A undefined), f
>> n ng'' (A undefined)] undefined)) where
>>             (choose, ng) = randomR (0::Int,3::Int) g
>>             (ng', ng'') = split ng
>>     f (n+1) g (Branch h lSys _)
>>         | choose >= 1 = Branch h lSys  (f n ng (F undefined))
>>         | choose == 0 = Branch h lSys (f n ng (Branch ng [f n ng' (A
>> undefined), f n ng'' (A undefined)] undefined)) where
>>             (choose, ng) = randomR (0::Int,5::Int) g
>>             (ng', ng'') = split ng
>>
>> -- recursivly render a LSys
>> renderLSystem :: Axiom -> LSys -> Region
>> renderLSystem _ Done = Empty
>> renderLSystem (r,u,v) (A lSys) = r `Union` renderLSystem (r,u,v) lSys
>> renderLSystem (r,u,v) (F lSys) = r'' `Union` renderLSystem (r'', u .+.
>> o , v .+.o) lSys where
>>     r'' =  Translate o   $  r
>>     o = (v .-. u)
>> renderLSystem (r,u,v) (Branch g lSys rest) =
>>     theBranches `Union` renderLSystem (r,u,v) rest where
>>         theBranches = Translate o $ foldr Union Empty $
>> 	-- we need to rotate around the u-Connector, not around (0,0)
>> 	-- thus translation
>>             map (Translate u) $ zipWith ($) rotations (map ((Translate
>> ((0,0).-.u)).(renderLSystem (r,u,v))) lSys)
>>         rotations = map rotateRegion (randomRs (-pi/4,pi/3) g) --
>> branches are rotated randomly
>>         o = (v .-. u)
>
> What do you think?
>
> Adrian
>
> [1] http://www.haskell.org/soe/graphics.htm
> [2] http://img149.imageshack.us/my.php?image=bild1tf4.png

That's interesting, nice and short. The output actually reminds me a lot of Nymphaea <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/nymphaea>; have you seen't?

--
gwern
Maple 82 Visa/BCC noise noise FCA Blacknet TELINT WISDIM S/Key
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
Url : http://www.haskell.org/pipermail/haskell-cafe/attachments/20080615/863a98da/attachment.bin