1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
module SimpleGraphics where
import Graphics.SOE
main0 = runGraphics $
do w <- openWindow "My First Graphics Program" (300,300)
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 ""
else do v <- SimpleGraphics.getLine
return (c:v)
putStr :: String -> IO ()
putStr [] = return ()
putStr (x:xs) = do putChar x
SimpleGraphics.putStr xs
pic1 = withColor Red
(ellipse (150, 150) (300, 200))
pic2 = withColor Blue
(polyline [(100, 50), (200, 50),
(200, 250), (100, 250), (100, 50)])
main2 = runGraphics $
do w <- openWindow "Some Graphics Figures" (300, 300)
drawInWindow w pic1
drawInWindow w pic2
spaceClose w
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)]
minSize :: Int
minSize = 8
sierpinskiTri :: Window -> Int -> Int -> Int -> IO ()
sierpinskiTri w x y size =
if size <= minSize
then fillTri w x y size
else let size2 = size `div` 2
in do sierpinskiTri w x y size2
sierpinskiTri w x (y-size2) size2
sierpinskiTri w (x+size2) y size2
main3 = runGraphics $
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
|
