ply-loader 0.2 → 0.3

raw patch · 4 files changed

+61/−5 lines, 4 filesdep +cereal

Dependencies added: cereal

Files

• ply-loader.cabal +4/−3
• src/PLY.hs +11/−1
• src/PLY/Binary.hs +45/−0
• src/PLY/Internal/Parsers.hs +1/−1

@@ -1,5 +1,5 @@ name:                ply-loader-version:             0.2+version:             0.3 synopsis:            PLY file loader.  description:         PLY is a lightweight file format for representing 3D@@ -32,7 +32,7 @@  library   ghc-options:         -O2 -Wall-  exposed-modules:     PLY, PLY.Ascii, PLY.Conf, PLY.Types,+  exposed-modules:     PLY, PLY.Ascii, PLY.Binary, PLY.Conf, PLY.Types,                        PLY.Internal.Parsers, PLY.Internal.StrictReplicate                           build-depends:       base >= 4.6 && < 5, @@ -44,7 +44,8 @@                        filepath,                        directory,                        parallel-io >= 0.3.2,-                       transformers+                       transformers,+                       cereal   hs-source-dirs:      src   default-language:    Haskell2010 

@@ -22,7 +22,7 @@             loadElements, loadElementsV3, loadConfV3,              -- * Loading components-            PLYData, loadHeader, preloadPly, +            Header, PLYData, loadHeader, preloadPly, plyHeader,             loadPlyElements, loadPlyElementsV3) where import Control.Applicative import Control.Concurrent.ParallelIO (parallel)@@ -40,6 +40,7 @@ import System.FilePath (takeDirectory, (</>))  import PLY.Ascii+import PLY.Binary import PLY.Conf import PLY.Internal.Parsers (line, parseSkip, header) import PLY.Types@@ -53,6 +54,11 @@ instance Show PLYData where   show (PLYData _ h) = "PLYData <bytes> " ++ show h +-- | Extract the 'Header' from a partially loaded PLY file (as from+-- 'preloadPly').+plyHeader :: PLYData -> Header+plyHeader (PLYData _ h) = h+ -- Helper to ensure that that an 'Either' is strict in the argument to -- the data constructor. This is important to keep Vector operations -- flowing efficiently.@@ -83,6 +89,10 @@         go (e:es) b | elName e == n = parseOnly (parseASCII e) b                     | otherwise = go es $                                   parseSkip (count (elNum e) line *> pure ()) b+loadPlyElements n (PLYData body (Binary_LE, ess)) = strictE $ go ess body+  where go [] _ = Left "Unknown element"+        go (e:es) b | elName e == n = Right . fst $ parseBinElement e b+                    | otherwise = go es . snd $ parseBinElement e b loadPlyElements _ _ = error "Binary PLY is unsupported" {-# INLINABLE loadPlyElements #-} 

@@ -0,0 +1,45 @@+module PLY.Binary where+import Control.Applicative+import Data.ByteString (ByteString)+import Data.Maybe (isJust, catMaybes)+import Data.Serialize.Get+import Data.Vector (Vector, (!))+import qualified Data.Vector as V+import Unsafe.Coerce+import PLY.Types++getScalarT :: ScalarT -> Get Scalar+getScalarT Tchar = Schar . fromIntegral <$> getWord8+getScalarT Tuchar = Suchar <$> getWord8+getScalarT Tshort = Sshort . fromIntegral <$> getWord16host+getScalarT Tushort = Sushort <$> getWord16host+getScalarT Tint = Sint . fromIntegral <$> getWord32host+getScalarT Tuint = Suint <$> getWord32host+getScalarT Tfloat = Sfloat . unsafeCoerce <$> getWord32host+getScalarT Tdouble = Sdouble . unsafeCoerce <$> getWord64host++mkScalarParser :: ScalarT -> Get Scalar+mkScalarParser t = getScalarT t++mkListParser :: ScalarT -> Get (Vector Scalar)+mkListParser t =+  getWord8 >>= flip V.replicateM (getScalarT t) . fromIntegral+                                               +mkElParser :: [Property] -> Get (Vector Scalar)+mkElParser props+  | all isJust scalars = let props' = V.fromList (catMaybes scalars)+                             aux i = let parsers = V.map mkScalarParser props'+                                     in parsers ! i+                         in V.generateM (V.length props') aux+  | null (tail props) = let (ListProperty t _) = head props in mkListParser t+  | otherwise = error $ "Binary elements with multiple property "+++                        "lists are not supported!"+  where getScalar (ScalarProperty t _) = Just t+        getScalar _ = Nothing+        scalars = map getScalar props++parseBinElement :: Element -> ByteString -> (Vector (Vector Scalar), ByteString)+parseBinElement (Element _ 0 _) bs = (V.empty, bs)+parseBinElement (Element _ n props) bs = +  either error id $ runGetState elParser bs 0+  where elParser = V.replicateM n (mkElParser props)

@@ -104,7 +104,7 @@  -- |Parse a PLY header. header :: Parser (Format, [Element])-header = (,) <$> preamble <*> elements <*. "end_header"+header = (,) <$> preamble <*> elements <*. "end_header" <* endOfLine   where preamble = "ply" .*> skip *> format         elements = many1 (skip *> element <* skipSpace)