module Text.GLTF.Loader.Internal.BufferAccessor
  ( GltfBuffer(..),
    GltfImageData(..),
    -- * Loading GLTF buffers
    loadBuffers,
    loadImages,
    -- * Deserializing Accessors
    vertexIndices,
    vertexPositions,
    vertexNormals,
    vertexTexCoords,
    imageDataRaw,
  ) where

import Text.GLTF.Loader.Internal.Decoders

import Codec.GLB (Chunk(..))
import Codec.GlTF.Accessor
import Codec.GlTF.Buffer
import Codec.GlTF.BufferView
import Codec.GlTF.Image
import Codec.GlTF.URI
import Codec.GlTF
import Data.Binary.Get
import Data.ByteString.Lazy (fromStrict)
import Foreign.Storable
import Linear
import RIO hiding (min, max)
import RIO.FilePath
import qualified RIO.Vector as Vector
import qualified RIO.ByteString as ByteString

-- | Holds the entire payload of a glTF buffer
newtype GltfBuffer
  = GltfBuffer { GltfBuffer -> ByteString
unBuffer :: ByteString }
  deriving (GltfBuffer -> GltfBuffer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GltfBuffer -> GltfBuffer -> Bool
$c/= :: GltfBuffer -> GltfBuffer -> Bool
== :: GltfBuffer -> GltfBuffer -> Bool
$c== :: GltfBuffer -> GltfBuffer -> Bool
Eq, Int -> GltfBuffer -> ShowS
[GltfBuffer] -> ShowS
GltfBuffer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GltfBuffer] -> ShowS
$cshowList :: [GltfBuffer] -> ShowS
show :: GltfBuffer -> String
$cshow :: GltfBuffer -> String
showsPrec :: Int -> GltfBuffer -> ShowS
$cshowsPrec :: Int -> GltfBuffer -> ShowS
Show, NonEmpty GltfBuffer -> GltfBuffer
GltfBuffer -> GltfBuffer -> GltfBuffer
forall b. Integral b => b -> GltfBuffer -> GltfBuffer
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> GltfBuffer -> GltfBuffer
$cstimes :: forall b. Integral b => b -> GltfBuffer -> GltfBuffer
sconcat :: NonEmpty GltfBuffer -> GltfBuffer
$csconcat :: NonEmpty GltfBuffer -> GltfBuffer
<> :: GltfBuffer -> GltfBuffer -> GltfBuffer
$c<> :: GltfBuffer -> GltfBuffer -> GltfBuffer
Semigroup, Semigroup GltfBuffer
GltfBuffer
[GltfBuffer] -> GltfBuffer
GltfBuffer -> GltfBuffer -> GltfBuffer
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [GltfBuffer] -> GltfBuffer
$cmconcat :: [GltfBuffer] -> GltfBuffer
mappend :: GltfBuffer -> GltfBuffer -> GltfBuffer
$cmappend :: GltfBuffer -> GltfBuffer -> GltfBuffer
mempty :: GltfBuffer
$cmempty :: GltfBuffer
Monoid)

data GltfImageData
  = ImageData ByteString
  | ImageBufferView BufferViewIx
  | NoImageData
  deriving (GltfImageData -> GltfImageData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GltfImageData -> GltfImageData -> Bool
$c/= :: GltfImageData -> GltfImageData -> Bool
== :: GltfImageData -> GltfImageData -> Bool
$c== :: GltfImageData -> GltfImageData -> Bool
Eq, Int -> GltfImageData -> ShowS
[GltfImageData] -> ShowS
GltfImageData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GltfImageData] -> ShowS
$cshowList :: [GltfImageData] -> ShowS
show :: GltfImageData -> String
$cshow :: GltfImageData -> String
showsPrec :: Int -> GltfImageData -> ShowS
$cshowsPrec :: Int -> GltfImageData -> ShowS
Show)

-- | A buffer and some metadata
data BufferAccessor = BufferAccessor
  { BufferAccessor -> Int
offset :: Int,
    BufferAccessor -> Int
count :: Int,
    BufferAccessor -> GltfBuffer
buffer :: GltfBuffer
  }

-- | Read all the buffers into memory
loadBuffers
  :: MonadUnliftIO io
  => GlTF
  -> Maybe Chunk
  -> FilePath -- ^ Base path of GlTF file
  -> io (Vector GltfBuffer)
