hgl-example-0.0.2: src/Sierpinski.hs

{- |
probabilistic Sierpinski triangle

See Computer Graphics I lecture at the university of Halle.
-}
module Sierpinski (demo, ) where

import Graphics.HGL.Utils (runWindow, )
import Graphics.HGL.Draw.Picture (polyline, )
import Graphics.HGL.Window (directDraw, )

import System.Random (RandomGen, randomRs, mkStdGen, )
import Data.Array (listArray, bounds, (!), )

import Data.Tuple.HT (mapPair, )


points :: (Fractional a, RandomGen g) =>
   g -> ((a,a), (a,a), (a,a)) -> [(a,a)]
points g (t0,t1,t2) =
   let vertices = listArray (0,2::Int) [t0,t1,t2]
   in  scanl1 (\(xt,yt) (xk,yk) -> ((xt+xk)/2, (yt+yk)/2))
              (map (vertices!) (randomRs (bounds vertices) g))

demo :: IO ()
demo =
   let size = 1000
       toInt :: Double -> Int
       toInt x = round (x * fromIntegral size)
       setDot p = polyline [p, p]
       graphics =
          map (setDot . mapPair (toInt, toInt)) $
          points (mkStdGen 834750) $
          ((0, 0), (1, 0), (0.5, sqrt 3 / 2))
   in  runWindow "Sierpinski" (size,size)
                 (\w -> mapM_ (directDraw w) graphics)