Skip to content
Browse files

Re-implement the SCAD output module.

Note that there's a really nice pretty printer inside that module
just waiting for the Reader's context to change from ℝ to (ℝ,Int) and a
few changes to call.

Otherwise, this is the same story as all of the other rewrites - no
more string concatenation and slightly less awkward parameter passing.

Note that this does introduce a dependency on mtl, which may not be
popular. This would also work with transformers, so...

(Commit 6/6 of my quest to add efficient GHCLive support for ImplicitCAD.)
  • Loading branch information...
1 parent e2c786b commit c7dfb60c22726e37c9a46cafd4f04e9bf23eff62 @matthewSorensen committed Aug 25, 2012
View
4 Graphics/Implicit/Export.hs
@@ -50,8 +50,8 @@ writeTHREEJS res = writeObject res TriangleMeshFormats.jsTHREE
writeGCodeHacklabLaser res = writeObject res PolylineFormats.hacklabLaserGCode
-writeSCAD3 res filename obj = writeFile filename $ pack $ SymbolicFormats.scad3 res obj
-writeSCAD2 res filename obj = writeFile filename $ pack $ SymbolicFormats.scad2 res obj
+writeSCAD3 res filename obj = writeFile filename $ SymbolicFormats.scad3 res obj
+writeSCAD2 res filename obj = writeFile filename $ SymbolicFormats.scad2 res obj
{-
View
160 Graphics/Implicit/Export/SymbolicFormats.hs
@@ -1,81 +1,97 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export.SymbolicFormats where
import Graphics.Implicit.Definitions
-import Data.List as List
-
-scad3 :: ℝ -> SymbolicObj3 -> String
-
-scad3 res (UnionR3 0 objs) =
- "union() {\n"
- ++ concat (map ((++"\n") . scad3 res) objs)
- ++ "}\n"
-scad3 res (DifferenceR3 0 objs) =
- "difference() {\n"
- ++ concat (map ((++"\n") . scad3 res) objs)
- ++ "}\n"
-scad3 res (IntersectR3 0 objs) =
- "intersection() {\n"
- ++ concat (map ((++"\n") . scad3 res) objs)
- ++ "}\n"
-scad3 res (Translate3 (x,y,z) obj) =
- "translate ([" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]) "
- ++ scad3 res obj
-scad3 res (Scale3 (x,y,z) obj) =
- "scale ([" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]) "
- ++ scad3 res obj
-scad3 _ (Rect3R 0 (x1,y1,z1) (x2,y2,z2)) =
- "translate ([" ++ show x1 ++ "," ++ show y1 ++ "," ++ show z1 ++ "]) "
- ++ "cube ([" ++ show (x2-x1) ++ "," ++ show (y2-y1) ++ "," ++ show (z2-z1) ++ "]);"
-scad3 _ (Cylinder h r1 r2) =
- "cylinder(r1 = " ++ show r1 ++ ", r2 = " ++ show r2 ++ ", " ++ show h ++ ");"
-scad3 _ (Sphere r) =
- "sphere(r = " ++ show r ++");"
-scad3 res (ExtrudeR 0 obj h) =
- "linear_extrude(" ++ show h ++ ")"
- ++ scad2 res obj
-scad3 res (ExtrudeRotateR 0 twist obj h) =
- "linear_extrude(" ++ show h ++ ", twist = " ++ show twist ++ " )"
- ++ scad2 res obj
-scad3 res (ExtrudeRM 0 (Just twist) Nothing Nothing obj (Left height)) =
- let
- for a b = map b a
- a ++! b = a ++ show b
- in (\pieces -> "union(){" ++ concat pieces ++ "}") . for (init [0, res.. height]) $ \h ->
- "rotate ([0,0," ++! twist h ++ "]) "
- ++ "linear_extrude(" ++! res ++ ", twist = " ++! (twist (h+res) - twist h) ++ " )"
- ++ scad2 res obj
-
-scad2 res (UnionR2 0 objs) =
- "union() {\n"
- ++ concat (map ((++"\n") . scad2 res) objs)
- ++ "}\n"
-scad2 res (DifferenceR2 0 objs) =
- "difference() {\n"
- ++ concat (map ((++"\n") . scad2 res) objs)
- ++ "}\n"
-scad2 res (IntersectR2 0 objs) =
- "intersection() {\n"
- ++ concat (map ((++"\n") . scad2 res) objs)
- ++ "}\n"
-scad2 res (Translate2 (x,y) obj) =
- "translate ([" ++ show x ++ "," ++ show y ++ "," ++ "]) "
- ++ scad2 res obj
-scad2 res (Scale2 (x,y) obj) =
- "scale ([" ++ show x ++ "," ++ show y ++ "]) "
- ++ scad2 res obj
-scad2 _ (RectR 0 (x1,y1) (x2,y2)) =
- "translate ([" ++ show x1 ++ "," ++ show y1 ++ "]) "
- ++ "cube ([" ++ show (x2-x1) ++ "," ++ show (y2-y1) ++ "]);"
-scad2 _ (Circle r) = "circle(" ++ show r ++ ");"
-scad2 _ (PolygonR 0 points) =
- "polygon("
- ++ "["
- ++ (concat. List.intersperse "," . map (\(a,b) -> "["++show a++","++show b++"]" ) $ points)
- ++ "]"
- ++ ");"
+import Graphics.Implicit.Export.TextBuilderUtils
+
+import Control.Monad.Reader
+import Control.Monad (sequence)
+
+import Data.List (intersperse)
+
+
+scad2 :: ℝ -> SymbolicObj2 -> Text
+scad2 res obj = toLazyText $ runReader (buildS2 obj) res
+
+scad3 :: ℝ -> SymbolicObj3 -> Text
+scad3 res obj = toLazyText $ runReader (buildS3 obj) res
+
+
+
+-- Format an openscad call given that all the modified objects are in the Reader monad...
+
+call :: Builder -> [Builder] -> [Reader a Builder] -> Reader a Builder
+call name args [] = return $ name <> buildArgs args <> ";"
+call name args [obj] = fmap ((name <> buildArgs args) <>) obj
+call name args objs = do
+ objs' <- fmap (mconcat . map (<> "\n")) $ sequence objs
+ return $! name <> buildArgs args <> "{\n" <> objs' <> "}\n"
+
+buildArgs [] = "()"
+buildArgs args = "([" <> mconcat (intersperse "," args) <> "])"
+
+
+buildS3 :: SymbolicObj3 -> ReaderBuilder
+
+buildS3 (UnionR3 0 objs) = call "union" [] $ map buildS3 objs
+
+buildS3 (DifferenceR3 0 objs) = call "difference" [] $ map buildS3 objs
+
+buildS3 (IntersectR3 0 objs) = call " intersection" [] $ map buildS3 objs
+
+buildS3 (Translate3 (x,y,z) obj) = call "translate" [buildFloat x, buildFloat y, buildFloat z] [buildS3 obj]
+
+buildS3 (Scale3 (x,y,z) obj) = call "scale" [buildFloat x, buildFloat y, buildFloat x] [buildS3 obj]
+
+buildS3 (Rect3R 0 (x1,y1,z1) (x2,y2,z2)) = call "translate" [buildFloat x1, buildFloat y1, buildFloat z1] [
+ call "cube" [buildFloat $ x2 - x1, buildFloat $ y2 - y1, buildFloat $ z2 - z1] []
+ ]
+buildS3 (Cylinder h r1 r2) = call "cylinder" [
+ "r1 = " <> buildFloat r1
+ ,"r2 = " <> buildFloat r2
+ , buildFloat h
+ ] []
+
+buildS3 (Sphere r) = call "sphere" ["r = " <> buildFloat r] []
+
+buildS3 (ExtrudeR 0 obj h) = call "linear_extrude" [buildFloat h] [buildS2 obj]
+
+buildS3 (ExtrudeRotateR 0 twist obj h) =
+ call "linear_extrude" [buildFloat h, "twist = " <> buildFloat twist] [buildS2 obj]
+
+buildS3 (ExtrudeRM 0 (Just twist) Nothing Nothing obj (Left height)) = do
+ res <- ask
+ call "union" [] [
+ call "rotate" ["0","0", buildFloat $ twist h] [
+ call "linear_extrude" [buildFloat res, "twist = " <> buildFloat (twist (h+res) - twist h)][
+ buildS2 obj
+ ]
+ ] | h <- init [0, res .. height]
+ ]
+
+buildS2 :: SymbolicObj2 -> ReaderBuilder
+
+buildS2 (UnionR2 0 objs) = call "union" [] $ map buildS2 objs
+
+buildS2 (DifferenceR2 0 objs) = call "difference" [] $ map buildS2 objs
+
+buildS2 (IntersectR2 0 objs) = call "intersection" [] $ map buildS2 objs
+
+buildS2 (Translate2 (x,y) obj) = call "translate" [buildFloat x, buildFloat y] $ [buildS2 obj]
+
+buildS2 (Scale2 (x,y) obj) = call "scale" [buildFloat x, buildFloat y] $ [buildS2 obj]
+
+buildS2 (RectR 0 (x1,y1) (x2,y2)) = call "translate" [buildFloat x1, buildFloat y1] [
+ call "cube" [buildFloat $ x2 - x1, buildFloat $ y2 - y1] []
+ ]
+
+buildS2 (Circle r) = call "circle" [buildFloat r] []
+buildS2 (PolygonR 0 points) = call "polygon" [buildVector [x,y] | (x,y) <- points] []
+ where buildVector comps = "[" <> mconcat (intersperse "," $ map buildFloat comps) <> "]"
View
8 Graphics/Implicit/Export/TextBuilderUtils.hs
@@ -1,15 +1,17 @@
--- This module exists to rexport a coherent set of functions to defined
+-- This module exists to re-export a coherent set of functions to define
-- Data.Text.Lazy builders with.
module Graphics.Implicit.Export.TextBuilderUtils
(
-- Values from Data.Text.Lazy
Text
- ,pack
+ ,pack
+ ,replicate
-- Values from Data.Text.Lazy.Builder, as well as some special builders
,Builder
,toLazyText
+ ,fromLazyText
,buildInt
-- Serialize a float in full precision
,buildFloat
@@ -31,6 +33,8 @@ import Data.Text.Lazy.Builder.Int
import Graphics.Implicit.Definitions
+import Prelude hiding (replicate)
+
buildFloat, buildTruncFloat :: ℝ -> Builder
buildFloat = formatRealFloat Fixed Nothing
View
5 implicit.cabal
@@ -25,8 +25,9 @@ Library
plugins,
deepseq,
text,
- blaze-svg
-
+ blaze-svg,
+ mtl
+
ghc-options:
-O2 -optc-O3
-threaded

0 comments on commit c7dfb60

Please sign in to comment.
Something went wrong with that request. Please try again.