--
module SimpleGraphics where import SOEGraphics import Shape import Draw main2 = runGraphics( do { w <- openWindow "Draw some shapes" (300,300) ; drawInWindow w (ellipse (0,0) (50,50)) ; drawInWindow w (shearEllipse (0,60) (100,120) (150,200)) ; drawInWindow w (withColor Red (line (200,200) (299,275))) ; drawInWindow w (polygon [(100,100),(150,100),(160,200)]) ; drawInWindow w (withColor Green (polyline [(100,200),(150,200), (160,299),(100,200)])) ; spaceClose w } ) minSize :: Int minSize = 8 fillTri x y size w = drawInWindow w (withColor Cyan (polygon [(x,y),(x+size,y),(x,y-size)])) sierpinskiTri w x y size = if size <= minSize then fillTri x y size w 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" (400,400) ; c <- getKey w ; sierpinskiTri w 50 300 256 ; spaceClose w } ) go = sierpinskiTri drawPoly w color points = drawInWindow w (withColor color (polygon points)) fromInt x = fromIntegral x eqTri :: Float -> Point -> ([ Point ],[ Point ]) eqTri side (x,y) = let xf :: Float yf :: Float xf = fromInt x yf = fromInt y sideDiv2 = side / 2.0 height = sqrt( side*side - (sideDiv2 * sideDiv2) ) h1third = height / 3.0 h2third = h1third * 2.0 f (a,b) = (round a,round b) in (map f [(xf, yf - h2third), (xf - sideDiv2,yf + h1third), (xf + sideDiv2,yf + h1third)], map f [(xf - sideDiv2,yf - h1third), (xf + sideDiv2,yf - h1third), (xf,yf + h2third)]) drawStar color1 color2 w side (x,y) = do { let (a,b) = eqTri side (x,y) ; drawPoly w color1 a ; drawPoly w color2 b } main4 = runGraphics( do { w <- openWindow "Star of david" (400,400) ; drawStar Red Green w 243 (200,200) ; spaceClose w } ) snow1 w color size (x,y) = if size <= minSize then return () else do { drawStar color color w (fromInt size) (x,y) ; sequence_ (map smaller allpoints) } where (triangle1,triangle2) = eqTri (fromInt size) (x,y) allpoints = (triangle1 ++ triangle2) smaller x = snow1 w color (size `div` 3) x main5 = runGraphics( do { w <- openWindow "SnowFlake 1" (400,400) ; snow1 w Red 243 (200,200) ; spaceClose w } ) snow2 w colors size (x,y) = if size <= minSize then return () else do { drawPoly w (colors !! 0) triangle2 ; drawPoly w (colors !! 1) triangle1 ; sequence_ (fmap smaller allpoints) } where (triangle1,triangle2) = eqTri (fromInt size) (x,y) allpoints = (triangle1 ++ triangle2) smaller x = snow2 w (tail colors) (size `div` 3) x -- This function should cause an error since there -- aren't enough colors main6 = runGraphics( do { w <- openWindow "Snowflake" (400,400) ; snow2 w [Red,Blue,Green,Yellow] 243 (200,200) ; spaceClose w } ) main7 = runGraphics( do { w <- openWindow "Snowflake 2" (400,400) ; snow2 w [Red,Blue,Green,Yellow,White] 243 (200,200) ; spaceClose w } ) main8 = runGraphics( do { w <- openWindow "Snowflake" (400,400) ; snow2 w (cycle [Red,Blue,Green,Yellow]) 243 (200,200) ; spaceClose w } ) snow3 w colors size (x,y) = if size <= minSize then return () else do { drawPoly w (colors !! 0) triangle2 ; drawPoly w (colors !! 1) triangle1 ; snow3 w colors (size `div` 3) (x,y) ; sequence_ (fmap smaller allpoints) } where (triangle1,triangle2) = eqTri (fromInt size) (x,y) allpoints = (triangle1 ++ triangle2) smaller x = snow3 w (tail colors) (size `div` 3) x main9 = runGraphics( do { w <- openWindow "Snowflake" (400,400) ; snow3 w (cycle [Red,Blue,Green,Yellow,White]) 243 (200,200) ; spaceClose w } ) -------------------------------------------------- -- Now the drawing shape examples -------------------------------------------------- sh1,sh2,sh3,sh4 :: Shape sh1 = Rectangle 3 2 sh2 = Ellipse 1 1.5 sh3 = RtTriangle 3 2 sh4 = Polygon [(-2.5,2.5), (-1.5,2.0), (-1.1,0.2), (-1.7,-1.0), (-3.0,0)] main10 = runGraphics ( do w <- openWindow "Drawing Shapes" (xWin,yWin) drawInWindow w (withColor Red (shapeToGraphic sh1)) drawInWindow w (withColor Blue (shapeToGraphic sh2)) spaceClose w ) type ColoredShapes = [(Color,Shape)] shs :: ColoredShapes shs = [(Red,sh1),(Blue,sh2), (Yellow,sh3),(Magenta,sh4)] drawShapes :: Window -> ColoredShapes -> IO () drawShapes w [] = return () drawShapes w ((c,s):cs) = do drawInWindow w (withColor c (shapeToGraphic s)) drawShapes w cs main11 = runGraphics ( do w <- openWindow "Drawing Shapes" (xWin,yWin) drawShapes w shs spaceClose w ) main12 = runGraphics ( do w <- openWindow "Drawing Shapes" (xWin,yWin) drawShapes w (reverse coloredCircles) spaceClose w ) conCircles = map circle [0.2,0.4 .. 1.6] coloredCircles = zip [Black, Blue, Green, Cyan, Red, Magenta, Yellow, White] conCircles --