Added Snowflake Fractal exerciseHEADmaster

2 files changed, 57 insertions, 6 deletions

diff --git a/src/ch3/Main.hs b/src/ch3/Main.hs
index 217f50d..26f5d5f 100644
--- a/src/ch3/Main.hs
+++ b/src/ch3/Main.hs
@@ -1,4 +1,4 @@
 import SimpleGraphics
 
 main :: IO ()
-main = main0
+main = main4
diff --git a/src/ch3/SimpleGraphics.hs b/src/ch3/SimpleGraphics.hs
index 57f3e16..9d88aea 100644
--- a/src/ch3/SimpleGraphics.hs
+++ b/src/ch3/SimpleGraphics.hs
@@ -1,4 +1,4 @@
-module SimpleGraphics where
+ module SimpleGraphics where
 
 import Graphics.SOE
 
@@ -7,11 +7,11 @@ main0 = runGraphics $
            drawInWindow w (text (100,200) "HelloGraphicsWolrd")
            spaceClose w
 
-
 spaceClose :: Window -> IO ()
 spaceClose w = do k <- getKey w
                   if k == ' ' then closeWindow w
                              else spaceClose w
+
 getLine :: IO String
 getLine = do c <- getChar
              if c == '\n' then return ""
@@ -37,8 +37,8 @@ main2 = runGraphics $
 
 fillTri :: Window -> Int -> Int -> Int -> IO ()
 fillTri w x y size =
-  drawInWindow w (withColor Blue
-                 (polygon [(x,y), (x + size, y), (x, y - size), (x, y)]))
+  drawInWindow w $ withColor Blue
+                 $ polygon [(x,y), (x + size, y), (x, y - size), (x, y)]
 
 minSize :: Int
 minSize = 8
@@ -53,6 +53,57 @@ sierpinskiTri w x y size =
              sierpinskiTri w (x+size2) y size2
 
 main3 = runGraphics $
-        do w <- openWindow "Sierpinski's Triangle" (400, 400)
+        do w <- openWindow "Sierpinski's Triangle" (windowSize, windowSize)
+           drawInWindow w $ overGraphics [
+               (withColor Red $ text (1,1) "(0,0)")
+             , (withColor Red $ text (1, windowSize) ("(0," ++ (show windowSize) ++ ")"))
+             , (withColor Red $ text (windowSize+1, 1) ("("++(show windowSize) ++ ",0)"))
+             , (withColor Red $ text (windowSize-1, windowSize-1) ("("++(show windowSize) ++ "," ++ (show windowSize) ++ ")"))
+             , (withColor White $ polygon [(0,0), (0, windowSize), (windowSize, windowSize), (windowSize, 0)])
+             ]
            sierpinskiTri w 50 300 256
            spaceClose w
+        where windowSize = 400
+
+snowflake :: Window -> IO ()
+snowflake w = do
+  drawTri w x y m 0 False -- draw first triangle w/flat top
+  flake   w x y m 0 True  -- begin recursion to complete job
+  where m = 81
+        x = 250
+        y = 250
+
+flake :: Window -> Int -> Int -> Int -> Int -> Bool -> IO ()
+flake w x y m c o = do
+  drawTri w x y m c o  -- draw second triangle
+  let c1 = (c+1)`mod`5 -- get next color
+  if (m<=3) then return ()  -- if too small, we're done
+     else do
+       flake w (x-2*m) (y-m) (m`div`3) c1 True  -- NW
+       flake w (x+2*m) (y-m) (m`div`3) c1 True  -- NE
+       flake w  x    (y+2*m) (m`div`3) c1 True  -- S
+       flake w (x-2*m) (y+m) (m`div`3) c1 False -- SW
+       flake w (x+2*m) (y+m) (m`div`3) c1 False -- SE
+       flake w  x    (y-2*m) (m`div`3) c1 False -- N
+
+drawTri :: Window -> Int -> Int -> Int -> Int -> Bool -> IO ()
+drawTri w x y m c o =
+  let colors = [ Magenta, Blue, Green, Red, Yellow ]
+      d =  (3*m) `div` 2
+      ps = if o
+           then [(x,y-3*m),  (x-3*m,y+d), (x+3*m,y+d)] -- side at bottom
+           else [(x,y+3*m),  (x-3*m,y-d), (x+3*m,y-d)] -- side at top
+  in drawInWindow w
+       (withColor (colors !! c)
+          (polygon ps))
+
+main4 = runGraphics $
+    do w <- openWindow "Snowflake Fractal" (windowSize,windowSize)
+       drawInWindow w $ withColor White
+         $ polygon [(0,0)
+                  ,(windowSize-1,0)
+                  ,(windowSize-1,windowSize-1)
+                  ,(0,windowSize-1)]
+       snowflake w
+       spaceClose w
+    where windowSize = 500