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)