loadBuffers :: forall (io :: * -> *).
MonadUnliftIO io =>
GlTF -> Maybe Chunk -> String -> io (Vector GltfBuffer)
loadBuffers GlTF{$sel:buffers:GlTF :: GlTF -> Maybe (Vector Buffer)
buffers=Maybe (Vector Buffer)
buffers} Maybe Chunk
chunk String
basePath = do
  let buffers' :: Vector Buffer
buffers' = forall a. a -> Maybe a -> a
fromMaybe [] Maybe (Vector Buffer)
buffers
      iforM :: Vector Buffer
-> (Int -> Buffer -> io GltfBuffer) -> io (Vector GltfBuffer)
iforM = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(Int -> a -> m b) -> v a -> m (v b)
Vector.imapM
  
  Vector Buffer
-> (Int -> Buffer -> io GltfBuffer) -> io (Vector GltfBuffer)
iforM Vector Buffer
buffers' forall a b. (a -> b) -> a -> b
$ \Int
idx Buffer{Int
Maybe Text
Maybe Value
Maybe Object
Maybe URI
$sel:byteLength:Buffer :: Buffer -> Int
$sel:uri:Buffer :: Buffer -> Maybe URI
$sel:name:Buffer :: Buffer -> Maybe Text
$sel:extensions:Buffer :: Buffer -> Maybe Object
$sel:extras:Buffer :: Buffer -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
uri :: Maybe URI
byteLength :: Int
..} -> do
    -- If the first buffer does not have a URI defined, it refers to a GLB chunk
    let fallback :: ByteString
fallback = if Int
idx forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe URI
uri
          then forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Chunk -> ByteString
chunkData Maybe Chunk
chunk
          else forall a. Monoid a => a
mempty
    
    ByteString
uri' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
fallback) (forall (io :: * -> *).
MonadUnliftIO io =>
String -> URI -> io ByteString
loadUri' String
basePath) Maybe URI
uri
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> GltfBuffer
GltfBuffer ByteString
uri'

loadImages
  :: MonadUnliftIO io
  => GlTF
  -> FilePath -- ^ Base path of GlTF file
  -> io (Vector GltfImageData)
loadImages :: forall (io :: * -> *).
MonadUnliftIO io =>
GlTF -> String -> io (Vector GltfImageData)
loadImages GlTF{$sel:images:GlTF :: GlTF -> Maybe (Vector Image)
images=Maybe (Vector Image)
images} String
basePath = do
  let images' :: Vector Image
images' = forall a. a -> Maybe a -> a
fromMaybe [] Maybe (Vector Image)
images

  forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
v a -> (a -> m b) -> m (v b)
Vector.forM Vector Image
images' forall a b. (a -> b) -> a -> b
$ \Image{Maybe Text
Maybe Value
Maybe Object
Maybe BufferViewIx
Maybe URI
$sel:uri:Image :: Image -> Maybe URI
$sel:mimeType:Image :: Image -> Maybe Text
$sel:bufferView:Image :: Image -> Maybe BufferViewIx
$sel:name:Image :: Image -> Maybe Text
$sel:extensions:Image :: Image -> Maybe Object
$sel:extras:Image :: Image -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
bufferView :: Maybe BufferViewIx
mimeType :: Maybe Text
uri :: Maybe URI
..} -> do
    let fallbackImageData :: io GltfImageData
fallbackImageData = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe GltfImageData
NoImageData BufferViewIx -> GltfImageData
ImageBufferView Maybe BufferViewIx
bufferView
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe io GltfImageData
fallbackImageData (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> GltfImageData
ImageData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (io :: * -> *).
MonadUnliftIO io =>
String -> URI -> io ByteString
loadUri' String
basePath) Maybe URI
uri

-- | Decode vertex indices
vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Word16
vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Word16
vertexIndices = forall storable.
Storable storable =>
Get (Vector storable)
-> GlTF -> Vector GltfBuffer -> AccessorIx -> Vector storable
readBufferWithGet Get (Vector Word16)
getIndices

-- | Decode vertex positions
vertexPositions :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float)
vertexPositions :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float)
vertexPositions = forall storable.
Storable storable =>
Get (Vector storable)
-> GlTF -> Vector GltfBuffer -> AccessorIx -> Vector storable
readBufferWithGet Get (Vector (V3 Float))
getPositions

