packages feed

ply-loader (empty) → 0.1.0.0

raw patch · 8 files changed

+459/−0 lines, 8 filesdep +attoparsecdep +basedep +bytestringsetup-changed

Dependencies added: attoparsec, base, bytestring, directory, filepath, lens, linear, parallel-io, ply-loader, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Anthony Cowley++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Anthony Cowley nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ply-loader.cabal view
@@ -0,0 +1,60 @@+name:                ply-loader+version:             0.1.0.0+synopsis:            PLY file loader.++description:         PLY is a lightweight file format for representing 3D+                     geometry. The library includes support for+                     placing mesh data into a consistent coordinate+                     frame using Stanford's @.conf@ file format. See+                     /The Stanford 3D Scanning Repository/+                     <http://graphics.stanford.edu/data/3Dscanrep/>+                     for more information.++                     This package provides a library for loading PLY+                     data, and an executable, @ply2bin@ for dumping+                     all vertex data referenced by a @.conf@ file to a+                     flat binary file comprising an array of single+                     precision float triples. Usage: @ply2bin confFile+                     outputFile@.++license:             BSD3+license-file:        LICENSE+author:              Anthony Cowley+maintainer:          acowley@gmail.com+copyright:           (c) Anthony Cowley 2012+category:            Graphics+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type: git+  location: git://github.com/acowley/ply-loader.git++library+  ghc-options:         -O2 -Wall+  exposed-modules:     PLY.Data, PLY.Types, PLY.Conf, PLY.Internal.Parsers+                       +  build-depends:       base >= 4.6 && < 5, +                       attoparsec >= 0.10, +                       bytestring >= 0.10,+                       linear >= 0.3,+                       lens >= 3.0,+                       vector >= 0.9,+                       filepath,+                       directory,+                       parallel-io >= 0.3.2+  hs-source-dirs:      src+  default-language:    Haskell2010+  ++executable ply2bin+  main-is:          Main.hs+  ghc-options:      -O2 -Wall -threaded+  hs-source-dirs:   src/executable+  build-depends:    base >= 4.6 && < 5, +                    bytestring >= 0.10,+                    linear >= 0.3,+                    vector >= 0.9,+                    ply-loader+  default-language: Haskell2010+
+ src/PLY/Conf.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+-- |Parse Stanford 3D Scanning Repository ".conf" files that place+-- individual PLY models into a consistent coordinate frame.+module PLY.Conf (parseConf, Transformation, Conf(..)) where+import Control.Applicative+import Data.Attoparsec.Char8+import Data.ByteString (ByteString)+import Linear.V3+import Linear.Quaternion+import PLY.Internal.Parsers (line, word)++-- | A 3D transformation represented as a translation vector and a+-- rotation.+type Transformation a = (V3 a, Quaternion a)++-- |A @.conf@ file includes a base transformation matrix, and a+-- list of meshes identified by their file name and a 'Transformation'+-- to place geometry in a consistent coordinate frame.+data Conf = Conf { camera :: Transformation Double +                 , meshes :: [(ByteString, Transformation Double)] }+            deriving Show++-- |Parse a 3D translation vector followed by a quaternion.+transformation :: Parser (V3 Double, Quaternion Double)+transformation = (,) <$> vec <*> rotation+  where vec = (\[x,y,z] -> V3 x y z) <$> count 3 (skipSpace *> double)+        rotation = Quaternion <$> (skipSpace *> double) <*> vec++-- |Parse a mesh file specification.+mesh :: Parser (ByteString, Transformation Double)+mesh = (,) <$> ("bmesh " .*> word) <*> transformation++-- |Parser for a Stanford .conf file.+conf :: Parser Conf+conf = Conf <$> ("camera " .*> transformation <* skipSpace)+            <*> (skipSpace *> cybmesh *> many1 (skipSpace *> mesh))+  where cybmesh = skipMany ("mesh " .*> line) -- Not a PLY file!++-- |Parse a Stanford .conf file.+parseConf :: ByteString -> Either String Conf+parseConf = parseOnly conf
+ src/PLY/Data.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}+-- |The loading of a @ply@ file is broken down into two steps: header+-- parsing, and data loading. The 'loadPLY' function will, if+-- successful, return a data structure that may be queried to extract+-- numeric data using 'loadElements' and 'loadElementsV3'. For example, +--+-- > {-# LANGUAGE OverloadedStrings #-}+-- > import Control.Monad ((>=>))+-- > import Data.ByteString (ByteString)+-- > import qualified Data.Vector.Storable as VS+-- > import Linear.V3+-- >+-- > loadVerts :: ByteString -> Either String (VS.Vector (V3 Float))+-- > loadVerts = loadPLY >=> loadElementsV3 "vertex"+-- +-- To load all vertex data from a series of @ply@ files identified by+-- a @.conf@ file, consider using,+--+-- > loadConf :: FilePath -> IO (Either [String] (VS.Vector (V3 Float)))+-- > loadConf confFile = loadMeshesV3 confFile "vertex"+--+module PLY.Data (PLYData, loadPLY, loadElements, loadElementsV3, +                 loadMeshesV3) where+import Control.Applicative+import Control.Concurrent.ParallelIO (parallel)+import Control.Lens (view)+import Data.Attoparsec.Char8+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+import Data.Either (partitionEithers)+import Data.Vector (Vector)+import qualified Data.Vector as V+import qualified Data.Vector.Storable as VS+import Linear.Matrix (mkTransformation, (!*))+import Linear.V3+import Linear.V4 (vector)+import System.Directory (canonicalizePath)+import System.FilePath (takeDirectory, (</>))++import PLY.Conf+import PLY.Internal.Parsers (line, parseSkip, skip, multiProps, +                             parseScalar, header)+import PLY.Types++type Header = (Format, [Element])++-- |A PLY header and the associated raw data. Use 'loadElements' or+-- 'loadElementsV3' to extract a particular element array.+newtype PLYData = PLYData (ByteString, Header)++instance Show PLYData where+  show (PLYData (_,h)) = "PLYData <bytes> " ++ show h++parseASCII :: Element -> Parser (Vector (Vector Scalar))+parseASCII e = V.replicateM (elNum e) +                            (skip *> (V.fromList <$> multiProps (elProps e)))++parseASCIIv3 :: forall a. PLYType a => Element -> Parser (VS.Vector (V3 a))+parseASCIIv3 (Element _ n ps@[_,_,_])+  | all samePropType ps = VS.replicateM n (skip *> (V3 <$> p <*> p <*> p))+  | otherwise = empty+  where t = plyType (undefined::a)+        p = unsafeUnwrap <$> (parseScalar t <* skipSpace)+        samePropType (ScalarProperty t' _) = t == t'+        samePropType (ListProperty _ _) = False+parseASCIIv3 _ = empty++-- |If the PLY header is successfully parsed, the 'PLYData' value+-- returned may be used with 'loadElements' and 'loadElementsV3' to+-- extract data.+loadPLY :: ByteString -> Either String PLYData+loadPLY = aux . parse header+  where aux (Fail _t ctxt msg) = Left $ "Parse failed: "++msg++" in "++show ctxt+        aux (Partial _) = Left "Incomplete header"+        aux (Done t r) = Right $ PLYData (t, r)++-- |@loadElements elementName ply@ loads a 'Vector' of each instance+-- of the requested element array. If you are extracted 3D data,+-- consider using 'loadElementsV3'.+loadElements :: ByteString -> PLYData -> +                Either String (Vector (Vector Scalar))+loadElements n (PLYData (body, (ASCII, ess))) = go ess body+  where go [] _ = Left "Unknown element"+        go (e:es) b | elName e == n = parseOnly (parseASCII e) b+                    | otherwise = go es $+                                  parseSkip (count (elNum e) line *> pure ()) b+loadElements _ _ = error "Binary PLY is unsupported"+{-# INLINABLE loadElements #-}++-- |Like 'loadElements', but restricted to 3D vectors. When it can be+-- used, this function is much more efficient than 'loadElements'.+loadElementsV3 :: PLYType a => ByteString -> PLYData -> +                  Either String (VS.Vector (V3 a))+loadElementsV3 n (PLYData (body, (ASCII, ess))) = go ess body+  where go [] _ = Left "Unknown element"+        go (e:es) b | elName e == n = parseOnly (parseASCIIv3 e) b+                    | otherwise = go es $+                                  parseSkip (count (elNum e) line *> pure ()) b+loadElementsV3 _ _ = error "Binary PLY is unsupported"+{-# INLINABLE loadElementsV3 #-}++(>=!>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c+f >=!> g !x = f x >>= (g $!)+infixr 1 >=!>++-- |Load all meshes identified by a @.conf@ file in parallel, and+-- transform vertex data into the coordinate frame specified by the+-- @.conf@ file. The application @loadMeshesV3 confFile element@ loads+-- @confFile@ to identify every @ply@ mesh to load. The @ply@ files+-- are loaded from the same directory that contained the @.conf@ file,+-- and the data associated with @element@ (e.g. @\"vertex\"@) is+-- loaded, transformed, and concatenated from all the meshes.+loadMeshesV3 :: forall a. (PLYType a, Fractional a) => +                FilePath -> ByteString -> IO (Either [String] (VS.Vector (V3 a)))+loadMeshesV3 confFile element = do dir <- takeDirectory <$> +                                          canonicalizePath confFile+                                   c <- parseConf <$> BS.readFile confFile+                                   either (return . Left . (:[]))+                                          (fmap checkConcat . loadAllMeshes dir)+                                          c+    where checkErrors :: [Either String (VS.Vector (V3 a))] -> Either [String] [VS.Vector (V3 a)]+          checkErrors xs = let (ls,rs) = partitionEithers xs+                           in if null ls then Right rs else Left ls+          checkConcat :: [Either String (VS.Vector (V3 a))] -> Either [String] (VS.Vector (V3 a))+          checkConcat = (fmap VS.concat $!) . checkErrors+          loadMesh :: FilePath -> (ByteString, Transformation Double) -> +                      IO (Either String (VS.Vector (V3 a)))+          loadMesh d (f, (t,r)) = +            let m = mkTransformation (fmap realToFrac r) (fmap realToFrac t)+            in (loadPLY +                >=!> loadElementsV3 element+                >=!> return . VS.map (view _xyz . (m !*) . vector))+               <$> BS.readFile (d </> BC.unpack f)+          loadAllMeshes :: FilePath -> Conf -> +                           IO ([Either String (VS.Vector (V3 a))])+          loadAllMeshes dir = parallel . map (loadMesh dir) . meshes+{-# INLINABLE loadMeshesV3 #-}+
+ src/PLY/Internal/Parsers.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE OverloadedStrings #-}+module PLY.Internal.Parsers where+import Control.Applicative+import Data.Attoparsec.Char8 hiding (char)+import qualified Data.Attoparsec.ByteString as B+import Data.ByteString (ByteString)+import PLY.Types++-- |Skip white space, comments, and obj_info lines.+skip :: Parser ()+skip = skipSpace *> ((ignore *> line *> skip) <|> pure ())+  where ignore = string "comment " <|> string "obj_info "++-- |Parse a PLY file format line+format :: Parser Format+format = "format" .*> skipSpace *> (ascii <|> le <|> be)+  where ascii = "ascii 1.0" .*> pure ASCII+        le = "binary_little_endian 1.0" .*> pure Binary_LE+        be = "binary_big_endian 1.0" .*> pure Binary_BE++-- * Numeric type parsers++char :: Parser Int8+char = signed decimal++uchar :: Parser Word8+uchar = decimal++int :: Parser Int+int = signed decimal++uint :: Parser Word32+uint = decimal++int16 :: Parser Int16+int16 = signed decimal++uint16 :: Parser Word16+uint16 = decimal++float :: Parser Float+float = realToFrac <$> double++-- | Take everything up to the end of the line+line :: Parser ByteString+line = B.takeTill isEndOfLine++scalarProperty :: Parser Property+scalarProperty = ScalarProperty <$> ("property " .*> scalarType) <*> line++scalarType :: Parser ScalarT+scalarType = choice $+             [ "char "   .*> pure Tchar+             , "uchar "  .*> pure Tuchar+             , "short "  .*> pure Tshort+             , "ushort " .*> pure Tushort+             , "int "    .*> pure Tint+             , "uint "   .*> pure Tuint+             , "float "  .*> pure Tfloat+             , "double " .*> pure Tdouble ]++-- |Take the next white space-delimited word.+word :: Parser ByteString+word = skipSpace *> takeTill isSpace <* skipSpace++listProperty :: Parser Property+listProperty = ListProperty <$> ("property list " .*> word *> scalarType)+                            <*> line++-- |Parse a monotyped list of values. All returned 'Scalar' values+-- will be of the type corresponding to the specific 'ScalarT' given.+parseList :: ScalarT -> Parser [Scalar]+parseList t = int >>= flip count (parseScalar t)++property :: Parser Property+property = skip *> (scalarProperty <|> listProperty)++element :: Parser Element+element = Element <$> ("element " .*> takeTill isSpace) +                  <*> (skipSpace *> int <* skipSpace)+                  <*> many1 property++parseScalar :: ScalarT -> Parser Scalar+parseScalar Tchar   = Schar   <$> char+parseScalar Tuchar  = Suchar  <$> uchar+parseScalar Tshort  = Sshort  <$> int16+parseScalar Tushort = Sushort <$> uint16+parseScalar Tint    = Sint    <$> int+parseScalar Tuint   = Suint   <$> uint+parseScalar Tfloat  = Sfloat  <$> float+parseScalar Tdouble = Sdouble <$> double++-- Parse a flat property list+multiProps :: [Property] -> Parser [Scalar]+multiProps = go []+  where go acc [] = pure (reverse acc)+        go acc (ScalarProperty t _:ps) = do x <- parseScalar t+                                            skipSpace+                                            go (x:acc) ps+        go _ (ListProperty t _:_) = int >>= flip count (parseScalar t)++-- FIXME: Support for list properties assumes that an element will not+-- have any other properties if it has a list property!++-- |Parse a PLY header.+header :: Parser (Format, [Element])+header = (,) <$> preamble <*> elements <*. "end_header"+  where preamble = "ply" .*> skip *> format+        elements = many1 (skip *> element <* skipSpace)++-- |Advance a 'ByteString' to where a given 'Parser' finishes. An+-- 'error' is raised if the parser fails to complete.+parseSkip :: Parser a -> ByteString -> ByteString+parseSkip = (aux .) . parse+  where aux (Fail _ _ msg) = error $ "parseSkip failed: "++msg+        aux (Partial _) = error $ "Incomplete data"+        aux (Done t _) = t
+ src/PLY/Types.hs view
@@ -0,0 +1,49 @@+module PLY.Types (module Data.Int, module Data.Word,+                  Format(..), Scalar(..), ScalarT(..),+                  Property(..), Element(..), PLYType(..), Storable) where+import Data.ByteString (ByteString)+import Data.Int+import Data.Word+import Foreign.Storable (Storable)++data Format = ASCII | Binary_LE | Binary_BE deriving Show++data Scalar = Schar Int8 +            | Suchar Word8+            | Sshort Int16+            | Sushort Word16+            | Sint Int+            | Suint Word32+            | Sfloat Float+            | Sdouble Double+              deriving Show++data ScalarT = Tchar | Tuchar | Tshort | Tushort | Tint | Tuint +             | Tfloat | Tdouble deriving (Eq,Show)++data Property = ScalarProperty ScalarT ByteString+              | ListProperty ScalarT ByteString+                deriving Show++data Element = Element { elName  :: ByteString+                       , elNum   :: Int+                       , elProps :: [Property] } deriving Show++class Storable a => PLYType a where+  plyType :: a -> ScalarT+  unsafeUnwrap :: Scalar -> a++instance PLYType Float where+  plyType _ = Tfloat+  unsafeUnwrap (Sfloat x) = x+  unsafeUnwrap y = error $ "Tried to unwrap "++show y++" as a Float"++instance PLYType Double where+  plyType _ = Tdouble+  unsafeUnwrap (Sdouble x) = x+  unsafeUnwrap y = error $ "Tried to unwrap "++show y++" as a Double"++instance PLYType Int where+  plyType _ = Tint+  unsafeUnwrap (Sint x) = x+  unsafeUnwrap y = error $ "Tried to unwrap "++show y++" as an Int"
+ src/executable/Main.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+-- |Executable that writes all 3D vertices found in all @PLY@ files+-- indicated by a @.conf@ file to a single binary file.+module Main (main) where+import Control.Monad (when)+import qualified Data.Vector.Storable as VS+import Linear.V3+import PLY.Data+import System.Environment (getArgs)+import System.IO (withBinaryFile, IOMode(WriteMode), hPutBuf)++main :: IO ()+main = do args@(~[confFile, outputFile]) <- getArgs+          when (length args /= 2)+               (error "Usage: ply2bin confFile outputFile")+          Right pts <- loadMeshesV3 confFile "vertex" +                         :: IO (Either [String] (VS.Vector (V3 Float)))+          putStrLn $ "Loaded "++show (VS.length pts)++" vertices"+          withBinaryFile outputFile WriteMode $ \h ->+            VS.unsafeWith pts $ \ptr ->+              hPutBuf h ptr (VS.length pts * 12)