First step in refactoring based on awesome feedback at http://www.red…

…dit.com/r/haskell/comments/p9jzh/implicitcad_is_a_programmatic_cad_tool3d/c3nss17 ... Thanks Peaker!
Haskell-Things · Feb 4, 2012 · bbacbfd · bbacbfd
1 parent ed32fb2
commit bbacbfd
Show file tree

Hide file tree

Showing 8 changed files with 138 additions and 128 deletions.
diff --git a/Graphics/Implicit.hs b/Graphics/Implicit.hs
@@ -32,57 +32,77 @@ module Graphics.Implicit(
 	runOpenscad
 ) where
 
-import Graphics.Implicit.Definitions
-import qualified Graphics.Implicit.Primitives as S
-import Graphics.Implicit.Operations
+-- Let's be explicit about where things come from :)
+import Graphics.Implicit.Definitions (ℝ, ℝ2, ℝ3, SymbolicObj2, SymbolicObj3)
+import qualified Graphics.Implicit.Primitives as Prim
 import qualified Graphics.Implicit.Export as Export
-import Graphics.Implicit.ExtOpenScad
+import Graphics.Implicit.ExtOpenScad (runOpenscad)
+import Graphics.Implicit.Operations 
+	(translate, scale, complement, 
+	 union,  intersect,  difference,
+	 unionR, intersectR, differenceR,
+	 extrudeR, extrudeOnEdgeOf, shell)
 
 -- The versions of objects that should be used by default.
 -- Import Graphics.Implicit.Primitives to override
+
 type DObj3 = SymbolicObj3
 type DObj2 = SymbolicObj2
 
-writeSTL :: ℝ -> String -> DObj3 -> IO()
+-- We're going to force some of the types to be less flexible 
+-- than they are for ease of use for the end user...
+
+writeSTL ::
+	ℝ           -- ^ Resolution
+	-> FilePath -- ^ STL file to write to
+	-> DObj3    -- ^ 3D object to write
+	-> IO()     -- ^ Writing action!
+
 writeSTL = Export.writeSTL
-writeSVG :: ℝ -> String -> DObj2 -> IO()
+
+writeSVG :: 
+	ℝ           -- ^ Resolution
+	-> FilePath -- ^ SVG File to be written to
+	-> DObj2    -- ^ 2D object to write
+	-> IO()     -- ^ Writing action!
+
 writeSVG = Export.writeSVG
 
 
 sphere ::
 	ℝ           -- ^ Radius of the sphere
 	-> DObj3    -- ^ Resulting sphere
-sphere = S.sphere
+sphere = Prim.sphere
 rect3R ::
 	ℝ           -- ^ Radius of roudning
 	-> ℝ3       -- ^ bot-left-out corner
 	-> ℝ3       -- ^ top-right-in corner
 	 -> DObj3   -- ^ Resuting 3D rect
-rect3R = S.rect3R
+rect3R = Prim.rect3R
 
 cylinder2 ::
 	ℝ           -- ^ Radius of the cylinder	
 	-> ℝ        -- ^ Second radius of the cylinder
 	-> ℝ        -- ^ Height of the cylinder
 	-> DObj3    -- ^ Resulting cylinder
-cylinder2 = S.cylinder2
+cylinder2 = Prim.cylinder2
 
 circle ::
 	ℝ          -- ^ radius of the circle
 	-> DObj2   -- ^ resulting circle
-circle = S.circle
+circle = Prim.circle
 
 rectR ::
 	ℝ          -- ^ Radius of rounding
 	-> ℝ2      -- ^ (x1, y1)
 	-> ℝ2      -- ^ (x2 ,y2)
 	-> DObj2   -- ^ rect between (x1,y1) and (x2,y2)
-rectR = S.rectR
+rectR = Prim.rectR
 
 polygon ::
 	[ℝ2]      -- ^ Verticies of the polygon
 	 -> DObj2   -- ^ Resulting polygon
-polygon = S.polygonR 0
+polygon = Prim.polygonR 0
 
 
 

diff --git a/Graphics/Implicit/Export.hs b/Graphics/Implicit/Export.hs
@@ -5,32 +5,45 @@ module Graphics.Implicit.Export where
 
 import Graphics.Implicit.Definitions
 --import Graphics.Implicit.Operations (slice)
-import System.IO
 
+import System.IO (writeFile)
+
+-- class DiscreteApproxable
 import Graphics.Implicit.Export.Definitions
 
