Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Convert output formats to use Data.Text.Lazy and SVG combinator library #56

Merged
merged 8 commits into from

2 participants

@matthewSorensen

While poking around with the internals of ImplicitCAD in order to develop a package that adds GHCLive support*, I noticed that all of the functions that convert objects to various output formats directly concatenate strings. In order to reduce memory consumption and accelerate the output process, I converted everything to either use Data.Text.Lazy builders or (in the case of SVG) special combinator libraries.

The largest impact these commits have is the introduction of a few new dependencies:

  • text >= 0.11.1.0. As your convention for dependencies seems be not specifying package versions, I omitted this requirement from implicit.cabal - however, it won't compile with anything less than 0.11.1.0.

  • blaze-svg, which in turn requires blaze-markup >= 0.5

  • mtl, in order to provide the Reader monad.

Otherwise, there are no public-facing API changes at this time - although starting a discussion about refactoring the output API seems smart.

Note that I couldn't find particularly good test cases for openscad output - especially for objects that invoke the ExtrudeRM codepath. I suspect this module is correct, but some more verification wouldn't hurt.

* This may just be the killer application for GHCLive - it's a really cool combination!

matthewSorensen added some commits
@matthewSorensen matthewSorensen Switch to using Data.Text.Lazy instead of String for output.
Note that all of the existing formatting functions still build strings,
so this commit introduces no performance gains. However, I plan on rewriting
all of them using the relevant builder modules, so all of the output
code paths should get much faster.

(Commit 1/n of my quest to add efficient GHCLive support for ImplicitCAD.)
d6164e9
@matthewSorensen matthewSorensen Rewrite the SVG output code to use blaze-svg.
Presumably, this has tremendous positive performance implications,
but I haven't benchmarked it.

(Commit 2/n of my quest to add efficient GHCLive support for ImplicitCAD.)
f906115
@matthewSorensen matthewSorensen Rewrite laser cutter output to use Data.Text.Lazy.Builder.
Output is line-for-line identical to the previous version. Note that
this does introduce a lower bound for base, as <> is a somewhat recent
introduction.

(Commit 3/n of my quest to add efficient GHCLive support for ImplicitCAD.)
ed3e934
@matthewSorensen matthewSorensen Update STL output. ef3f51e
@matthewSorensen matthewSorensen Create a new module Graphics.Implicit.Export.TextBuilderUtils to mana…
…ge exports.

Also switch all of the functions for showing integers and floats to
the native Data.Text.Lazy.Builder.* functions.

(Commit 5/n of my quest to add efficient GHCLive support for ImplicitCAD.)
e2c786b
@matthewSorensen matthewSorensen 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.)
c7dfb60
@matthewSorensen matthewSorensen Define the <> syn for mappend so as to build with base < 4.5. 916bd78
@colah
Owner

Hey Matthew!

It's really exciting that you are interested in ImplicitCAD. More people contributing would be awesome! (You may wish to check out hacking.md)

On the surface, switching to Data.Text.Lazy seems like an awesome idea. I've tried using a few different String alternatives (namely some of the byestrings), since we seem to be loosing a significant amount of time on generating the text of different files (according to some profiling that I don't entirely trust).

Unfortunately, I don't really understand lazy performance well enough to predict if things will actually speed up ImplicitCAD. So I rely on benchmarking code to determine if a change genuinely has a positive impact on performance (and I've tried and had to reject dozens of things I expected to improve performance but didn't).

To test your code, I used the following object:

$res = 1;
union() {
  cube(40);
  translate([30,30,30]) cube(40);
}

I ran the old code 10 times (with one thread, since multi-threading makes performance harder to track). It took the following amounts of time:

3.440s
3.377s
3.356s
3.399s
3.507s
3.493s
3.348s
3.415s
3.459s
3.442s

I then ran your code:

3.694s
3.788s
3.776s
3.795s
3.787s
3.779s
3.739s
3.759s
3.599s
3.649s

My guess is that it has something to do with the triangles not being lazily generated (this is a result of parallelism having different sections of the list generated simultaneously).

That said, your code for generating SVGs is a bit faster. So that's definitely something to incorporate.

I can't merge this code right now, but if you can get it to the point where it is more performant than the present version, I'd be thrilled to accept it.

@colah
Owner

That said, your code for generating SVGs is a bit faster

It occurs to me that parallelism is presently not being used in 2D objects right now... This would reinforce the notion that it has to do with the laziness of the triangle mesh.

