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

32 lines
874 B
Haskell

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