Browse files

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.)
  • Loading branch information...
1 parent ef3f51e commit e2c786be76de6c03590c5f51fcb97e0c7a6c388a @matthewSorensen committed Aug 24, 2012
View
32 Graphics/Implicit/Export/NormedTriangleMeshFormats.hs
@@ -1,20 +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
-import Data.Text.Lazy (pack)
-obj normedtriangles = pack 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 " <> buildFloat x <> " " <> buildFloat y <> " " <> buildFloat 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 " <> buildFloat x <> " " <> buildFloat y <> " " <> buildFloat z <> "\n"
verts = do
-- extract the vertices for each triangle
-- recall that a normed triangle is of the form ((vert, norm), ...)
@@ -26,17 +28,13 @@ obj normedtriangles = pack 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
16 Graphics/Implicit/Export/PolylineFormats.hs
@@ -7,10 +7,7 @@ module Graphics.Implicit.Export.PolylineFormats where
import Graphics.Implicit.Definitions
-import Text.Printf (printf)
-
-import Data.Text.Lazy (Text,unwords,pack)
-import Data.Text.Lazy.Builder
+import Graphics.Implicit.Export.TextBuilderUtils
import Text.Blaze.Svg.Renderer.Text (renderSvg)
import Text.Blaze.Svg
@@ -19,10 +16,6 @@ import qualified Text.Blaze.Svg11.Attributes as A
import Data.List (foldl')
-import Data.Monoid
-
-import Prelude hiding (unwords)
-
svg :: [Polyline] -> Text
svg = renderSvg . svg11 . svg'
where
@@ -39,7 +32,8 @@ 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 $ unwords [pack $ show (x-xmin) ++ "," ++ show (ymax - y) | (x,y) <- line]
+ where pointList = toValue $ toLazyText $ mconcat [buildFloat (x-xmin) <> "," <> buildFloat (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
@@ -58,10 +52,8 @@ hacklabLaserGCode polylines = toLazyText $ gcodeHeader <> mconcat (map interpret
,"G00 X0.0 Y0.0 (move to 0)\n"
,"M2 (end)"]
gcodeXY :: ℝ2 -> Builder
- gcodeXY (x,y) = mconcat ["X", showF x, " Y", showF y]
+ gcodeXY (x,y) = mconcat ["X", buildTruncFloat x, " Y", buildTruncFloat y]
- showF = fromString . printf "%.4f"
-
interpretPolyline (start:others) = mconcat [
"G00 ", gcodeXY start
,"\nM62 P0 (laser on)\n"
View
41 Graphics/Implicit/Export/TextBuilderUtils.hs
@@ -0,0 +1,41 @@
+-- This module exists to rexport a coherent set of functions to defined
+-- Data.Text.Lazy builders with.
+
+
+module Graphics.Implicit.Export.TextBuilderUtils
+ (
+ -- Values from Data.Text.Lazy
+ Text
+ ,pack
+ -- Values from Data.Text.Lazy.Builder, as well as some special builders
+ ,Builder
+ ,toLazyText
+ ,buildInt
+ -- Serialize a float in full precision
+ ,buildFloat
+ -- Serialize a float with four decimal places
+ ,buildTruncFloat
+ -- Values from Data.Monoid
+ ,(<>)
+ ,mconcat
+ ,mempty
+
+ ) where
+import Data.Text.Lazy
+import Data.Monoid
+
+import Data.Text.Lazy
+import Data.Text.Lazy.Builder
+import Data.Text.Lazy.Builder.RealFloat
+import Data.Text.Lazy.Builder.Int
+
+import Graphics.Implicit.Definitions
+
+buildFloat, buildTruncFloat :: ℝ -> Builder
+
+buildFloat = formatRealFloat Fixed Nothing
+
+buildTruncFloat = formatRealFloat Fixed $ Just 4
+
+buildInt :: Int -> Builder
+buildInt = decimal
View
86 Graphics/Implicit/Export/TriangleMeshFormats.hs
@@ -6,22 +6,17 @@
module Graphics.Implicit.Export.TriangleMeshFormats where
import Graphics.Implicit.Definitions
-
-import Data.Text.Lazy (Text,pack)
-
-import Data.Text.Lazy.Builder
-
-import Data.Monoid
+import Graphics.Implicit.Export.TextBuilderUtils
stl triangles = toLazyText $ stlHeader <> mconcat (map triangle triangles) <> stlFooter
where
stlHeader = "solid ImplictCADExport\n"
stlFooter = "endsolid ImplictCADExport\n"
vertex :: ℝ3 -> Builder
vertex (x,y,z) = mconcat ["vertex "
- ,fromString $ show x , " "
- ,fromString $ show y , " "
- ,fromString $ show z]
+ ,buildFloat x , " "
+ ,buildFloat y , " "
+ ,buildFloat z]
triangle :: (ℝ3, ℝ3, ℝ3) -> Builder
triangle (a,b,c) =
"facet normal 0 0 0\n"
@@ -31,42 +26,39 @@ stl triangles = toLazyText $ stlHeader <> mconcat (map triangle triangles) <> st
<> vertex c
<> "\nendloop\nendfacet\n"
-
jsTHREE :: TriangleMesh -> Text
-jsTHREE triangles = pack 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
-
+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(" <> buildFloat x <> "," <> buildFloat y <> "," <> buildFloat 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

0 comments on commit e2c786b

Please sign in to comment.