Binary stl support #60

Merged
merged 4 commits into from Sep 11, 2012
View
@@ -30,6 +30,7 @@ module Graphics.Implicit(
-- Export
writeSVG,
writeSTL,
+ writeBinSTL,
writeOBJ,
writeTHREEJS,
writeSCAD2,
@@ -50,11 +51,12 @@ import Graphics.Implicit.Definitions
-- We want Export to be a bit less polymorphic
-- (so that types will collapse nicely)
-writeSVG = Export.writeSVG :: -> FilePath -> SymbolicObj2 -> IO ()
-writeSTL = Export.writeSTL :: -> FilePath -> SymbolicObj3 -> IO ()
-writeOBJ = Export.writeOBJ :: -> FilePath -> SymbolicObj3 -> IO ()
-writeSCAD2 = Export.writeSCAD2 :: -> FilePath -> SymbolicObj2 -> IO ()
-writeSCAD3 = Export.writeSCAD3 :: -> FilePath -> SymbolicObj3 -> IO ()
+writeSVG = Export.writeSVG :: -> FilePath -> SymbolicObj2 -> IO ()
+writeSTL = Export.writeSTL :: -> FilePath -> SymbolicObj3 -> IO ()
+writeBinSTL = Export.writeBinSTL :: -> FilePath -> SymbolicObj3 -> IO ()
+writeOBJ = Export.writeOBJ :: -> FilePath -> SymbolicObj3 -> IO ()
+writeSCAD2 = Export.writeSCAD2 :: -> FilePath -> SymbolicObj2 -> IO ()
+writeSCAD3 = Export.writeSCAD3 :: -> FilePath -> SymbolicObj3 -> IO ()
writeTHREEJS = Export.writeTHREEJS :: -> FilePath -> SymbolicObj3 -> IO ()
writeGCodeHacklabLaser = Export.writeGCodeHacklabLaser :: -> FilePath -> SymbolicObj2 -> IO ()
@@ -9,6 +9,7 @@ import Graphics.Implicit.Definitions
import Data.Text.Lazy (Text,pack)
import Data.Text.Lazy.IO (writeFile)
import Prelude hiding (writeFile)
+import qualified Data.ByteString.Lazy as LBS
-- class DiscreteApproxable
import Graphics.Implicit.Export.Definitions
@@ -45,6 +46,9 @@ formatObject res format = format . discreteAprox res
writeSVG res = writeObject res PolylineFormats.svg
writeSTL res = writeObject res TriangleMeshFormats.stl
+
+writeBinSTL res file obj = LBS.writeFile file $ TriangleMeshFormats.binaryStl $ discreteAprox res obj
+
writeOBJ res = writeObject res NormedTriangleMeshFormats.obj
writeTHREEJS res = writeObject res TriangleMeshFormats.jsTHREE
@@ -7,7 +7,6 @@ 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
@@ -36,9 +35,6 @@ 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
@@ -8,6 +8,14 @@ module Graphics.Implicit.Export.TriangleMeshFormats where
import Graphics.Implicit.Definitions
import Graphics.Implicit.Export.TextBuilderUtils
+import Blaze.ByteString.Builder hiding (Builder)
+import Blaze.ByteString.Builder.ByteString
+import Data.ByteString (replicate)
+import Data.ByteString.Lazy (ByteString)
+import Data.Storable.Endian
+
+import Prelude hiding (replicate)
+
stl triangles = toLazyText $ stlHeader <> mconcat (map triangle triangles) <> stlFooter
where
stlHeader = "solid ImplictCADExport\n"
@@ -26,6 +34,19 @@ stl triangles = toLazyText $ stlHeader <> mconcat (map triangle triangles) <> st
<> vertex c
<> "\nendloop\nendfacet\n"
+
+-- Write a 32-bit little-endian float to a buffer.
+float32LE :: Float -> Write
+float32LE = writeStorable . LE
+
+binaryStl :: [Triangle] -> ByteString
+binaryStl triangles = toLazyByteString $ header <> lengthField <> mconcat (map triangle triangles)
+ where header = fromByteString $ replicate 80 0
+ lengthField = fromWord32le $ toEnum $ length triangles
+ triangle (a,b,c) = normal <> point a <> point b <> point c <> fromWord16le 0
+ point (x,y,z) = fromWrite $ float32LE x <> float32LE y <> float32LE z
+ normal = fromWrite $ float32LE 0 <> float32LE 0 <> float32LE 0
+
jsTHREE :: TriangleMesh -> Text
jsTHREE triangles = toLazyText $ header <> vertcode <> facecode <> footer
where
View
@@ -26,7 +26,10 @@ Library
deepseq,
text,
blaze-svg,
- mtl
+ mtl,
+ bytestring,
+ blaze-builder,
+ storable-endian
ghc-options:
-O2 -optc-O3