module Text.GLTF.Loader.BufferAccessor
( GltfBuffer(..),
loadBuffers,
vertexIndices,
vertexPositions,
vertexNormals,
vertexTexCoords,
) where
import Text.GLTF.Loader.Decoders
import Codec.GlTF.Accessor
import Codec.GlTF.Buffer
import Codec.GlTF.BufferView
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 qualified RIO.Vector as Vector
import qualified RIO.ByteString as ByteString
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)
data BufferAccessor = BufferAccessor
{ BufferAccessor -> Int
offset :: Int,
BufferAccessor -> Int
count :: Int,
BufferAccessor -> GltfBuffer
buffer :: GltfBuffer
}
loadBuffers :: MonadUnliftIO io => GlTF -> io (Vector GltfBuffer)
loadBuffers :: forall (io :: * -> *).
MonadUnliftIO io =>
GlTF -> io (Vector GltfBuffer)
loadBuffers GlTF{$sel:buffers:GlTF :: GlTF -> Maybe (Vector Buffer)
buffers=Maybe (Vector Buffer)
buffers} = do
let buffers' :: Vector Buffer
buffers' = forall a. a -> Maybe a -> a
fromMaybe [] Maybe (Vector Buffer)
buffers
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
v a -> (a -> m b) -> m (v b)
Vector.forM Vector Buffer
buffers' forall a b. (a -> b) -> a -> b
$ \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
ByteString
payload <-
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
"")
(\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 a. HasCallStack => a
undefined 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)
Maybe URI
uri
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> GltfBuffer
GltfBuffer ByteString
payload
vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Int
vertexIndices :: GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Int
vertexIndices = forall storable.
Storable storable =>
Get (Vector storable)
-> GlTF -> Vector GltfBuffer -> AccessorIx -> Vector storable
readBufferWithGet Get (Vector Int)
getIndices
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
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
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
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)
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:images:GlTF :: GlTF -> Maybe (Vector Image)
$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: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
}
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
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:byteLength:BufferView :: BufferView -> Int
$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:byteOffset:BufferView :: BufferView -> Int
..} = BufferIx -> Vector GltfBuffer -> Maybe GltfBuffer
lookupBuffer BufferIx
buffer
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)
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)
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)
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 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 (ByteString -> ByteString
fromStrict ByteString
payload')
where payload' :: ByteString
payload' = 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
len' :: Int
len' = Int
count forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf storable
storable