@matthewSorensen matthewSorensen Switch to a much larger buffer size (16 K chars, vs 128).
This pretty much solves the performance issues vs. the original
string implementation.
71dc7e4
@matthewSorensen

It turns out that the main performance issue was that I was using a ridiculously tiny buffer size when converting Builders to Text. The last commit remedies this - here's a benchmark demonstrating that, and the typical results of running it. The end result is that both implementations are very close in terms of performance, although the text version tends to be slightly faster. My main interest in making these changes was not performance, however - rather, fully evaluated Text uses significantly less (~2/5 as much) memory as Strings.

I was also considering implementing support for binary stl files - is this a desirable addition?

@colah colah merged commit 3562552 into from
@colah
Owner

Binary STLs would be appreciated. :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Aug 23, 2012
  1. @matthewSorensen

    Switch to using Data.Text.Lazy instead of String for output.

    matthewSorensen authored
    Note that all of the existing formatting functions still build strings,
    so this commit introduces no performance gains. However, I plan on rewriting
    all of them using the relevant builder modules, so all of the output
    code paths should get much faster.
    
    (Commit 1/n of my quest to add efficient GHCLive support for ImplicitCAD.)
Commits on Aug 24, 2012
  1. @matthewSorensen

    Rewrite the SVG output code to use blaze-svg.

    matthewSorensen authored
    Presumably, this has tremendous positive performance implications,
    but I haven't benchmarked it.
    
    (Commit 2/n of my quest to add efficient GHCLive support for ImplicitCAD.)
  2. @matthewSorensen

    Rewrite laser cutter output to use Data.Text.Lazy.Builder.

    matthewSorensen authored
    Output is line-for-line identical to the previous version. Note that
    this does introduce a lower bound for base, as <> is a somewhat recent
    introduction.
    
    (Commit 3/n of my quest to add efficient GHCLive support for ImplicitCAD.)
  3. @matthewSorensen

    Update STL output.

    matthewSorensen authored
  4. @matthewSorensen

    Create a new module Graphics.Implicit.Export.TextBuilderUtils to mana…

    matthewSorensen authored
    …ge exports.
    
    Also switch all of the functions for showing integers and floats to
    the native Data.Text.Lazy.Builder.* functions.
    
    (Commit 5/n of my quest to add efficient GHCLive support for ImplicitCAD.)
Commits on Aug 25, 2012
  1. @matthewSorensen

    Re-implement the SCAD output module.

    matthewSorensen authored
    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.)
  2. @matthewSorensen
Commits on Aug 28, 2012
  1. @matthewSorensen

    Switch to a much larger buffer size (16 K chars, vs 128).

    matthewSorensen authored
    This pretty much solves the performance issues vs. the original
    string implementation.