-- | Decode vertex normals
vertexNormals :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float)
vertexNormals :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float)
vertexNormals = forall storable.
Storable storable =>
Get (Vector storable)
-> GlTF -> Vector GltfBuffer -> AccessorIx -> Vector storable
readBufferWithGet Get (Vector (V3 Float))
getNormals

-- | Decode texture coordinates. Note that we only use the first one.
vertexTexCoords :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V2 Float)
vertexTexCoords :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V2 Float)
vertexTexCoords = forall storable.
Storable storable =>
Get (Vector storable)
-> GlTF -> Vector GltfBuffer -> AccessorIx -> Vector storable
readBufferWithGet Get (Vector (V2 Float))
getTexCoords

-- | Read an image from a buffer view
imageDataRaw :: GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString
imageDataRaw :: GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString
imageDataRaw = GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString
readBufferView

-- | Return a buffer view undecoded
readBufferView :: GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString
readBufferView :: GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString
readBufferView GlTF
gltf Vector GltfBuffer
buffers' BufferViewIx
bufferViewId = do
  accessor :: BufferAccessor
accessor@BufferAccessor{count :: BufferAccessor -> Int
count=Int
length'}
    <- GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe BufferAccessor
bufferViewAccessor GlTF
gltf Vector GltfBuffer
buffers' BufferViewIx
bufferViewId

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BufferAccessor -> Int -> ByteString
readFromBufferRaw BufferAccessor
accessor Int
length'

-- | Read a URI. Throws error on failure
loadUri'
  :: MonadUnliftIO io
  => FilePath -- ^ Base path
  -> URI      -- ^ URI to load
  -> io ByteString
loadUri' :: forall (io :: * -> *).
MonadUnliftIO io =>
String -> URI -> io ByteString
loadUri' String
baseDir URI
uri' = do
  Either String ByteString
readRes <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HasCallStack =>
(String -> IO (Either String ByteString))
-> URI -> IO (Either String ByteString)
loadURI (forall (io :: * -> *).
MonadUnliftIO io =>
String -> String -> io (Either String ByteString)
loadFile String
baseDir) URI
uri'
  case Either String ByteString
readRes of
    Left String
err -> forall a. HasCallStack => String -> a
error String
err
    Right ByteString
res -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res

loadFile :: MonadUnliftIO io => FilePath -> FilePath -> io (Either String ByteString)
loadFile :: forall (io :: * -> *).
MonadUnliftIO io =>
String -> String -> io (Either String ByteString)
loadFile String
baseDir String
filename = do
  ByteString
contents <- forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBinary (String
baseDir String -> ShowS
</> String
filename)

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ByteString
contents

-- | Decode a buffer using the given Binary decoder
readBufferWithGet
  :: Storable storable
  => Get (Vector storable)
  -> GlTF
  -> Vector GltfBuffer
  -> AccessorIx
  -> Vector storable
readBufferWithGet :: forall storable.
Storable storable =>
Get (Vector storable)
-> GlTF -> Vector GltfBuffer -> AccessorIx -> Vector storable
readBufferWithGet Get (Vector storable)
getter GlTF
gltf Vector GltfBuffer
buffers' AccessorIx
accessorId
  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty
      (forall storable.
Storable storable =>
storable
-> Get (Vector storable) -> BufferAccessor -> Vector storable
readFromBuffer forall a. HasCallStack => a
undefined Get (Vector storable)
getter)
      (GlTF -> Vector GltfBuffer -> AccessorIx -> Maybe BufferAccessor
bufferAccessor GlTF
gltf Vector GltfBuffer
buffers' AccessorIx
accessorId)

-- | Look up a Buffer from a GlTF and AccessorIx
bufferAccessor
  :: GlTF
  -> Vector GltfBuffer
  -> AccessorIx
  -> Maybe BufferAccessor
bufferAccessor :: GlTF -> Vector GltfBuffer -> AccessorIx -> Maybe BufferAccessor
bufferAccessor GlTF{Maybe Value
Maybe Object
Maybe (Vector Text)
Maybe (Vector Animation)
Maybe (Vector Scene)
Maybe (Vector Node)
Maybe (Vector Skin)
Maybe (Vector Mesh)
Maybe (Vector Accessor)
Maybe (Vector Texture)
Maybe (Vector Image)
Maybe (Vector BufferView)
Maybe (Vector Buffer)
Maybe (Vector Material)
Maybe (Vector Sampler)
Maybe (Vector Camera)
Asset
$sel:asset:GlTF :: GlTF -> Asset
$sel:extensionsUsed:GlTF :: GlTF -> Maybe (Vector Text)
$sel:extensionsRequired:GlTF :: GlTF -> Maybe (Vector Text)
$sel:accessors:GlTF :: GlTF -> Maybe (Vector Accessor)
$sel:animations:GlTF :: GlTF -> Maybe (Vector Animation)
$sel:bufferViews:GlTF :: GlTF -> Maybe (Vector BufferView)
$sel:cameras:GlTF :: GlTF -> Maybe (Vector Camera)
$sel:materials:GlTF :: GlTF -> Maybe (Vector Material)
$sel:meshes:GlTF :: GlTF -> Maybe (Vector Mesh)
$sel:nodes:GlTF :: GlTF -> Maybe (Vector Node)
$sel:samplers:GlTF :: GlTF -> Maybe (Vector Sampler)
$sel:scenes:GlTF :: GlTF -> Maybe (Vector Scene)
$sel:skins:GlTF :: GlTF -> Maybe (Vector Skin)
$sel:textures:GlTF :: GlTF -> Maybe (Vector Texture)
$sel:extensions:GlTF :: GlTF -> Maybe Object
$sel:extras:GlTF :: GlTF -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
textures :: Maybe (Vector Texture)
skins :: Maybe (Vector Skin)
scenes :: Maybe (Vector Scene)
samplers :: Maybe (Vector Sampler)
nodes :: Maybe (Vector Node)
meshes :: Maybe (Vector Mesh)
materials :: Maybe (Vector Material)
images :: Maybe (Vector Image)
cameras :: Maybe (Vector Camera)
bufferViews :: Maybe (Vector BufferView)
buffers :: Maybe (Vector Buffer)
animations :: Maybe (Vector Animation)
accessors :: Maybe (Vector Accessor)
extensionsRequired :: Maybe (Vector Text)
extensionsUsed :: Maybe (Vector Text)
asset :: Asset
$sel:images:GlTF :: GlTF -> Maybe (Vector Image)
$sel:buffers:GlTF :: GlTF -> Maybe (Vector Buffer)
..} Vector GltfBuffer
buffers' AccessorIx
accessorId = do
  Accessor
accessor <- AccessorIx -> Vector Accessor -> Maybe Accessor
lookupAccessor AccessorIx
accessorId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Vector Accessor)
accessors
  BufferView
