diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ch3/Main.hs | 2 | ||||
| -rw-r--r-- | src/ch3/SimpleGraphics.hs | 61 |
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 |