-- 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