Merge pull request #1 from diffoperator/primitives

Primitives

Graphics/Implicit.hs

@@ -1,12 +1,12 @@
 -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
 -- Released under the GNU GPL, see LICENSE
 
-{- The sole purpose of this file it to pass on the 
+{- The sole purpose of this file it to pass on the
    functionality we want to be accessible to the end user. -}
 
 module Graphics.Implicit(
 	-- Operations
-	translate, 
+	translate,
 	scale,
 	complement,
 	union,  intersect,  difference,
@@ -26,7 +26,7 @@ module Graphics.Implicit(
 	regularPolygon,
 	zsurface,
 	polygon,
-	--ellipse,
+	ellipse,
 	-- Export
 	writeSVG,
 	writeSVG2,

Graphics/Implicit/Primitives.hs

@@ -10,7 +10,7 @@ module Graphics.Implicit.Primitives (
 	regularPolygon,
 	polygon,
 	zsurface--,
-	--ellipse
+	ellipse
 ) where
 
 import Graphics.Implicit.Definitions
@@ -19,85 +19,84 @@ import qualified Graphics.Implicit.SaneOperators as S
 -- If you are confused as to how these functions work, please refer to
 -- http://christopherolah.wordpress.com/2011/11/06/manipulation-of-implicit-functions-with-an-eye-on-cad/
 
-sphere :: 
+sphere ::
 	ℝ         -- ^ Radius of the sphere
 	-> Obj3   -- ^ Resulting sphere
 sphere r = \(x,y,z) -> sqrt (x**2 + y**2 + z**2) - r
 
-cube :: 
+cube ::
 	ℝ          -- ^ Width of the cube
 	 -> Obj3   -- ^ Resuting cube
 cube l = \(x,y,z) -> (maximum $ map abs [x,y,z]) - l/2.0
 
-cylinder :: 
+cylinder ::
 	ℝ         -- ^ Radius of the cylinder
 	-> ℝ      -- ^ Height of the cylinder
 	-> Obj3   -- ^ Resulting cylinder
 cylinder r h = \(x,y,z) -> max (sqrt(x^2+y^2) - r) (abs(z) - h)
 
-circle :: 
+circle ::
 	ℝ        -- ^ radius of the circle
 	-> Obj2  -- ^ resulting circle
 circle r = \(x,y) -> sqrt (x**2 + y**2) - r
 
-torus :: 
+torus ::
 	ℝ       -- ^ radius of the rotated circle of a torus
 	-> ℝ    -- ^ radius of the circle rotationaly extruded on of a torus
 	-> Obj3 -- ^ resulting torus
 torus r_main r_second = \(x,y,z) -> sqrt( ( sqrt (x^2 + y^2) - r_main )^2 + z^2 ) - r_second
 
---ellipse :: ℝ -> ℝ -> Obj2
---ellipse a b = \(x,y) ->
---	if a > b 
---	then ellipse b a (y,x)
---	else sqrt ((b/a*x)*	*2 + y**2) - a
+ellipse :: ℝ -> ℝ -> Obj2
+ellipse a b
+    | a < b = \(x,y) -> sqrt ((b/a*x)**2 + y**2) - a
+    | otherwise = \(x,y) -> sqrt (x**2 + (a/b*y)**2) - b
 
-square :: 
+square ::
 	ℝ        -- ^ Width of the square
 	-> Obj2  -- ^ Resulting square
 square l = \(x,y) -> (maximum $ map abs [x,y]) - l/2.0
 
-polygon :: 
+polygon ::
 	[ℝ2]      -- ^ Verticies of the polygon
 	 -> Obj2  -- ^ Resulting polygon
-polygon points = 
+polygon points =
 	let
-		pairs = 
+		pairs =
 		   [ (points !! n, points !! (mod (n+1) (length points) ) ) | n <- [0 .. (length points) - 1] ]
-		isIn p@(p1,p2) = 
-			let 
-				crossing_points = 
+		isIn p@(p1,p2) =
+			let
+				crossing_points =
 					[x1 + (x2-x1)*y2/(y2-y1) |
-					((x1,y1), (x2,y2)) <- 
+					((x1,y1), (x2,y2)) <-
 						map (\((a1,a2),(b1,b2)) -> ((a1-p1,a2-p2), (b1-p1,b2-p2)) ) pairs,
 					( (y2 < 0) && (y1 > 0) ) || ( (y2 > 0) && (y1 < 0) ) ]
-			in 
+			in
 				if odd $ length $ filter (>0) crossing_points then -1 else 1
 		dist a@(a1,a2) b@(b1,b2) p@(p1,p2) =
 			let
 				ab = b S.- a
 				nab = (1 / S.norm ab) S.* ab
 				ap = p S.- a
 				d  = nab S.⋅ ap
-				closest 
+				closest
 					| d < 0 = a
 					| d > S.norm ab = b
 					| otherwise = a S.+ d S.* nab
 			in
 				S.norm (closest S.- p)
 		dists = \ p -> map (\(a,b) ->  dist a b p) pairs
-	in 
+	in
 		\ p -> isIn p * minimum (dists p)
 
-regularPolygon :: 
+regularPolygon ::
 	ℕ       -- ^ number of sides
 	-> ℝ    -- ^ radius
 	-> Obj2 -- ^ resulting regular polygon
 regularPolygon sides r = let sidesr = fromIntegral sides in
-	\(x,y) -> maximum [ x*cos(2*pi*m/sidesr) + y*sin(2*pi*m/sidesr) | m <- [0.. sidesr -1]] - r 
+	\(x,y) -> maximum [ x*cos(2*pi*m/sidesr) + y*sin(2*pi*m/sidesr) | m <- [0.. sidesr -1]] - r
 
 
-zsurface :: 
+zsurface ::
 	(ℝ2 -> ℝ) -- ^ Description of the height of the surface
 	-> Obj3   -- ^ Resulting 3D object
 zsurface f = \(x,y,z) -> f (x,y) - z