Move to stack src directory

4 files changed, 143 insertions, 0 deletions

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