Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

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

This pretty much solves the performance issues vs. the original
string implementation.
  • Loading branch information...
commit 71dc7e48e07b750086820fe02f3fee8e4a6f55d2 1 parent 916bd78
@matthewSorensen matthewSorensen authored
View
4 Graphics/Implicit/Export/NormedTriangleMeshFormats.hs
@@ -13,10 +13,10 @@ 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 -> Builder
- v (x,y,z) = "v " <> buildFloat x <> " " <> buildFloat y <> " " <> buildFloat z <> "\n"
+ 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 -> Builder
- n (x,y,z) = "vn " <> buildFloat x <> " " <> buildFloat y <> " " <> buildFloat z <> "\n"
+ 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), ...)
View
2  Graphics/Implicit/Export/PolylineFormats.hs
@@ -32,7 +32,7 @@ svg = renderSvg . svg11 . svg'
minmax (xa,ya) (xb,yb) = (min xa xb, max ya yb)
poly xmin ymax line = polyline ! A.points pointList
- where pointList = toValue $ toLazyText $ mconcat [buildFloat (x-xmin) <> "," <> buildFloat (ymax - y) <> " " | (x,y) <- line]
+ 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
View
36 Graphics/Implicit/Export/SymbolicFormats.hs
@@ -43,31 +43,31 @@ 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 (Translate3 (x,y,z) obj) = call "translate" [bf x, bf y, bf z] [buildS3 obj]
-buildS3 (Scale3 (x,y,z) obj) = call "scale" [buildFloat x, buildFloat y, buildFloat x] [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" [buildFloat x1, buildFloat y1, buildFloat z1] [
- call "cube" [buildFloat $ x2 - x1, buildFloat $ y2 - y1, buildFloat $ z2 - z1] []
+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 = " <> buildFloat r1
- ,"r2 = " <> buildFloat r2
- , buildFloat h
+ "r1 = " <> bf r1
+ ,"r2 = " <> bf r2
+ , bf h
] []
-buildS3 (Sphere r) = call "sphere" ["r = " <> buildFloat r] []
+buildS3 (Sphere r) = call "sphere" ["r = " <> bf r] []
-buildS3 (ExtrudeR 0 obj h) = call "linear_extrude" [buildFloat h] [buildS2 obj]
+buildS3 (ExtrudeR 0 obj h) = call "linear_extrude" [bf h] [buildS2 obj]
buildS3 (ExtrudeRotateR 0 twist obj h) =
- call "linear_extrude" [buildFloat h, "twist = " <> buildFloat twist] [buildS2 obj]
+ 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", buildFloat $ twist h] [
- call "linear_extrude" [buildFloat res, "twist = " <> buildFloat (twist (h+res) - twist h)][
+ 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]
@@ -81,17 +81,17 @@ 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 (Translate2 (x,y) obj) = call "translate" [bf x, bf y] $ [buildS2 obj]
-buildS2 (Scale2 (x,y) obj) = call "scale" [buildFloat x, buildFloat 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" [buildFloat x1, buildFloat y1] [
- call "cube" [buildFloat $ x2 - x1, buildFloat $ y2 - y1] []
+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" [buildFloat r] []
+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 buildFloat comps) <> "]"
+ where buildVector comps = "[" <> mconcat (intersperse "," $ map bf comps) <> "]"
View
16 Graphics/Implicit/Export/TextBuilderUtils.hs
@@ -14,7 +14,7 @@ module Graphics.Implicit.Export.TextBuilderUtils
,fromLazyText
,buildInt
-- Serialize a float in full precision
- ,buildFloat
+ ,bf
-- Serialize a float with four decimal places
,buildTruncFloat
-- Values from Data.Monoid
@@ -29,7 +29,8 @@ import Data.Text.Lazy
import Data.Monoid hiding ((<>))
import Data.Text.Lazy
-import Data.Text.Lazy.Builder
+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
@@ -37,9 +38,16 @@ import Graphics.Implicit.Definitions
import Prelude hiding (replicate)
-buildFloat, buildTruncFloat ::-> Builder
-buildFloat = formatRealFloat Fixed Nothing
+-- 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
View
8 Graphics/Implicit/Export/TriangleMeshFormats.hs
@@ -14,9 +14,9 @@ stl triangles = toLazyText $ stlHeader <> mconcat (map triangle triangles) <> st
stlFooter = "endsolid ImplictCADExport\n"
vertex :: ℝ3 -> Builder
vertex (x,y,z) = mconcat ["vertex "
- ,buildFloat x , " "
- ,buildFloat y , " "
- ,buildFloat z]
+ ,bf x , " "
+ ,bf y , " "
+ ,bf z]
triangle :: (ℝ3, ℝ3, ℝ3) -> Builder
triangle (a,b,c) =
"facet normal 0 0 0\n"
@@ -45,7 +45,7 @@ jsTHREE triangles = toLazyText $ header <> vertcode <> facecode <> footer
,"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(" <> buildFloat x <> "," <> buildFloat y <> "," <> buildFloat z <> ");\n"
+ v (x,y,z) = "v(" <> bf x <> "," <> bf y <> "," <> bf z <> ");\n"
-- A face line
f :: Int -> Int -> Int -> Builder
f posa posb posc =
Please sign in to comment.
Something went wrong with that request. Please try again.