bufferView <- Accessor -> Vector BufferView -> Maybe BufferView
lookupBufferViewFromAccessor Accessor
accessor forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Vector BufferView)
bufferViews
  GltfBuffer
buffer <- BufferView -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBufferFromBufferView BufferView
bufferView Vector GltfBuffer
buffers'

  let Accessor{$sel:byteOffset:Accessor :: Accessor -> Int
byteOffset=Int
offset, $sel:count:Accessor :: Accessor -> Int
count=Int
count} = Accessor
accessor
      BufferView{$sel:byteOffset:BufferView :: BufferView -> Int
byteOffset=Int
offset'} = BufferView
bufferView

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BufferAccessor
    { offset :: Int
offset = Int
offset forall a. Num a => a -> a -> a
+ Int
offset',
      count :: Int
count = Int
count,
      buffer :: GltfBuffer
buffer = GltfBuffer
buffer
    }

-- | Look up a Buffer from a GlTF and BufferView
bufferViewAccessor
  :: GlTF
  -> Vector GltfBuffer
  -> BufferViewIx
  -> Maybe BufferAccessor
bufferViewAccessor :: GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe BufferAccessor
bufferViewAccessor GlTF{Maybe Value
Maybe Object
Maybe (Vector Text)
Maybe (Vector Animation)
Maybe (Vector Scene)
Maybe (Vector Node)
Maybe (Vector Skin)
Maybe (Vector Mesh)
Maybe (Vector Accessor)
Maybe (Vector Texture)
Maybe (Vector Image)
Maybe (Vector BufferView)
Maybe (Vector Buffer)
Maybe (Vector Material)
Maybe (Vector Sampler)
Maybe (Vector Camera)
Asset
extras :: Maybe Value
extensions :: Maybe Object
textures :: Maybe (Vector Texture)
skins :: Maybe (Vector Skin)
scenes :: Maybe (Vector Scene)
samplers :: Maybe (Vector Sampler)
nodes :: Maybe (Vector Node)
meshes :: Maybe (Vector Mesh)
materials :: Maybe (Vector Material)
images :: Maybe (Vector Image)
cameras :: Maybe (Vector Camera)
bufferViews :: Maybe (Vector BufferView)
buffers :: Maybe (Vector Buffer)
animations :: Maybe (Vector Animation)
accessors :: Maybe (Vector Accessor)
extensionsRequired :: Maybe (Vector Text)
extensionsUsed :: Maybe (Vector Text)
asset :: Asset
$sel:asset:GlTF :: GlTF -> Asset
$sel:extensionsUsed:GlTF :: GlTF -> Maybe (Vector Text)
$sel:extensionsRequired:GlTF :: GlTF -> Maybe (Vector Text)
$sel:accessors:GlTF :: GlTF -> Maybe (Vector Accessor)
$sel:animations:GlTF :: GlTF -> Maybe (Vector Animation)
$sel:bufferViews:GlTF :: GlTF -> Maybe (Vector BufferView)
$sel:cameras:GlTF :: GlTF -> Maybe (Vector Camera)
$sel:materials:GlTF :: GlTF -> Maybe (Vector Material)
$sel:meshes:GlTF :: GlTF -> Maybe (Vector Mesh)
$sel:nodes:GlTF :: GlTF -> Maybe (Vector Node)
$sel:samplers:GlTF :: GlTF -> Maybe (Vector Sampler)
$sel:scenes:GlTF :: GlTF -> Maybe (Vector Scene)
$sel:skins:GlTF :: GlTF -> Maybe (Vector Skin)
$sel:textures:GlTF :: GlTF -> Maybe (Vector Texture)
$sel:extensions:GlTF :: GlTF -> Maybe Object
$sel:extras:GlTF :: GlTF -> Maybe Value
$sel:images:GlTF :: GlTF -> Maybe (Vector Image)
$sel:buffers:GlTF :: GlTF -> Maybe (Vector Buffer)
..} Vector GltfBuffer
buffers' BufferViewIx
bufferViewId = do
  BufferView
bufferView <- BufferViewIx -> Vector BufferView -> Maybe BufferView
lookupBufferView BufferViewIx
bufferViewId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Vector BufferView)
bufferViews
  GltfBuffer
