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