Merge pull request #1 from colah/master

merge with upstream

.gitignore

@@ -3,4 +3,3 @@
 *.hi
 dist/
 extopenscad
-

Graphics/Implicit.hs

@@ -1,47 +1,47 @@
 -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
 -- Released under the GNU GPL, see LICENSE
 
-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts, TypeSynonymInstances, UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeSynonymInstances, UndecidableInstances #-}
 
 {- 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,
-	scale,
-	complement,
-	union,  intersect,  difference,
-	unionR, intersectR, differenceR,
-	shell,
-	--slice,
-	extrudeR,
-	extrudeOnEdgeOf,
-	-- Primitives
-	sphere,
-	rect3R,
-	circle,
-	cylinder,
-	cylinder2,
-	rectR,
-	--regularPolygon,
-	--zsurface,
-	polygon,
-	-- Export
-	writeSVG,
-	writeSTL,
-	writeBinSTL,
-	writeOBJ,
-	writeTHREEJS,
-	writeSCAD2,
-	writeSCAD3,
-	writeGCodeHacklabLaser,
-	writePNG2,
-	writePNG3,
-	runOpenscad,
-	implicit,
-	SymbolicObj2,
-	SymbolicObj3
+    -- Operations
+    translate,
+    scale,
+    complement,
+    union,  intersect,  difference,
+    unionR, intersectR, differenceR,
+    shell,
+    --slice,
+    extrudeR,
+    extrudeOnEdgeOf,
+    -- Primitives
+    sphere,
+    rect3R,
+    circle,
+    cylinder,
+    cylinder2,
+    rectR,
+    --regularPolygon,
+    --zsurface,
+    polygon,
+    -- Export
+    writeSVG,
+    writeSTL,
+    writeBinSTL,
+    writeOBJ,
+    writeTHREEJS,
+    writeSCAD2,
+    writeSCAD3,
+    writeGCodeHacklabLaser,
+    writePNG2,
+    writePNG3,
+    runOpenscad,
+    implicit,
+    SymbolicObj2,
+    SymbolicObj3
 ) where
 
 -- Let's be explicit about where things come from :)
@@ -53,14 +53,33 @@ import Graphics.Implicit.Definitions
 -- We want Export to be a bit less polymorphic
 -- (so that types will collapse nicely)
 
-writeSVG    = Export.writeSVG   :: ℝ -> FilePath -> SymbolicObj2 -> IO ()
-writeSTL    = Export.writeSTL   :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
-writeBinSTL = Export.writeBinSTL   :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
-writeOBJ    = Export.writeOBJ   :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
-writeSCAD2  = Export.writeSCAD2 :: ℝ -> FilePath -> SymbolicObj2 -> IO ()
-writeSCAD3  = Export.writeSCAD3 :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
-writeTHREEJS = Export.writeTHREEJS :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
-writeGCodeHacklabLaser = Export.writeGCodeHacklabLaser :: ℝ -> FilePath -> SymbolicObj2 -> IO () 
-writePNG2 = Export.writePNG :: ℝ -> FilePath -> SymbolicObj2  -> IO ()
-writePNG3 = Export.writePNG :: ℝ -> FilePath -> SymbolicObj3  -> IO ()
+writeSVG :: ℝ -> FilePath -> SymbolicObj2 -> IO ()
+writeSVG = Export.writeSVG
+
+writeSTL :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
+writeSTL = Export.writeSTL
+
+writeBinSTL :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
+writeBinSTL = Export.writeBinSTL
+
+writeOBJ :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
+writeOBJ = Export.writeOBJ
+
+writeSCAD2 :: ℝ -> FilePath -> SymbolicObj2 -> IO ()
+writeSCAD2 = Export.writeSCAD2
+
+writeSCAD3 :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
+writeSCAD3 = Export.writeSCAD3
+
+writeTHREEJS :: ℝ -> FilePath -> SymbolicObj3 -> IO ()
+writeTHREEJS = Export.writeTHREEJS
+
+writeGCodeHacklabLaser :: ℝ -> FilePath -> SymbolicObj2 -> IO () 
+writeGCodeHacklabLaser = Export.writeGCodeHacklabLaser
+
+writePNG2 :: ℝ -> FilePath -> SymbolicObj2  -> IO ()
+writePNG2 = Export.writePNG
+
+writePNG3 :: ℝ -> FilePath -> SymbolicObj3  -> IO ()
+writePNG3 = Export.writePNG
 

