STL 0.1.0.0 → 0.2
raw patch · 6 files changed
+134/−39 lines, 6 filesdep +bytestringdep +cerealdep −prettydep ~attoparsecdep ~basedep ~text
Dependencies added: bytestring, cereal
Dependencies removed: pretty
Dependency ranges changed: attoparsec, base, text
Files
- STL.cabal +13/−10
- src/Graphics/Formats/STL.hs +3/−2
- src/Graphics/Formats/STL/Binary.hs +62/−0
- src/Graphics/Formats/STL/Parser.hs +10/−3
- src/Graphics/Formats/STL/Printer.hs +44/−22
- src/Graphics/Formats/STL/Types.hs +2/−2
STL.cabal view
@@ -1,16 +1,12 @@--- Initial STL.cabal generated by cabal init. For further documentation, --- see http://haskell.org/cabal/users-guide/- name: STL-version: 0.1.0.0+version: 0.2 synopsis: STL 3D geometry format parsing and pretty-printing description: STL is a simple file format for representing 3D objects as the triangles which form their surface. It is common in 3D printing workflows. This library provides parsing and serialization- to the ASCII STL format. The binary STL format- is not yet supported.+ to and from both text and binary STL formats. homepage: http://github.com/bergey/STL license: BSD3 license-file: LICENSE@@ -22,17 +18,24 @@ -- extra-source-files: cabal-version: >=1.10 bug-reports: http://github.com/bergey/STL/issues+Tested-with: GHC == 7.6.3, GHC == 7.8.1+Source-repository head+ type: git+ location: http://github.com/bergey/STL.git + library exposed-modules: Graphics.Formats.STL, Graphics.Formats.STL.Types, Graphics.Formats.STL.Parser,- Graphics.Formats.STL.Printer+ Graphics.Formats.STL.Printer,+ Graphics.Formats.STL.Binary -- other-modules: -- other-extensions: - build-depends: base >=4.6 && <4.7,- pretty >= 1.1 && < 1.2,+ build-depends: base >=4.6 && <4.8, attoparsec >= 0.11 && < 0.12,- text >= 1.0 && < 1.2+ text >= 1.0 && < 1.2,+ cereal >= 0.4 && < 0.5,+ bytestring >= 0.10 && < 0.11 hs-source-dirs: src default-language: Haskell2010
src/Graphics/Formats/STL.hs view
@@ -1,10 +1,11 @@ module Graphics.Formats.STL (- prettySTL+ textSTL , stlParser , STL(..), Triangle(..), Vector(..) ) where -import Graphics.Formats.STL.Printer (prettySTL)+import Graphics.Formats.STL.Binary+import Graphics.Formats.STL.Printer (textSTL) import Graphics.Formats.STL.Parser (stlParser) import Graphics.Formats.STL.Types
+ src/Graphics/Formats/STL/Binary.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module Graphics.Formats.STL.Binary () -- export only instances+ where++import Graphics.Formats.STL.Types+import Data.Word+import Control.Applicative+import Control.Monad+import Data.Serialize+import qualified Data.Text as T+import qualified Data.ByteString as BS+import Data.Text.Encoding++instance Serialize Triangle where+ get = Triangle <$> getNormal <*> t <* skip 2 where+ t = (,,) <$> getVector <*> getVector <*> getVector+ put (Triangle n (a, b, c)) = maybeNormal n *> v3 a *> v3 b *> v3 c *> put (0x00 :: Word16)++instance Serialize STL where+ get = do+ _ <- getHeader+ ct <- getWord32le+ STL "" <$> replicateM (fromIntegral ct) get+ put (STL n tris) = put (header n) *> putWord32le ct *> mapM_ put tris where+ ct :: Word32+ ct = fromIntegral . length $ tris -- here's the space leak++-- | header is always exactly 80 characters long+header :: T.Text -> BS.ByteString+header n = BS.concat [lib, truncatedName, padding] where+ lib = encodeUtf8 "http://hackage.haskell.org/package/STL "+ truncatedName = BS.take (72 - BS.length lib) . encodeUtf8 $ n+ padding = BS.replicate (72 - BS.length truncatedName - BS.length lib) 0x20+-- header _ = BS.replicate 72 0x20 -- cereal adds 8 bytes giving the length of the BS++putFloat :: Float -> Put+putFloat = putFloat32le++v3 :: Vector -> PutM ()+v3 (x,y,z) = putFloat x *> putFloat y *> putFloat z++maybeNormal :: Maybe Vector -> PutM ()+maybeNormal n = case n of+ Nothing -> v3 (0,0,0)+ Just n' -> v3 n'++getHeader :: Get ()+getHeader = skip 80++getFloat :: Get Float+getFloat = getFloat32le++getVector :: Get Vector+getVector = (,,) <$> getFloat <*> getFloat <*> getFloat++getNormal :: Get (Maybe Vector)+getNormal = do+ v <- getVector+ return $ case v of+ (0,0,0) -> Nothing+ n' -> Just n'
src/Graphics/Formats/STL/Parser.hs view
@@ -23,17 +23,24 @@ loop = triple <$> (text "outer loop" *> ss vertex) <*> ss vertex <*> ss vertex <* text "endloop" -normalParser :: Parser Vector-normalParser = text "facet" *> text "normal" *> v3+normalParser :: Parser (Maybe Vector)+normalParser = text "facet" *> text "normal" *> do+ n <- v3+ return $ case n of+ (0, 0, 0) -> Nothing+ _ -> Just n vertex :: Parser Vector vertex = text "vertex" *> v3 v3 :: Parser Vector-v3 = triple <$> ss double <*> ss double <*> ss double+v3 = triple <$> ss float <*> ss float <*> ss float ss :: Parser a -> Parser a ss p = p <* skipSpace text :: Text -> Parser Text text t = string t <* skipSpace++float :: Parser Float+float = realToFrac <$> double
src/Graphics/Formats/STL/Printer.hs view
@@ -1,30 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+ module Graphics.Formats.STL.Printer where -import Data.Text (Text, unpack)-import Text.PrettyPrint+import qualified Data.ByteString as BS+import Data.ByteString.Lazy.Builder+import Data.ByteString.Lazy.Builder.ASCII+import Data.List (intersperse)+import Data.Monoid+import Data.Text.Encoding (encodeUtf8) -import Graphics.Formats.STL.Types+import Graphics.Formats.STL.Types --- | Convert an @STL@ value to a @Doc@, which can be converted to a--- @String@ with 'render'-prettySTL :: STL -> Doc-prettySTL s = vcat [ text "solid " <> (text . unpack $ name s)- , vcat . map triangle $ triangles s- , text "endsolid " <> (text . unpack $ name s)- ]+-- | Convert an @STL@ value to a @Builder@, which can be converted to a+-- @ByteString@ with 'toLazyByteString'+textSTL :: STL -> Builder+textSTL s = vcat [ stringUtf8 "solid " <> (byteString . encodeUtf8 $ name s)+ , vcat . map triangle $ triangles s+ , stringUtf8 "endsolid " <> (byteString . encodeUtf8 $ name s)+ ] -triangle :: Triangle -> Doc+triangle :: Triangle -> Builder triangle (Triangle n (a, b, c)) =- vcat [ text "facet normal" <+> v3 n- , nest 4 $ vcat [ text "outer loop"- , nest 4 $ vcat [vertex a, vertex b, vertex c]- , text "endloop"- ]- , text "endfacet"- ]+ vcat $ stringUtf8 "facet normal " <> maybeNormal n :+ map (indent 4) [ stringUtf8 "outer loop"+ , indent 4 $ vertex a+ , indent 4 $ vertex b+ , indent 4 $ vertex c+ , stringUtf8 "endloop"+ ]+ ++ [stringUtf8 "endfacet"] -vertex :: Vector -> Doc-vertex v = text "vertex" <+> v3 v+maybeNormal :: Maybe Vector -> Builder+maybeNormal n = case n of+ Nothing -> v3 (0,0,0)+ Just n' -> v3 n' -v3 :: Vector -> Doc-v3 (x, y, z) = hsep [double x, double y, double z]+vertex :: Vector -> Builder+vertex v = stringUtf8 "vertex " <> v3 v++v3 :: Vector -> Builder+v3 (x, y, z) = mconcat $ intersperse comma [floatDec x, floatDec y, floatDec z]+ where+ comma = stringUtf8 ", "++indent :: Int -> Builder -> Builder+indent i bs = spaces <> bs where+ spaces = byteString . BS.replicate i $ 0x20 -- 0x20 is UTF-8 space++vcat :: [Builder] -> Builder+vcat bs = mconcat $ intersperse newline bs where+ newline = charUtf8 '\n'
src/Graphics/Formats/STL/Types.hs view
@@ -10,11 +10,11 @@ -- | A single triangle in STL is represented by a normal vector and -- three vertices.-data Triangle = Triangle { normal :: Vector+data Triangle = Triangle { normal :: Maybe Vector , vertices :: (Vector, Vector, Vector) } -type Vector = (Double, Double, Double)+type Vector = (Float, Float, Float) triple :: a -> a -> a -> (a, a, a) triple a b c = (a, b, c)