STL 0.2.0.2 → 0.3
raw patch · 7 files changed
+89/−78 lines, 7 filesdep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring
API changes (from Hackage documentation)
- Graphics.Formats.STL.Binary: instance Serialize STL
- Graphics.Formats.STL.Binary: instance Serialize Triangle
+ Graphics.Formats.STL.Types: instance Serialize STL
+ Graphics.Formats.STL.Types: instance Serialize Triangle
- Graphics.Formats.STL.Parser: loop :: Parser Text (Vector, Vector, Vector)
+ Graphics.Formats.STL.Parser: loop :: Parser (Vector, Vector, Vector)
- Graphics.Formats.STL.Parser: triangle :: Parser Text Triangle
+ Graphics.Formats.STL.Parser: triangle :: Parser Triangle
Files
- CHANGES.md +6/−0
- STL.cabal +8/−9
- src/Graphics/Formats/STL.hs +1/−2
- src/Graphics/Formats/STL/Binary.hs +0/−62
- src/Graphics/Formats/STL/Parser.hs +2/−0
- src/Graphics/Formats/STL/Printer.hs +2/−3
- src/Graphics/Formats/STL/Types.hs +70/−2
CHANGES.md view
@@ -1,3 +1,9 @@+0.3+---++- Move `Serialize` instances to avoid orphans+- Fix broken text output format+ 0.2.0.2 -------
STL.cabal view
@@ -1,5 +1,5 @@ name: STL-version: 0.2.0.2+version: 0.3 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@@ -12,10 +12,10 @@ license-file: LICENSE author: Daniel Bergey maintainer: bergey@alum.mit.edu--- copyright: +-- copyright: category: Graphics build-type: Simple--- extra-source-files: +-- extra-source-files: cabal-version: >=1.10 Extra-source-files: CHANGES.md, README.md bug-reports: http://github.com/bergey/STL/issues@@ -29,14 +29,13 @@ exposed-modules: Graphics.Formats.STL, Graphics.Formats.STL.Types, Graphics.Formats.STL.Parser,- Graphics.Formats.STL.Printer,- Graphics.Formats.STL.Binary- -- other-modules: - -- other-extensions: + Graphics.Formats.STL.Printer+ -- other-modules:+ -- other-extensions: build-depends: base >=4.6 && <4.8, attoparsec >= 0.11 && < 0.13, text >= 0.11.1.5 && < 1.3, cereal >= 0.4 && < 0.5,- bytestring >= 0.10 && < 0.11- hs-source-dirs: src + bytestring >= 0.10.2 && < 0.11+ hs-source-dirs: src default-language: Haskell2010
src/Graphics/Formats/STL.hs view
@@ -1,11 +1,10 @@ module Graphics.Formats.STL ( textSTL , stlParser- , STL(..), Triangle(..), Vector(..)+ , STL(..), Triangle(..), Vector ) where -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
@@ -1,62 +0,0 @@-{-# 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
@@ -19,8 +19,10 @@ nameParser :: Parser Text nameParser = text "solid" *> takeWhile (inClass " -~") <* skipSpace +triangle :: Parser Triangle triangle = Triangle <$> ss normalParser <*> loop <* text "endfacet" +loop :: Parser (Vector, Vector, Vector) loop = triple <$> (text "outer loop" *> ss vertex) <*> ss vertex <*> ss vertex <* text "endloop" normalParser :: Parser (Maybe Vector)
src/Graphics/Formats/STL/Printer.hs view
@@ -4,7 +4,6 @@ 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)@@ -39,9 +38,9 @@ vertex v = stringUtf8 "vertex " <> v3 v v3 :: Vector -> Builder-v3 (x, y, z) = mconcat $ intersperse comma [floatDec x, floatDec y, floatDec z]+v3 (x, y, z) = mconcat $ intersperse space [floatDec x, floatDec y, floatDec z] where- comma = stringUtf8 ", "+ space = charUtf8 ' ' indent :: Int -> Builder -> Builder indent i bs = spaces <> bs where
src/Graphics/Formats/STL/Types.hs view
@@ -1,7 +1,22 @@-module Graphics.Formats.STL.Types where+{-# LANGUAGE OverloadedStrings #-} -import Data.Text (Text)+module Graphics.Formats.STL.Types+ (+ STL(..),+ Triangle(..),+ Vector,+ triple,+ ) where +import Control.Applicative+import Control.Monad+import qualified Data.ByteString as BS+import Data.Serialize+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding+import Data.Word+ -- | A representation of an STL file, consisting of a (possibly empty) -- object name, and a list of triangles. data STL = STL { name :: Text@@ -18,3 +33,56 @@ triple :: a -> a -> a -> (a, a, a) triple a b c = (a, b, c)++--------------------------------------------------------------------------------+-- Binary Output+--------------------------------------------------------------------------------++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'