From d235a180b642f62b19acc582166255f015d38438 Mon Sep 17 00:00:00 2001 From: Carlos Sosa Date: Sat, 21 Mar 2020 18:41:35 -0700 Subject: Move to stack src directory --- ex2/Main.hs | 28 --------------- ex2/Shape.hs | 87 ----------------------------------------------- src/ch2/Main.hs | 28 +++++++++++++++ src/ch2/Shape.hs | 87 +++++++++++++++++++++++++++++++++++++++++++++++ src/ch3/Main.hs | 4 +++ src/ch3/SimpleGraphics.hs | 24 +++++++++++++ 6 files changed, 143 insertions(+), 115 deletions(-) delete mode 100644 ex2/Main.hs delete mode 100644 ex2/Shape.hs create mode 100644 src/ch2/Main.hs create mode 100644 src/ch2/Shape.hs create mode 100644 src/ch3/Main.hs create mode 100644 src/ch3/SimpleGraphics.hs diff --git a/ex2/Main.hs b/ex2/Main.hs deleted file mode 100644 index 74d0054..0000000 --- a/ex2/Main.hs +++ /dev/null @@ -1,28 +0,0 @@ -import Shape - -main :: IO () -main = do - putStrLn "Convex Polygon:" - putStrLn - $ show - $ area - (polygon - [ (550, 450) - , (455, 519) - , (491, 631) - , (609, 631) - , (645, 519) - ] - ) - putStrLn "Concave Polygon:" - putStrLn - $ show - $ area - (polygon - [ (550, 580) - , (455, 519) - , (491, 631) - , (609, 631) - , (645, 519) - ] - ) diff --git a/ex2/Shape.hs b/ex2/Shape.hs deleted file mode 100644 index d1f9e2f..0000000 --- a/ex2/Shape.hs +++ /dev/null @@ -1,87 +0,0 @@ -module Shape - ( Shape - , area - , square - , circle - , polygon - ) -where - -data Shape = Rectangle Side Side - | Ellipse Radius Radius - | RtTriangle Side Side - | Polygon [Vertex] - deriving Show - -type Radius = Float -type Side = Float -type Vertex = (Float, Float) - -polygon :: [Vertex] -> Shape -polygon vs = Polygon vs - -area :: Shape -> Float -area (Rectangle s1 s2 ) = s1 * s2 -area (RtTriangle s1 s2 ) = s1 * s2 / 2 -area (Ellipse r1 r2 ) = pi * r1 * r2 -area (Polygon vs) - | length vs <= 2 = 0 - | otherwise = polyArea (vs ++ [head vs]) - where polyArea :: [Vertex] -> Float - polyArea (v1: v2: vs') = trapezoidArea v1 v2 + polyArea (v2:vs') - polyArea _ = 0 - -trapezoidArea :: Vertex -> Vertex -> Float -trapezoidArea v1 v2 = - let h = fst v2 - fst v1 - aplusb = snd v2 + snd v1 - in (aplusb / 2) * h - -triArea :: Vertex -> Vertex -> Vertex -> Float -triArea v1 v2 v3 = - let a = distBetween v1 v2 - b = distBetween v2 v3 - c = distBetween v3 v1 - s = 0.5 * (a + b + c) - in sqrt (s * (s - a) * (s - b) * (s - c)) - -distBetween :: Vertex -> Vertex -> Float -distBetween (x1, y1) (x2, y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) - -circle :: Radius -> Shape -circle r = Ellipse r r - -convex :: Shape -> Bool -convex (Rectangle a b ) = True -convex (RtTriangle a b ) = True -convex (Ellipse r1 r2) = True -convex (Polygon [_, _, _]) = True -convex (Polygon (vfirst : vsecond : vthird : vs)) = False - -crossProduct :: Vertex -> Vertex -> Vertex -> Float -crossProduct (x1, y1) (x2, y2) (x3, y3) = (x2 - x1) * (y3 - y2) - (y2 - y1) * (x3 - x2) - -square :: Side -> Shape -square s = Rectangle s s - -rectangle :: Side -> Side -> Shape -rectangle s1 s2 = Polygon [(x, y), (-x, y), (-x, -y), (x, -y)] - where - x = s1 / 2 - y = s2 / 2 - -regularPolygon :: Int -> Side -> Shape -regularPolygon n s = - let - angleinc = (pi * 2) / fromIntegral n - radius = (s * sin ((pi - angleinc) / 2)) / sin angleinc - regularVerts 0 _ = [] - regularVerts n angle = - (radius * cos angle, radius * sin angle) : regularVerts - (n - 1) - (angle + angleinc) - in - Polygon (regularVerts n 0) - -rtTriangle :: Side -> Side -> Shape -rtTriangle s1 s2 = Polygon [(0, 0), (s1, 0), (0, s2)] diff --git a/src/ch2/Main.hs b/src/ch2/Main.hs new file mode 100644 index 0000000..74d0054 --- /dev/null +++ b/src/ch2/Main.hs @@ -0,0 +1,28 @@ +import Shape + +main :: IO () +main = do + putStrLn "Convex Polygon:" + putStrLn + $ show + $ area + (polygon + [ (550, 450) + , (455, 519) + , (491, 631) + , (609, 631) + , (645, 519) + ] + ) + putStrLn "Concave Polygon:" + putStrLn + $ show + $ area + (polygon + [ (550, 580) + , (455, 519) + , (491, 631) + , (609, 631) + , (645, 519) + ] + ) diff --git a/src/ch2/Shape.hs b/src/ch2/Shape.hs new file mode 100644 index 0000000..d1f9e2f --- /dev/null +++ b/src/ch2/Shape.hs @@ -0,0 +1,87 @@ +module Shape + ( Shape + , area + , square + , circle + , polygon + ) +where + +data Shape = Rectangle Side Side + | Ellipse Radius Radius + | RtTriangle Side Side + | Polygon [Vertex] + deriving Show + +type Radius = Float +type Side = Float +type Vertex = (Float, Float) + +polygon :: [Vertex] -> Shape +polygon vs = Polygon vs + +area :: Shape -> Float +area (Rectangle s1 s2 ) = s1 * s2 +area (RtTriangle s1 s2 ) = s1 * s2 / 2 +area (Ellipse r1 r2 ) = pi * r1 * r2 +area (Polygon vs) + | length vs <= 2 = 0 + | otherwise = polyArea (vs ++ [head vs]) + where polyArea :: [Vertex] -> Float + polyArea (v1: v2: vs') = trapezoidArea v1 v2 + polyArea (v2:vs') + polyArea _ = 0 + +trapezoidArea :: Vertex -> Vertex -> Float +trapezoidArea v1 v2 = + let h = fst v2 - fst v1 + aplusb = snd v2 + snd v1 + in (aplusb / 2) * h + +triArea :: Vertex -> Vertex -> Vertex -> Float +triArea v1 v2 v3 = + let a = distBetween v1 v2 + b = distBetween v2 v3 + c = distBetween v3 v1 + s = 0.5 * (a + b + c) + in sqrt (s * (s - a) * (s - b) * (s - c)) + +distBetween :: Vertex -> Vertex -> Float +distBetween (x1, y1) (x2, y2) = sqrt ((x1 - x2) ^ 2 + (y1 - y2) ^ 2) + +circle :: Radius -> Shape +circle r = Ellipse r r + +convex :: Shape -> Bool +convex (Rectangle a b ) = True +convex (RtTriangle a b ) = True +convex (Ellipse r1 r2) = True +convex (Polygon [_, _, _]) = True +convex (Polygon (vfirst : vsecond : vthird : vs)) = False + +crossProduct :: Vertex -> Vertex -> Vertex -> Float +crossProduct (x1, y1) (x2, y2) (x3, y3) = (x2 - x1) * (y3 - y2) - (y2 - y1) * (x3 - x2) + +square :: Side -> Shape +square s = Rectangle s s + +rectangle :: Side -> Side -> Shape +rectangle s1 s2 = Polygon [(x, y), (-x, y), (-x, -y), (x, -y)] + where + x = s1 / 2 + y = s2 / 2 + +regularPolygon :: Int -> Side -> Shape +regularPolygon n s = + let + angleinc = (pi * 2) / fromIntegral n + radius = (s * sin ((pi - angleinc) / 2)) / sin angleinc + regularVerts 0 _ = [] + regularVerts n angle = + (radius * cos angle, radius * sin angle) : regularVerts + (n - 1) + (angle + angleinc) + in + Polygon (regularVerts n 0) + +rtTriangle :: Side -> Side -> Shape +rtTriangle s1 s2 = Polygon [(0, 0), (s1, 0), (0, s2)] diff --git a/src/ch3/Main.hs b/src/ch3/Main.hs new file mode 100644 index 0000000..217f50d --- /dev/null +++ b/src/ch3/Main.hs @@ -0,0 +1,4 @@ +import SimpleGraphics + +main :: IO () +main = main0 diff --git a/src/ch3/SimpleGraphics.hs b/src/ch3/SimpleGraphics.hs new file mode 100644 index 0000000..5e160a7 --- /dev/null +++ b/src/ch3/SimpleGraphics.hs @@ -0,0 +1,24 @@ +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 -- cgit v1.3-2-g0d8e