Skip to content

Instantly share code, notes, and snippets.

@ntj

ntj/tree.hs

Forked from kig/gist:34505
Created December 30, 2010 17:28
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save ntj/760023 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save ntj/760023 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. ntj renamed this gist Dec 30, 2010. 1 changed file with 43 additions and 43 deletions.
    86 changes: 43 additions & 43 deletions gistfile1.hs → tree.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -1,43 +1,43 @@
    -- tree.hs
    module Main where
    import Graphics.Rendering.Cairo
    import Canvas
    import System.Random

    main = do
    gen <- getStdGen
    let ns = randoms gen :: [Double]
    canvas (draw ns) 600 600

    draw ns w h t = do
    color white
    rectangle 0 0 w h
    fill
    color black
    drawTree ns w h t

    drawTree ns w h t = do
    translate (w/2) (h+5)
    mapM_ strokeWidthLine tree
    where tree = map (mapWidthLine (uscaleP 25)) $ branch ns 8 (pi/2*sin t)

    branch _ 0 _ = []
    branch (r1:r2:rs) n angle =
    (thickness, points) : subBranches
    where
    da = angularDistance 0 angle
    scale = r2 * 5 * ((1-(abs da / pi)) ** 2)
    points = map (rotateP (angle + r1 * da) . uscaleP scale) [(0,0), (0, -1)]
    thickness = n
    (x,y) = last points
    subBranches = map (mapWidthLine (translateP x y)) (left ++ right)
    left = branch (takeOdd rs) (n-1) (angle-r1*pi/4)
    right = branch (takeEven rs) (n-1) (angle+r2*pi/4)

    takeOdd [] = []
    takeOdd [x] = []
    takeOdd (_:x:xs) = x : (takeOdd xs)

    takeEven [] = []
    takeEven [x] = [x]
    takeEven (x:_:xs) = x : (takeEven xs)
    -- tree.hs
    module Main where
    import Graphics.Rendering.Cairo
    import Canvas
    import System.Random

    main = do
    gen <- getStdGen
    let ns = randoms gen :: [Double]
    canvas (draw ns) 600 600

    draw ns w h t = do
    color white
    rectangle 0 0 w h
    fill
    color black
    drawTree ns w h t

    drawTree ns w h t = do
    translate (w/2) (h+5)
    mapM_ strokeWidthLine tree
    where tree = map (mapWidthLine (uscaleP 25)) $ branch ns 8 (pi/2*sin t)

    branch _ 0 _ = []
    branch (r1:r2:rs) n angle =
    (thickness, points) : subBranches
    where
    da = angularDistance 0 angle
    scale = r2 * 5 * ((1-(abs da / pi)) ** 2)
    points = map (rotateP (angle + r1 * da) . uscaleP scale) [(0,0), (0, -1)]
    thickness = n
    (x,y) = last points
    subBranches = map (mapWidthLine (translateP x y)) (left ++ right)
    left = branch (takeOdd rs) (n-1) (angle-r1*pi/4)
    right = branch (takeEven rs) (n-1) (angle+r2*pi/4)

    takeOdd [] = []
    takeOdd [x] = []
    takeOdd (_:x:xs) = x : (takeOdd xs)

    takeEven [] = []
    takeEven [x] = [x]
    takeEven (x:_:xs) = x : (takeEven xs)
  2. @kig kig revised this gist Dec 10, 2008. 1 changed file with 1 addition and 1 deletion.
    2 changes: 1 addition & 1 deletion gistfile1.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -29,7 +29,7 @@ module Main where
    scale = r2 * 5 * ((1-(abs da / pi)) ** 2)
    points = map (rotateP (angle + r1 * da) . uscaleP scale) [(0,0), (0, -1)]
    thickness = n
    [_,(x,y)] = points
    (x,y) = last points
    subBranches = map (mapWidthLine (translateP x y)) (left ++ right)
    left = branch (takeOdd rs) (n-1) (angle-r1*pi/4)
    right = branch (takeEven rs) (n-1) (angle+r2*pi/4)
  3. @kig kig created this gist Dec 10, 2008.
    43 changes: 43 additions & 0 deletions gistfile1.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,43 @@
    -- tree.hs
    module Main where
    import Graphics.Rendering.Cairo
    import Canvas
    import System.Random

    main = do
    gen <- getStdGen
    let ns = randoms gen :: [Double]
    canvas (draw ns) 600 600

    draw ns w h t = do
    color white
    rectangle 0 0 w h
    fill
    color black
    drawTree ns w h t

    drawTree ns w h t = do
    translate (w/2) (h+5)
    mapM_ strokeWidthLine tree
    where tree = map (mapWidthLine (uscaleP 25)) $ branch ns 8 (pi/2*sin t)

    branch _ 0 _ = []
    branch (r1:r2:rs) n angle =
    (thickness, points) : subBranches
    where
    da = angularDistance 0 angle
    scale = r2 * 5 * ((1-(abs da / pi)) ** 2)
    points = map (rotateP (angle + r1 * da) . uscaleP scale) [(0,0), (0, -1)]
    thickness = n
    [_,(x,y)] = points
    subBranches = map (mapWidthLine (translateP x y)) (left ++ right)
    left = branch (takeOdd rs) (n-1) (angle-r1*pi/4)
    right = branch (takeEven rs) (n-1) (angle+r2*pi/4)

    takeOdd [] = []
    takeOdd [x] = []
    takeOdd (_:x:xs) = x : (takeOdd xs)

    takeEven [] = []
    takeEven [x] = [x]
    takeEven (x:_:xs) = x : (takeEven xs)