Data commit

Task/Fractal-tree/Haskell/fractal-tree-1.hs

@@ -0,0 +1,12 @@
+import Graphics.Gloss
+
+type Model = [Picture -> Picture]
+
+fractal :: Int -> Model -> Picture -> Picture
+fractal n model pict = pictures $ take n $ iterate (mconcat model) pict
+
+tree1 _ = fractal 10 branches $ Line [(0,0),(0,100)]
+  where branches = [ Translate 0 100 . Scale 0.75 0.75 . Rotate 30
+                   , Translate 0 100 . Scale 0.5 0.5 . Rotate (-30) ]
+
+main = animate (InWindow "Tree" (800, 800) (0, 0)) white $ tree1 . (* 60)

Task/Fractal-tree/Haskell/fractal-tree-2.hs

@@ -0,0 +1,24 @@
+--animated tree
+tree2 t = fractal 8 branches $ Line [(0,0),(0,100)]
+  where branches = [ Translate 0 100 . Scale 0.75 0.75 . Rotate t
+                   , Translate 0 100 . Scale 0.6 0.6 . Rotate 0
+                   , Translate 0 100 . Scale 0.5 0.5 . Rotate (-2*t) ]
+
+--animated fractal clock
+circles t = fractal 10 model $ Circle 100
+  where model = [ Translate 0 50 . Scale 0.5 0.5 . Rotate t
+                , Translate 0 (-50) . Scale 0.5 0.5 . Rotate (-2*t) ]
+
+--Pythagoras tree
+pithagor _ = fractal 10 model $ rectangleWire 100 100
+  where model = [ Translate 50 100 . Scale s s . Rotate 45
+                , Translate (-50) 100 . Scale s s . Rotate (-45)]
+        s = 1/sqrt 2
+
+--Sierpinski pentagon
+pentaflake _ = fractal 5 model $ pentagon
+  where model =  map copy [0,72..288]
+        copy a = Scale s s . Rotate a . Translate 0 x
+        pentagon = Line [ (sin a, cos a) | a <- [0,2*pi/5..2*pi] ]
+        x = 2*cos(pi/5)
+        s = 1/(1+x)

Task/Fractal-tree/Haskell/fractal-tree-3.hs

@@ -0,0 +1,31 @@
+import Graphics.HGL.Window
+import Graphics.HGL.Run
+import Control.Arrow
+import Control.Monad
+import Data.List
+
+enumBase :: Int -> Int -> [[Int]]
+enumBase n = mapM (enumFromTo 0). replicate n. pred
+
+psPlus (a,b) (p,q) = (a+p, b+q)
+
+toInt :: Double -> Int
+toInt = fromIntegral.round
+
+intPoint = toInt *** toInt
+
+pts n =
+  map (map (intPoint.psPlus (100,0)). ((0,300):). scanl1 psPlus. ((r,300):). zipWith (\h a -> (h*cos a, h*sin a)) rs) hs
+  where
+    [r,h,sr,sh] = [50, pi/5, 0.9, 0.75]
+    rs   = take n $ map (r*) $ iterate(*sr) sr
+    lhs  = map (map (((-1)**).fromIntegral)) $ enumBase n 2
+    rhs  = take n $ map (h*) $ iterate(*sh) 1
+    hs   = map (scanl1 (+). zipWith (*)rhs) lhs
+
+fractalTree :: Int -> IO ()
+fractalTree n =
+   runWindow "Fractal Tree" (500,600)
+    (\w -> setGraphic w (overGraphics ( map polyline $ pts (n-1))) >> getKey w)
+
+main = fractalTree 10