module PLY (
loadElements, loadElementsV3, loadConfV3,
Header, PLYData, loadHeader, preloadPly, plyHeader,
loadPlyElements, loadPlyElementsV3) where
import Control.Applicative
import Control.Concurrent.ParallelIO (parallel)
import Control.Monad ((>=>))
import Control.Monad.Trans.Error
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 VB
import qualified Data.Vector.Storable as VS
import Linear
import System.Directory (canonicalizePath)
import System.FilePath (takeDirectory, (</>))
import PLY.Ascii
import PLY.Binary
import PLY.Conf
import PLY.Internal.Parsers (line, parseSkip, header)
import PLY.Types
type Header = (Format, [Element])
data PLYData = PLYData !ByteString !Header
instance Show PLYData where
show (PLYData _ h) = "PLYData <bytes> " ++ show h
plyHeader :: PLYData -> Header
plyHeader (PLYData _ h) = h
strictE :: Either a b -> Either a b
strictE l@(Left !_x) = l
strictE r@(Right !_x) = r
loadHeader :: FilePath -> IO (Either String PLYData)
loadHeader = fmap preloadPly . BS.readFile
preloadPly :: ByteString -> Either String PLYData
preloadPly = 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
loadPlyElements :: ByteString -> PLYData ->
Either String (Vector (Vector Scalar))
loadPlyElements n (PLYData body (ASCII, ess)) = strictE $ 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
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"
loadElements :: ByteString -> FilePath
-> IO (Either String (Vector (Vector Scalar)))
loadElements name file =
(preloadPly >=> loadPlyElements name) <$> BS.readFile file
loadPlyElementsV3 :: PLYType a => ByteString -> PLYData ->
Either String (VS.Vector (V3 a))
loadPlyElementsV3 n (PLYData body (ASCII, ess)) = strictE $ 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
loadPlyElementsV3 _ _ = error "Binary PLY is unsupported"
loadElementsV3 :: PLYType a => ByteString -> FilePath
-> IO (Either String (VS.Vector (V3 a)))
loadElementsV3 name file =
(preloadPly >=> loadPlyElementsV3 name) <$> BS.readFile file
type ErrorMsg a = Either String a
loadConfV3 :: forall a. (PLYType a, Fractional a, Conjugate a, RealFloat a)
=> ByteString -> FilePath -> IO (Either String (VS.Vector (V3 a)))
loadConfV3 element confFile =
do dir <- takeDirectory <$> canonicalizePath confFile
runErrorT $
do c <- ErrorT $ parseConf <$> BS.readFile confFile
ErrorT $ checkConcat <$> loadAll dir c
where checkErrors :: [ErrorMsg b] -> ErrorMsg [b]
checkErrors xs = let (ls,rs) = partitionEithers xs
in if null ls then Right rs else Left (unlines ls)
checkConcat :: [ErrorMsg (VS.Vector (V3 a))]
-> ErrorMsg (VS.Vector (V3 a))
checkConcat = (fmap VS.concat $!) . checkErrors
loadMesh :: FilePath -> M44 a -> (ByteString, Transformation a)
-> IO (ErrorMsg (VS.Vector (V3 a)))
loadMesh d _cam (f, (t,r)) =
let m = (^+^ fmap realToFrac t ) . rotate (conjugate (fmap realToFrac r))
in fmap (VS.map m) <$> loadElementsV3 element (d </> BC.unpack f)
loadAll :: FilePath -> Conf a -> IO ([ErrorMsg (VS.Vector (V3 a))])
loadAll dir (Conf (t,r) ms) =
let cam = mkTransformation r t
in parallel $ map (loadMesh dir cam) ms