+-- instances of DiscreteApproxable...
 import Graphics.Implicit.Export.BoxedObj2
 import Graphics.Implicit.Export.BoxedObj3
 import Graphics.Implicit.Export.SymbolicObj2
 import Graphics.Implicit.Export.SymbolicObj3
 
-import Graphics.Implicit.Export.PolylineFormats
-import Graphics.Implicit.Export.TriangleMeshFormats
+-- File formats
+import qualified Graphics.Implicit.Export.PolylineFormats as PolylineFormats
+import qualified Graphics.Implicit.Export.TriangleMeshFormats as TriangleMeshFormats
+
+-- Write an object in a given formet...
 
 writeObject :: (DiscreteAproxable obj aprox) => 
 	ℝ                    -- ^ Resolution
 	-> (aprox -> String) -- ^ File Format (Function that formats)
-	-> String            -- ^ File Name
+	-> FilePath          -- ^ File Name
 	-> obj               -- ^ Object to render
 	-> IO()              -- ^ Writing Action!
+
 writeObject res format filename obj = writeFile filename text 
 	where
 		aprox = discreteAprox res obj
 		text = format aprox
 
-writeSVG res = writeObject res svg
-writeSTL res = writeObject res  stl
-writeGCodeHacklabLaser res = writeObject res hacklabLaserGCode
+-- Now functions to write it in specific formats
+
+writeSVG res = writeObject res PolylineFormats.svg
+
+writeSTL res = writeObject res  TriangleMeshFormats.stl
+
+writeGCodeHacklabLaser res = writeObject res PolylineFormats.hacklabLaserGCode
+
+
 
 {-
 renderRaw :: ℝ3 -> ℝ3 -> ℝ -> String -> Obj3 -> IO()

diff --git a/Graphics/Implicit/ExtOpenScad.hs b/Graphics/Implicit/ExtOpenScad.hs
@@ -3,48 +3,20 @@
 
 -- We'd like to parse openscad code, with some improvements, for backwards compatability.
 
-module Graphics.Implicit.ExtOpenScad where
-
-import Graphics.Implicit.Definitions
-import Graphics.Implicit.ExtOpenScad.Definitions
-import Graphics.Implicit.ExtOpenScad.Expressions
-import Graphics.Implicit.ExtOpenScad.Default
-import Graphics.Implicit.ExtOpenScad.Statements
-
-import Prelude hiding (lookup)
-import Data.Map (Map, fromList, lookup)
-import Text.ParserCombinators.Parsec 
-import Text.ParserCombinators.Parsec.Expr
-import Control.Monad (liftM)
-
+module Graphics.Implicit.ExtOpenScad (runOpenscad) where
 
-runComputationsDefault = runComputations $
-	return (fromList funcs, [], [])
+import Graphics.Implicit.ExtOpenScad.Default (defaultObjects)
+import Graphics.Implicit.ExtOpenScad.Statements (computationStatement, runComputations)
 
+import Text.ParserCombinators.Parsec (parse, many1)
+import Control.Monad (liftM)
 
+-- Small wrapper to handle parse errors, etc
 runOpenscad str = case parse (many1 computationStatement) ""  str of
 	Right res -> Right $ runComputationsDefault res
 	Left  err ->  Left err
 
+runComputationsDefault = runComputations $
+	return (defaultObjects, [], [])
 
 
-funcs = [
-		("pi", ONum pi),
-		("sin", numericOFunc sin),
-		("cos", numericOFunc cos),
-		("tan", numericOFunc tan),
-		("abs", numericOFunc abs),
-		("sign", numericOFunc signum),
-		("floor", numericOFunc (fromIntegral . floor) ),
-		("ceil", numericOFunc (fromIntegral . ceiling) ),
-		("exp", numericOFunc exp),
-		("max", numericOFunc2 max),
-		("min", numericOFunc2 min),
-		("map", mapfunc)
-	]
-
-mapfunc = OFunc $ \oObj -> case oObj of
-	OFunc f -> OFunc $ \oObj2 -> case oObj2 of
-		OList l -> OList $ map f l
-		_ -> OUndefined
-	_ -> OUndefined
diff --git a/Graphics/Implicit/ExtOpenScad/Default.hs b/Graphics/Implicit/ExtOpenScad/Default.hs
@@ -7,6 +7,45 @@ module Graphics.Implicit.ExtOpenScad.Default where
 
 import Graphics.Implicit.Definitions
 import Graphics.Implicit.ExtOpenScad.Definitions
+import Data.Map (Map, fromList)
+
+defaultObjects :: VariableLookup -- = Map String OpenscadObj
+defaultObjects = fromList $ 
+	defaultConstants
+	++ defaultFunctions
+	++ defaultFunctions2
+	++ defaultFunctionsSpecial
+
+defaultConstants = map (\(a,b) -> (a, ONum b))
+	[("pi", pi)]
+
+defaultFunctions = map (\(a,b) -> (a, numericOFunc b))
+	[
+		("sin",   sin),
+		("cos",   cos),
+		("tan",   tan),
+		("abs",   abs),
+		("sign",  signum),
+		("floor", fromIntegral . floor ),
+		("ceil",  fromIntegral . ceiling ),
+		("exp",   exp)
+	]
+
+defaultFunctions2 = map (\(a,b) -> (a, numericOFunc2 b))
+	[
+		("max", max),
+		("min", min)
+	]
+
+defaultFunctionsSpecial = [("map", mapfunc)]
+
+-- Stupid functions for convering to openscad objects follow:
+
+mapfunc = OFunc $ \oObj -> case oObj of
+	OFunc f -> OFunc $ \oObj2 -> case oObj2 of
+		OList l -> OList $ map f l
+		_ -> OUndefined
+	_ -> OUndefined
 
 numericOFunc f = OFunc $ \oObj -> case oObj of
 	ONum n -> ONum $ f n
@@ -19,3 +58,4 @@ numericOFunc2 f = OFunc $ \oObj -> case oObj of
 		_ -> OUndefined
 	_ -> OUndefined
 
+
diff --git a/Graphics/Implicit/Operations.hs b/Graphics/Implicit/Operations.hs
@@ -18,18 +18,13 @@ module Graphics.Implicit.Operations (
 	rotate3
 ) where
 
-import Prelude hiding ((+),(-),(*),(/))
-import Graphics.Implicit.Definitions
-import Graphics.Implicit.MathUtil
-import Graphics.Implicit.SaneOperators
-
+-- classes in here provide basicaly everything we're exporting...
 import Graphics.Implicit.Operations.Definitions
+
+-- Then we have a bunch of isntances, corresponding to each file name.
 import Graphics.Implicit.Operations.Obj2
 import Graphics.Implicit.Operations.Obj3
 import Graphics.Implicit.Operations.ObjPair
-import Graphics.Implicit.Operations.Box2
-import Graphics.Implicit.Operations.Box3
-import Graphics.Implicit.Operations.BoxPair
 import Graphics.Implicit.Operations.BoxedObj2
 import Graphics.Implicit.Operations.BoxedObj3
 import Graphics.Implicit.Operations.BoxedObjPair
@@ -39,11 +34,7 @@ import Graphics.Implicit.Operations.SymbolicObjPair
 
 
 
--- 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/
-
-
-
+{- Old stuff that may need to be incorporated into the larger structure later
 
 -- | Slice a 3D objects at a given z value to make a 2D object.
 slice :: 
@@ -52,16 +43,7 @@ slice ::
 	-> Obj2   -- ^ Resulting 2D object
 slice z obj = \(a,b) -> obj (a,b,z)
 
--- | Bubble out a 2D object into a 3D one.
-bubble :: ℝ -> Obj2 -> Obj3
-bubble s obj = 
-	let
-		spsqrt n = signum n * sqrt (abs n)
-		spsq n = signum n * n ** 2
-	in
-		\(x,y,z) -> spsqrt ( z ** 2 + s * obj (x,y) )
 
-{-
 -- | Extrude a 2D object. (The extrusion goes into the z-plane)
 extrude :: 
 	ℝ          -- ^ Length to extrude
@@ -86,24 +68,4 @@ extrudeOnEdgeOf ::
 extrudeOnEdgeOf a b = \(x,y,z) -> a (b (x,y), z) 
 
 
-
-
 -}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Graphics/Implicit/Operations/Definitions.hs b/Graphics/Implicit/Operations/Definitions.hs
@@ -6,12 +6,7 @@
 
 module Graphics.Implicit.Operations.Definitions where
 
-import Prelude hiding ((+),(-),(*),(/))
 import Graphics.Implicit.Definitions
-import Graphics.Implicit.MathUtil
-import Graphics.Implicit.SaneOperators
-
-
 
 
 infty = (1 :: ℝ) / (0 :: ℝ)