Graphics/Implicit/Definitions.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
 
 -- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
 -- Released under the GNU GPL, see LICENSE
@@ -10,8 +10,6 @@ module Graphics.Implicit.Definitions where
 import Data.IORef (IORef, newIORef, readIORef)
 import System.IO.Unsafe (unsafePerformIO)
 import Data.VectorSpace       
-import Control.Applicative
-import Data.NumInstances
 
 -- Let's make things a bit nicer. 
 -- Following math notation ℝ, ℝ², ℝ³...
@@ -92,66 +90,66 @@ type BoxedObj3 = Boxed3 Obj3
 --   accelerate rendering & give ideal meshes for simple
 --   cases.
 data SymbolicObj2 =
-	-- Primitives
-	  RectR ℝ ℝ2 ℝ2
-	| Circle ℝ
-	| PolygonR ℝ [ℝ2]
-	-- (Rounded) CSG
-	| Complement2 SymbolicObj2
-	| UnionR2 ℝ [SymbolicObj2]
-	| DifferenceR2 ℝ [SymbolicObj2]
-	| IntersectR2 ℝ [SymbolicObj2]
-	-- Simple transforms
-	| Translate2 ℝ2 SymbolicObj2
-	| Scale2 ℝ2 SymbolicObj2
-	| Rotate2 ℝ SymbolicObj2
-	-- Boundary mods
-	| Outset2 ℝ SymbolicObj2
-	| Shell2 ℝ SymbolicObj2
-	-- Misc
-	| EmbedBoxedObj2 BoxedObj2
-	deriving Show
+    -- Primitives
+    RectR ℝ ℝ2 ℝ2
+    | Circle ℝ
+    | PolygonR ℝ [ℝ2]
+    -- (Rounded) CSG
+    | Complement2 SymbolicObj2
+    | UnionR2 ℝ [SymbolicObj2]
+    | DifferenceR2 ℝ [SymbolicObj2]
+    | IntersectR2 ℝ [SymbolicObj2]
+    -- Simple transforms
+    | Translate2 ℝ2 SymbolicObj2
+    | Scale2 ℝ2 SymbolicObj2
+    | Rotate2 ℝ SymbolicObj2
+    -- Boundary mods
+    | Outset2 ℝ SymbolicObj2
+    | Shell2 ℝ SymbolicObj2
+    -- Misc
+    | EmbedBoxedObj2 BoxedObj2
+    deriving Show
 
 -- | A symbolic 3D format!
 
 data SymbolicObj3 = 
