-- Sierpinski Carpet                                   --
-- Copied from Paul Hudak's Haskell School of Expression --

import SOE

fillSqu :: Window -> Int -> Int -> Int -> IO ()
fillSqu w x y size =
  drawInWindow w (withColor Blue 
                    (polygon [(x,y), (x + size, y), (x + size, y + size), (x, y + size)]))

minSize :: Int
minSize = 1

carpet :: Window -> Int -> Int -> Int -> IO ()
carpet w x y size =
  if size <= minSize then 
    fillSqu w x y size 
  else 
    let size3 = size `div` 3 in
    do carpet w (x-size3) y size3
       carpet w (x-size3) (y-size3) size3
       carpet w (x-size3) (y+size3) size3
       carpet w (x+size3) y size3
       carpet w (x+size3) (y-size3) size3
       carpet w (x+size3) (y+size3) size3
       carpet w x (y-size3) size3
       carpet w x (y+size3) size3

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

main =
  runGraphics $ do
    w <- openWindow "Sierpinski's Carpet" (360, 360)
    carpet w 180 180 256
    spaceClose w