This page is out of date. Refresh to see the latest.
View
31 Graphics/Implicit/Export.hs
@@ -6,7 +6,9 @@ module Graphics.Implicit.Export where
import Graphics.Implicit.Definitions
--import Graphics.Implicit.Operations (slice)
-import System.IO (writeFile)
+import Data.Text.Lazy (Text,pack)
+import Data.Text.Lazy.IO (writeFile)
+import Prelude hiding (writeFile)
-- class DiscreteApproxable
import Graphics.Implicit.Export.Definitions
@@ -24,18 +26,21 @@ import qualified Graphics.Implicit.Export.SymbolicFormats as SymbolicFormats
-- Write an object in a given formet...
writeObject :: (DiscreteAproxable obj aprox) =>
- -- ^ Resolution
- -> (aprox -> String) -- ^ File Format (Function that formats)
- -> FilePath -- ^ File Name
- -> obj -- ^ Object to render
- -> IO() -- ^ Writing Action!
+ -- ^ Resolution
+ -> (aprox -> Text) -- ^ File Format (Function that formats)
+ -> 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
+writeObject res format filename obj = writeFile filename $ formatObject res format obj
--- Now functions to write it in specific formats
+formatObject :: (DiscreteAproxable obj aprox) =>
+ ℝ -- ^ Resolution
+ -> (aprox -> Text) -- ^ File Format (Function that formats)
+ -> obj -- ^ Object to render
+ -> Text -- ^ Resulting lazy ByteString
+
+formatObject res format = format . discreteAprox res
writeSVG res = writeObject res PolylineFormats.svg
@@ -45,8 +50,8 @@ writeTHREEJS res = writeObject res TriangleMeshFormats.jsTHREE
writeGCodeHacklabLaser res = writeObject res PolylineFormats.hacklabLaserGCode
-writeSCAD3 res filename obj = writeFile filename (SymbolicFormats.scad3 res obj)
-writeSCAD2 res filename obj = writeFile filename (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
32 Graphics/Implicit/Export/NormedTriangleMeshFormats.hs
@@ -1,18 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export.NormedTriangleMeshFormats where
import Graphics.Implicit.Definitions
+import Graphics.Implicit.Export.TextBuilderUtils
+
-obj normedtriangles = text
+obj normedtriangles = toLazyText $ vertcode <> normcode <> trianglecode
where
-- A vertex line; v (0.0, 0.0, 1.0) = "v 0.0 0.0 1.0\n"
- v :: ℝ3 -> String
- v (x,y,z) = "v " ++ show x ++ " " ++ show y ++ " " ++ show z ++ "\n"
+ v :: ℝ3 -> Builder
+ v (x,y,z) = "v " <> bf x <> " " <> bf y <> " " <> bf z <> "\n"
-- A normal line; n (0.0, 0.0, 1.0) = "vn 0.0 0.0 1.0\n"
- n :: ℝ3 -> String
- n (x,y,z) = "vn " ++ show x ++ " " ++ show y ++ " " ++ show z ++ "\n"
+ n :: ℝ3 -> Builder
+ n (x,y,z) = "vn " <> bf x <> " " <> bf y <> " " <> bf z <> "\n"
verts = do
-- extract the vertices for each triangle
-- recall that a normed triangle is of the form ((vert, norm), ...)
@@ -24,17 +28,13 @@ obj normedtriangles = text
((_,a),(_,b),(_,c)) <- normedtriangles
-- The normals from each triangle take up 3 position in the resulting list
[a,b,c]
- vertcode = concat $ map v verts
- normcode = concat $ map n norms
- trianglecode = concat $ do
+ vertcode = mconcat $ map v verts
+ normcode = mconcat $ map n norms
+ trianglecode = mconcat $ do
n <- map ((+1).(*3)) [0,1 .. length normedtriangles -1]
let
- vta = show n -- ++ "//" ++ show n
- vtb = show (n+1)-- ++ "//" ++ show (n+1)
- vtc = show (n+2)-- ++ "//" ++ show (n+2)
- return $ "f " ++ vta ++ " " ++ vtb ++ " " ++ vtc ++ " " ++ "\n"
- text = vertcode ++ normcode ++ trianglecode
-
-
-
+ vta = buildInt n
+ vtb = buildInt (n+1)
+ vtc = buildInt (n+2)
+ return $ "f " <> vta <> " " <> vtb <> " " <> vtc <> " " <> "\n"
View
99 Graphics/Implicit/Export/PolylineFormats.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
@@ -6,49 +7,57 @@ module Graphics.Implicit.Export.PolylineFormats where
import Graphics.Implicit.Definitions
-import Text.Printf (printf)
-
-svg :: [Polyline] -> String
-svg polylines = text
- where
- -- SVG is stupidly laid out... (0,0) is the top left corner
- (xs, ys) = unzip (concat polylines)
- (minx, maxy) = (minimum xs, maximum ys)
- transform (x,y) = (x-minx, maxy - y)
- polylines2 = map (map transform) polylines
- svglines = concat $ map (\line ->
- " <polyline points=\""
- ++ concat (map (\(x,y) -> " " ++ show x ++ "," ++ show y) line)
- ++ "\" style=\"stroke:rgb(0,0,255);stroke-width:1;fill:none;\"/> \n" )
- polylines2
- text = "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\"> \n"
- ++ svglines
- ++ "</svg> "
-
-hacklabLaserGCode :: [Polyline] -> String
-hacklabLaserGCode polylines = text
- where
- gcodeHeader =
- "(generated by ImplicitCAD, based of hacklab wiki example)\n"
- ++"M63 P0 (laser off)\n"
- ++"G0 Z0.002 (laser off)\n"
- ++"G21 (units=mm)\n"
- ++"F400 (set feedrate)\n"
- ++"M3 S1 (enable laser)\n"
- ++"\n"
- gcodeFooter =
- "M5 (disable laser)\n"
- ++"G00 X0.0 Y0.0 (move to 0)\n"
- ++"M2 (end)"
- showF n = printf "%.4f" n
- gcodeXY :: ℝ2 -> [Char]
- gcodeXY (x,y) = "X"++ showF x ++" Y"++ showF y
- interpretPolyline (start:others) =
- "G00 "++ gcodeXY start ++ "\n"
- ++ "M62 P0 (laser on)\n"
- ++ concat (map (\p -> "G01 " ++ (gcodeXY p) ++ "\n") others)
- ++ "M63 P0 (laser off)\n\n"
- text = gcodeHeader
- ++ (concat $ map interpretPolyline polylines)
- ++ gcodeFooter
+import Graphics.Implicit.Export.TextBuilderUtils
+import Text.Blaze.Svg.Renderer.Text (renderSvg)
+import Text.Blaze.Svg
+import Text.Blaze.Svg11 ((!),docTypeSvg,g,polyline,toValue)
+import qualified Text.Blaze.Svg11.Attributes as A
+
+import Data.List (foldl')
+
+svg :: [Polyline] -> Text
+svg = renderSvg . svg11 . svg'
+ where
+ svg11 content = docTypeSvg ! A.version "1.1" $ content
+ -- The reason this isn't totally straightforwards is that svg has different coordinate system
+ -- and we need to compute the requisite translation.
+ svg' [] = mempty
+ -- When we have a known point, we can compute said transformation:
+ svg' polylines@((start:_):_) = let (xmin, ymax) = foldl' (foldl' minmax) start polylines
+ in thinBlueGroup $ mapM_ (poly xmin ymax) polylines
+ -- Otherwise, if we don't have a point to start out with, skip this polyline:
+ svg' ([]:rest) = svg' rest
+
+ minmax (xa,ya) (xb,yb) = (min xa xb, max ya yb)
+
+ poly xmin ymax line = polyline ! A.points pointList
+ where pointList = toValue $ toLazyText $ mconcat [bf (x-xmin) <> "," <> bf (ymax - y) <> " " | (x,y) <- line]
+
+ -- Instead of setting styles on every polyline, we wrap the lines in a group element and set the styles on it:
+ thinBlueGroup = g ! A.stroke "rgb(0,0,255)" ! A.strokeWidth "1" ! A.fill "none" -- $ obj
+
+hacklabLaserGCode :: [Polyline] -> Text
+hacklabLaserGCode polylines = toLazyText $ gcodeHeader <> mconcat (map interpretPolyline polylines) <> gcodeFooter
+ where
+ gcodeHeader = mconcat [
+ "(generated by ImplicitCAD, based of hacklab wiki example)\n"
+ ,"M63 P0 (laser off)\n"
+ ,"G0 Z0.002 (laser off)\n"
+ ,"G21 (units=mm)\n"
+ ,"F400 (set feedrate)\n"
+ ,"M3 S1 (enable laser)\n\n"]
+ gcodeFooter = mconcat [
+ "M5 (disable laser)\n"
+ ,"G00 X0.0 Y0.0 (move to 0)\n"
+ ,"M2 (end)"]
+ gcodeXY :: ℝ2 -> Builder
+ gcodeXY (x,y) = mconcat ["X", buildTruncFloat x, " Y", buildTruncFloat y]
+
+ interpretPolyline (start:others) = mconcat [
+ "G00 ", gcodeXY start
+ ,"\nM62 P0 (laser on)\n"
+ ,mconcat [ "G01 " <> gcodeXY point <> "\n" | point <- others]
+ ,"M63 P0 (laser off)\n\n"
+ ]
+ interpretPolyline [] = mempty
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" [bf x, bf y, bf z] [buildS3 obj]
+
+buildS3 (Scale3 (x,y,z) obj) = call "scale" [bf x, bf y, bf x] [buildS3 obj]
+
+buildS3 (Rect3R 0 (x1,y1,z1) (x2,y2,z2)) = call "translate" [bf x1, bf y1, bf z1] [
+ call "cube" [bf $ x2 - x1, bf $ y2 - y1, bf $ z2 - z1] []
+ ]
+buildS3 (Cylinder h r1 r2) = call "cylinder" [
+ "r1 = " <> bf r1
+ ,"r2 = " <> bf r2
+ , bf h
+ ] []
+
+buildS3 (Sphere r) = call "sphere" ["r = " <> bf r] []
+
+buildS3 (ExtrudeR 0 obj h) = call "linear_extrude" [bf h] [buildS2 obj]
+
+buildS3 (ExtrudeRotateR 0 twist obj h) =
+ call "linear_extrude" [bf h, "twist = " <> bf twist] [buildS2 obj]
+
+buildS3 (ExtrudeRM 0 (Just twist) Nothing Nothing obj (Left height)) = do
+ res <- ask
+ call "union" [] [
+ call "rotate" ["0","0", bf $ twist h] [
+ call "linear_extrude" [bf res, "twist = " <> bf (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" [bf x, bf y] $ [buildS2 obj]
+
+buildS2 (Scale2 (x,y) obj) = call "scale" [bf x, bf y] $ [buildS2 obj]
+
+buildS2 (RectR 0 (x1,y1) (x2,y2)) = call "translate" [bf x1, bf y1] [
+ call "cube" [bf $ x2 - x1, bf $ y2 - y1] []
+ ]
+
+buildS2 (Circle r) = call "circle" [bf r] []
+buildS2 (PolygonR 0 points) = call "polygon" [buildVector [x,y] | (x,y) <- points] []
+ where buildVector comps = "[" <> mconcat (intersperse "," $ map bf comps) <> "]"
View
61 Graphics/Implicit/Export/TextBuilderUtils.hs
@@ -0,0 +1,61 @@
+-- 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
+ ,replicate
+ -- Values from Data.Text.Lazy.Builder, as well as some special builders
+ ,Builder
+ ,toLazyText
+ ,fromLazyText
+ ,buildInt
+ -- Serialize a float in full precision
+ ,bf
+ -- Serialize a float with four decimal places
+ ,buildTruncFloat
+ -- Values from Data.Monoid
+ ,(<>)
+ ,mconcat
+ ,mempty
+
+ ) where
+import Data.Text.Lazy
+-- We manually redefine this operator to avoid a dependency on base >= 4.5
+-- This will become unnecessary later.
+import Data.Monoid hiding ((<>))
+
+import Data.Text.Lazy
+import Data.Text.Lazy.Internal (defaultChunkSize)
+import Data.Text.Lazy.Builder hiding (toLazyText)
+import Data.Text.Lazy.Builder.RealFloat
+import Data.Text.Lazy.Builder.Int
+
+import Graphics.Implicit.Definitions
+
+import Prelude hiding (replicate)
+
+
+-- The chunk size for toLazyText is very small (128 bytes), so we export
+-- a version with a much larger size (~16 K)
+toLazyText :: Builder -> Text
+toLazyText = toLazyTextWith defaultChunkSize
+
+bf, buildTruncFloat ::-> Builder
+
+bf = formatRealFloat Exponent Nothing
+{-# INLINE bf #-}
+
+buildTruncFloat = formatRealFloat Fixed $ Just 4
+
+buildInt :: Int -> Builder
+buildInt = decimal
+
+-- This is directly copied from base 4.5.1.0
+infixr 6 <>
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend
+{-# INLINE (<>) #-}
View
107 Graphics/Implicit/Export/TriangleMeshFormats.hs
@@ -1,65 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Released under the GNU GPL, see LICENSE
module Graphics.Implicit.Export.TriangleMeshFormats where
import Graphics.Implicit.Definitions
+import Graphics.Implicit.Export.TextBuilderUtils
-stl triangles = text
+stl triangles = toLazyText $ stlHeader <> mconcat (map triangle triangles) <> stlFooter
where
stlHeader = "solid ImplictCADExport\n"
stlFooter = "endsolid ImplictCADExport\n"
- vertex :: ℝ3 -> String
- vertex (x,y,z) = "vertex " ++ show x ++ " " ++ show y ++ " " ++ show z
- stlTriangle :: (ℝ3, ℝ3, ℝ3) -> String
- stlTriangle (a,b,c) =
- "facet normal 0 0 0\n"
- ++ "outer loop\n"
- ++ vertex a ++ "\n"
- ++ vertex b ++ "\n"
- ++ vertex c ++ "\n"
- ++ "endloop\n"
- ++ "endfacet\n"
- text = stlHeader
- ++ (concat $ map stlTriangle triangles)
- ++ stlFooter
-
-
-jsTHREE :: TriangleMesh -> String
-jsTHREE triangles = text
- where
- -- some dense JS. Let's make helper functions so that we don't repeat code each line
- header =
- "var Shape = function(){\n"
- ++ "var s = this;\n"
- ++ "THREE.Geometry.call(this);\n"
- ++ "function vec(x,y,z){return new THREE.Vector3(x,y,z);}\n"
- ++ "function v(x,y,z){s.vertices.push(vec(x,y,z));}\n"
- ++ "function f(a,b,c){"
- ++ "s.faces.push(new THREE.Face3(a,b,c));"
- ++ "}\n"
- footer =
- "}\n"
- ++ "Shape.prototype = new THREE.Geometry();\n"
- ++ "Shape.prototype.constructor = Shape;\n"
- -- A vertex line; v (0.0, 0.0, 1.0) = "v(0.0,0.0,1.0);\n"
- v :: ℝ3 -> String
- v (x,y,z) = "v(" ++ show x ++ "," ++ show y ++ "," ++ show z ++ ");\n"
- -- A face line
- f :: Int -> Int -> Int -> String
- f posa posb posc =
- "f(" ++ show posa ++ "," ++ show posb ++ "," ++ show posc ++ ");"
- verts = do
- -- extract the vertices for each triangle
- -- recall that a normed triangle is of the form ((vert, norm), ...)
- (a,b,c) <- triangles
- -- The vertices from each triangle take up 3 position in the resulting list
- [a,b,c]
- vertcode = concat $ map v verts
- facecode = concat $ do
- (n,_) <- zip [0, 3 ..] triangles
- let
- (posa, posb, posc) = (n, n+1, n+2)
- return $ f posa posb posc
- text = header ++ vertcode ++ facecode ++ footer
+ vertex :: ℝ3 -> Builder
+ vertex (x,y,z) = mconcat ["vertex "
+ ,bf x , " "
+ ,bf y , " "
+ ,bf z]
+ triangle :: (ℝ3, ℝ3, ℝ3) -> Builder
+ triangle (a,b,c) =
+ "facet normal 0 0 0\n"
+ <> "outer loop\n"
+ <> vertex a <> "\n"
+ <> vertex b <> "\n"
+ <> vertex c
+ <> "\nendloop\nendfacet\n"
+jsTHREE :: TriangleMesh -> Text
+jsTHREE triangles = toLazyText $ header <> vertcode <> facecode <> footer
+ where
+ -- some dense JS. Let's make helper functions so that we don't repeat code each line
+ header = mconcat [
+ "var Shape = function(){\n"
+ ,"var s = this;\n"
+ ,"THREE.Geometry.call(this);\n"
+ ,"function vec(x,y,z){return new THREE.Vector3(x,y,z);}\n"
+ ,"function v(x,y,z){s.vertices.push(vec(x,y,z));}\n"
+ ,"function f(a,b,c){"
+ ,"s.faces.push(new THREE.Face3(a,b,c));"
+ ,"}\n" ]
+ footer = mconcat [
+ "}\n"
+ ,"Shape.prototype = new THREE.Geometry();\n"
+ ,"Shape.prototype.constructor = Shape;\n" ]
+ -- A vertex line; v (0.0, 0.0, 1.0) = "v(0.0,0.0,1.0);\n"
+ v :: ℝ3 -> Builder
+ v (x,y,z) = "v(" <> bf x <> "," <> bf y <> "," <> bf z <> ");\n"
+ -- A face line
+ f :: Int -> Int -> Int -> Builder
+ f posa posb posc =
+ "f(" <> buildInt posa <> "," <> buildInt posb <> "," <> buildInt posc <> ");"
+ verts = do
+ -- extract the vertices for each triangle
+ -- recall that a normed triangle is of the form ((vert, norm), ...)
+ (a,b,c) <- triangles
+ -- The vertices from each triangle take up 3 position in the resulting list
+ [a,b,c]
+ vertcode = mconcat $ map v verts
+ facecode = mconcat $ do
+ (n,_) <- zip [0, 3 ..] triangles
+ let
+ (posa, posb, posc) = (n, n+1, n+2)
+ return $ f posa posb posc
View
10 implicit.cabal
@@ -23,8 +23,11 @@ Library
parallel,
containers,
plugins,
- deepseq
-
+ deepseq,
+ text,
+ blaze-svg,
+ mtl
+
ghc-options:
-O2 -optc-O3
-threaded
@@ -47,7 +50,8 @@ Library
ScopedTypeVariables,
TypeSynonymInstances,
UndecidableInstances,
- ViewPatterns
+ ViewPatterns,
+ OverloadedStrings
Exposed-Modules:
Graphics.Implicit
Something went wrong with that request. Please try again.