-	-- Primitives
-	  Rect3R ℝ ℝ3 ℝ3
-	| Sphere ℝ
-	| Cylinder ℝ ℝ ℝ -- h r1 r2
-	-- (Rounded) CSG
-	| Complement3 SymbolicObj3
-	| UnionR3 ℝ [SymbolicObj3]
-	| IntersectR3 ℝ [SymbolicObj3]
-	| DifferenceR3 ℝ [SymbolicObj3]
-	-- Simple transforms
-	| Translate3 ℝ3 SymbolicObj3
-	| Scale3 ℝ3 SymbolicObj3
-	| Rotate3 (ℝ,ℝ,ℝ) SymbolicObj3
-	| Rotate3V ℝ ℝ3 SymbolicObj3
-	-- Boundary mods
-	| Outset3 ℝ SymbolicObj3
-	| Shell3 ℝ SymbolicObj3
-	-- Misc
-	| EmbedBoxedObj3 BoxedObj3
-	-- 2D based
-	| ExtrudeR ℝ SymbolicObj2 ℝ
-	| ExtrudeRotateR ℝ ℝ SymbolicObj2 ℝ
-	| ExtrudeRM 
-		ℝ                 -- rounding radius
-		(Maybe (ℝ -> ℝ))  -- twist
-		(Maybe (ℝ -> ℝ))  -- scale
-		(Maybe (ℝ -> ℝ2)) -- translate
-		SymbolicObj2      -- object to extrude
-		(Either ℝ (ℝ2 -> ℝ)) -- height to extrude to
-	| RotateExtrude
-		ℝ                   -- Angle to sweep to
-		(Maybe ℝ)           -- Loop or path (rounded corner)
-		(Either ℝ2 (ℝ -> ℝ2)) -- translate function
-		(Either ℝ  (ℝ -> ℝ )) -- rotate function
-		SymbolicObj2      -- object to extrude
-	| ExtrudeOnEdgeOf SymbolicObj2 SymbolicObj2
-	deriving Show
+    -- Primitives
+      Rect3R ℝ ℝ3 ℝ3
+    | Sphere ℝ
+    | Cylinder ℝ ℝ ℝ -- h r1 r2
+    -- (Rounded) CSG
+    | Complement3 SymbolicObj3
+    | UnionR3 ℝ [SymbolicObj3]
+    | IntersectR3 ℝ [SymbolicObj3]
+    | DifferenceR3 ℝ [SymbolicObj3]
+    -- Simple transforms
+    | Translate3 ℝ3 SymbolicObj3
+    | Scale3 ℝ3 SymbolicObj3
+    | Rotate3 (ℝ,ℝ,ℝ) SymbolicObj3
+    | Rotate3V ℝ ℝ3 SymbolicObj3
+    -- Boundary mods
+    | Outset3 ℝ SymbolicObj3
+    | Shell3 ℝ SymbolicObj3
+    -- Misc
+    | EmbedBoxedObj3 BoxedObj3
+    -- 2D based
+    | ExtrudeR ℝ SymbolicObj2 ℝ
+    | ExtrudeRotateR ℝ ℝ SymbolicObj2 ℝ
+    | ExtrudeRM 
+        ℝ                 -- rounding radius
+        (Maybe (ℝ -> ℝ))  -- twist
+        (Maybe (ℝ -> ℝ))  -- scale
+        (Maybe (ℝ -> ℝ2)) -- translate
+        SymbolicObj2      -- object to extrude
+        (Either ℝ (ℝ2 -> ℝ)) -- height to extrude to
+    | RotateExtrude
+        ℝ                   -- Angle to sweep to
+        (Maybe ℝ)           -- Loop or path (rounded corner)
+        (Either ℝ2 (ℝ -> ℝ2)) -- translate function
+        (Either ℝ  (ℝ -> ℝ )) -- rotate function
+        SymbolicObj2      -- object to extrude
+    | ExtrudeOnEdgeOf SymbolicObj2 SymbolicObj2
+    deriving Show
 
 -- | Rectilinear 2D set
 type Rectilinear2 = [Box2]
@@ -171,22 +169,23 @@ xmlErrorOn = unsafePerformIO $ newIORef False
 
 errorMessage :: Int -> String -> IO()
 errorMessage line msg = do
-		useXML <- readIORef xmlErrorOn
-		let
-			msg' = "At line <line>" ++ show line ++ "</line>:" ++ msg
-			-- dropXML inTag (x:xs)
-			dropXML inQuote False ('"':xs) = '"':dropXML (not inQuote) False  xs
-			dropXML True    _     ( x :xs) = x:dropXML True    False  xs
-			dropXML False   False ('<':xs) =   dropXML False   True  xs
-			dropXML False   True  ('>':xs) =   dropXML False   False xs
-			dropXML inQuote True  ( _ :xs) =   dropXML inQuote True  xs
-			dropXML inQuote False ( x :xs) = x:dropXML inQuote False xs
-			dropXML _       _        []    = []
-		if useXML 
-			then putStrLn $ "<error>" ++ msg' ++ "</error>"
-			else putStrLn $ dropXML False False $ msg'
-		return ()
-
+        useXML <- readIORef xmlErrorOn
+        let
+            msg' = "At line <line>" ++ show line ++ "</line>:" ++ msg
+            -- dropXML inTag (x:xs)
+            dropXML inQuote False ('"':xs) = '"':dropXML (not inQuote) False  xs
+            dropXML True    _     ( x :xs) = x:dropXML True    False  xs
+            dropXML False   False ('<':xs) =   dropXML False   True  xs
+            dropXML False   True  ('>':xs) =   dropXML False   False xs
+            dropXML inQuote True  ( _ :xs) =   dropXML inQuote True  xs
+            dropXML inQuote False ( x :xs) = x:dropXML inQuote False xs
+            dropXML _       _        []    = []
+        if useXML 
+            then putStrLn $ "<error>" ++ msg' ++ "</error>"
+            else putStrLn $ dropXML False False $ msg'
+        return ()
+
+-- FIXME: document WHY this is wrong.
 -- HACK: This needs to be fixed correctly someday
 instance Show (a -> b) where
-		show _ = "<function>"
+        show _ = "<function>"