Guest User

Untitled

a guest
Feb 21st, 2018
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.13 KB | None | 0 0
  1. -- tree.hs
  2. module Main where
  3. import Graphics.Rendering.Cairo
  4. import Canvas
  5. import System.Random
  6.  
  7. main = do
  8. gen <- getStdGen
  9. let ns = randoms gen :: [Double]
  10. canvas (draw ns) 600 600
  11.  
  12. draw ns w h t = do
  13. color white
  14. rectangle 0 0 w h
  15. fill
  16. color black
  17. drawTree ns w h t
  18.  
  19. drawTree ns w h t = do
  20. translate (w/2) (h+5)
  21. mapM_ strokeWidthLine tree
  22. where tree = map (mapWidthLine (uscaleP 25)) $ branch ns 8 (pi/2*sin t)
  23.  
  24. branch _ 0 _ = []
  25. branch (r1:r2:rs) n angle =
  26. (thickness, points) : subBranches
  27. where
  28. da = angularDistance 0 angle
  29. scale = r2 * 5 * ((1-(abs da / pi)) ** 2)
  30. points = map (rotateP (angle + r1 * da) . uscaleP scale) [(0,0), (0, -1)]
  31. thickness = n
  32. (x,y) = last points
  33. subBranches = map (mapWidthLine (translateP x y)) (left ++ right)
  34. left = branch (takeOdd rs) (n-1) (angle-r1*pi/4)
  35. right = branch (takeEven rs) (n-1) (angle+r2*pi/4)
  36.  
  37. takeOdd [] = []
  38. takeOdd [x] = []
  39. takeOdd (_:x:xs) = x : (takeOdd xs)
  40.  
  41. takeEven [] = []
  42. takeEven [x] = [x]
  43. takeEven (x:_:xs) = x : (takeEven xs)
Add Comment
Please, Sign In to add comment