buffer <- BufferView -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBufferFromBufferView BufferView
bufferView Vector GltfBuffer
buffers'

  let BufferView{$sel:byteLength:BufferView :: BufferView -> Int
byteLength=Int
length', $sel:byteOffset:BufferView :: BufferView -> Int
byteOffset=Int
offset'} = BufferView
bufferView

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ BufferAccessor
    { offset :: Int
offset = Int
offset',
      count :: Int
count = Int
length',
      buffer :: GltfBuffer
buffer = GltfBuffer
buffer
    }

-- | Look up a BufferView by Accessor
lookupBufferViewFromAccessor :: Accessor -> Vector BufferView -> Maybe BufferView
lookupBufferViewFromAccessor :: Accessor -> Vector BufferView -> Maybe BufferView
lookupBufferViewFromAccessor Accessor{Bool
Int
Maybe Text
Maybe Value
Maybe Object
Maybe AccessorSparse
Maybe BufferViewIx
Maybe (Vector Scientific)
ComponentType
AttributeType
$sel:componentType:Accessor :: Accessor -> ComponentType
$sel:normalized:Accessor :: Accessor -> Bool
$sel:type':Accessor :: Accessor -> AttributeType
$sel:bufferView:Accessor :: Accessor -> Maybe BufferViewIx
$sel:min:Accessor :: Accessor -> Maybe (Vector Scientific)
$sel:max:Accessor :: Accessor -> Maybe (Vector Scientific)
$sel:sparse:Accessor :: Accessor -> Maybe AccessorSparse
$sel:name:Accessor :: Accessor -> Maybe Text
$sel:extensions:Accessor :: Accessor -> Maybe Object
$sel:extras:Accessor :: Accessor -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
sparse :: Maybe AccessorSparse
max :: Maybe (Vector Scientific)
min :: Maybe (Vector Scientific)
bufferView :: Maybe BufferViewIx
type' :: AttributeType
count :: Int
byteOffset :: Int
normalized :: Bool
componentType :: ComponentType
$sel:count:Accessor :: Accessor -> Int
$sel:byteOffset:Accessor :: Accessor -> Int
..} Vector BufferView
bufferViews
  = Maybe BufferViewIx
bufferView forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip BufferViewIx -> Vector BufferView -> Maybe BufferView
lookupBufferView Vector BufferView
bufferViews

-- | Look up a Buffer by BufferView
lookupBufferFromBufferView :: BufferView -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBufferFromBufferView :: BufferView -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBufferFromBufferView BufferView{Int
Maybe Int
Maybe Text
Maybe Value
Maybe Object
Maybe BufferViewTarget
BufferIx
$sel:buffer:BufferView :: BufferView -> BufferIx
$sel:byteStride:BufferView :: BufferView -> Maybe Int
$sel:target:BufferView :: BufferView -> Maybe BufferViewTarget
$sel:name:BufferView :: BufferView -> Maybe Text
$sel:extensions:BufferView :: BufferView -> Maybe Object
$sel:extras:BufferView :: BufferView -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
target :: Maybe BufferViewTarget
byteStride :: Maybe Int
byteLength :: Int
byteOffset :: Int
buffer :: BufferIx
$sel:byteLength:BufferView :: BufferView -> Int
$sel:byteOffset:BufferView :: BufferView -> Int
..} = BufferIx -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBuffer BufferIx
buffer

-- | Look up an Accessor by Ix
lookupAccessor :: AccessorIx -> Vector Accessor -> Maybe Accessor
lookupAccessor :: AccessorIx -> Vector Accessor -> Maybe Accessor
lookupAccessor (AccessorIx Int
accessorId) = (forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
Vector.!? Int
accessorId)

-- | Look up a BufferView by Ix
lookupBufferView :: BufferViewIx -> Vector BufferView -> Maybe BufferView
lookupBufferView :: BufferViewIx -> Vector BufferView -> Maybe BufferView
lookupBufferView (BufferViewIx Int
bufferViewId) = (forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
Vector.!? Int
bufferViewId)

-- | Look up a Buffer by Ix
lookupBuffer :: BufferIx -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBuffer :: BufferIx -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBuffer (BufferIx Int
bufferId) = (forall (v :: * -> *) a. Vector v a => v a -> Int -> Maybe a
Vector.!? Int
bufferId)

-- | Decode a buffer using the given Binary decoder
readFromBuffer
  :: Storable storable
  => storable
  -> Get (Vector storable)
  -> BufferAccessor
  -> Vector storable
readFromBuffer :: forall storable.
Storable storable =>
storable
-> Get (Vector storable) -> BufferAccessor -> Vector storable
readFromBuffer storable
storable Get (Vector storable)
getter accessor :: BufferAccessor
accessor@BufferAccessor{Int
GltfBuffer
buffer :: GltfBuffer
count :: Int
offset :: Int
buffer :: BufferAccessor -> GltfBuffer
count :: BufferAccessor -> Int
offset :: BufferAccessor -> Int
..}
  = forall a. Get a -> ByteString -> a
runGet Get (Vector storable)
getter forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict forall a b. (a -> b) -> a -> b
$ ByteString
payload
  where payload :: ByteString
payload = BufferAccessor -> Int -> ByteString
readFromBufferRaw BufferAccessor
accessor Int
len'
        len' :: Int
len' = Int
count forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf storable
storable

-- | Read from buffer without decoding
readFromBufferRaw :: BufferAccessor -> Int -> ByteString
readFromBufferRaw :: BufferAccessor -> Int -> ByteString
readFromBufferRaw BufferAccessor{Int
GltfBuffer
buffer :: GltfBuffer
count :: Int
offset :: Int
buffer :: BufferAccessor -> GltfBuffer
count :: BufferAccessor -> Int
offset :: BufferAccessor -> Int
..} Int
len'
  = Int -> ByteString -> ByteString
ByteString.take Int
len' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
ByteString.drop Int
offset forall b c a. (b -> c) -> (a -> b) -> a -> c
. GltfBuffer -> ByteString
unBuffer forall a b. (a -> b) -> a -> b
$ GltfBuffer
buffer