--- Paul Hudak: Snowflake
--- See: The Haskell School of Expression, Chapter 3

import SOEGraphics

spaceClose :: Window -> IO ()
spaceClose w =
    do k <- getKey w
       if k == ' ' then closeWindow w
	  else spaceClose w

mkpoint :: (Double, Double) -> Point
mkpoint (x, y) = (round x, round y)

fillTri :: Window 
	   -> (Double, Double) -> (Double, Double) -> (Double, Double) 
	   -> Color -> IO ()
fillTri w p1 p2 p3 c
        = drawInWindow w (withColor c 
			  (polygon [mkpoint p1, 
				    mkpoint p2,
				    mkpoint p3,
				    mkpoint p1]))
        
minSize :: Double
minSize = 8.0

snowflake :: Window -> (Double, Double) -> Double -> IO ()
snowflake w (x, y) size 
    = let
        a = size/2
	h = sqrt (3.0/4.0)*size
	b = h/3
	c = 2*(h/3) 
	p1 = (x-a, y+b)
	p2 = (x+a, y+b)
	p3 = (x, y-c)
	q1 = (x-a, y-b)
	q2 = (x+a, y-b)
	q3 = (x, y+c)
      in
        if size <= minSize then 
	   do fillTri w p1 p2 p3 White
	      fillTri w q1 q2 q3 White
        else
	   let size' = size/2.8
	   in
             do fillTri w p1 p2 p3 White
		fillTri w q1 q2 q3 White
		snowflake w p1 size'
		snowflake w q3 size'
		snowflake w p2 size'
		snowflake w q2 size'
		snowflake w p3 size'
		snowflake w q1 size'

main0 
  = runGraphics (
      do w <- openWindow "Snow Flake" (500, 500)
         snowflake w (250.0, 250.0) 249.0
	 spaceClose w)