-- |Transform a `Codec.GlTF.GlTF` to `Text.GLTF.Loader.Gltf.Gltf`
module Text.GLTF.Loader.Internal.Adapter
  ( attributePosition,
    attributeNormal,
    attributeTexCoord,
    runAdapter,
    adaptGltf,
    adaptAsset,
    adaptImages,
    adaptMaterials,
    adaptMeshes,
    adaptNodes,
    adaptTextures,
    adaptImage,
    adaptMaterial,
    adaptMesh,
    adaptNode,
    adaptTexture,
    adaptAlphaMode,
    adaptPbrMetallicRoughness,
    adaptMeshPrimitives,
    adaptMeshPrimitive,
    adaptMeshPrimitiveMode
  ) where

import Text.GLTF.Loader.Gltf
import Text.GLTF.Loader.Internal.BufferAccessor
import Text.GLTF.Loader.Internal.MonadAdapter

import Linear (V3(..), V4(..))
import RIO
import RIO.Partial (toEnum)
import RIO.Vector.Partial ((!))
import qualified Codec.GlTF as GlTF
import qualified Codec.GlTF.Asset as Asset
import qualified Codec.GlTF.Image as Image
import qualified Codec.GlTF.Material as Material
import qualified Codec.GlTF.PbrMetallicRoughness as PbrMetallicRoughness
import qualified Codec.GlTF.Mesh as Mesh
import qualified Codec.GlTF.Node as Node
import qualified Codec.GlTF.Sampler as Sampler
import qualified Codec.GlTF.Texture as Texture
import qualified Codec.GlTF.TextureInfo as TextureInfo
import qualified Data.HashMap.Strict as HashMap
import qualified RIO.Vector as V

attributePosition :: Text
attributePosition :: Text
attributePosition = Text
"POSITION"

attributeNormal :: Text
attributeNormal :: Text
attributeNormal = Text
"NORMAL"

attributeTexCoord :: Text
attributeTexCoord :: Text
attributeTexCoord = Text
"TEXCOORD_0"

runAdapter
  :: GlTF.GlTF
  -> Vector GltfBuffer
  -> Vector GltfImageData
  -> Gltf
runAdapter :: GlTF -> Vector GltfBuffer -> Vector GltfImageData -> Gltf
runAdapter GlTF
gltf Vector GltfBuffer
buffers Vector GltfImageData
images = forall r a. Reader r a -> r -> a
runReader Adapter Gltf
adaptGltf AdaptEnv
env
  where env :: AdaptEnv
env = GlTF -> Vector GltfBuffer -> Vector GltfImageData -> AdaptEnv
AdaptEnv GlTF
gltf Vector GltfBuffer
buffers Vector GltfImageData
images

adaptGltf :: Adapter Gltf
adaptGltf :: Adapter Gltf
adaptGltf = do
  GlTF.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:buffers:GlTF :: GlTF -> Maybe (Vector Buffer)
$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
..} <- Reader AdaptEnv GlTF
getGltf

  Vector Image
gltfImages <- Maybe (Vector Image) -> Adapter (Vector Image)
adaptImages Maybe (Vector Image)
images
  Vector Mesh
gltfMeshes <- Maybe (Vector Mesh) -> Adapter (Vector Mesh)
adaptMeshes Maybe (Vector Mesh)
meshes
  
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Gltf
    { gltfAsset :: Asset
gltfAsset = Asset -> Asset
adaptAsset Asset
asset,
      gltfImages :: Vector Image
gltfImages = Vector Image
gltfImages,
      gltfMaterials :: Vector Material
gltfMaterials = Maybe (Vector Material) -> Vector Material
adaptMaterials Maybe (Vector Material)
materials,
      gltfMeshes :: Vector Mesh
gltfMeshes = Vector Mesh
gltfMeshes,
      gltfNodes :: Vector Node
gltfNodes = Maybe (Vector Node) -> Vector Node
adaptNodes Maybe (Vector Node)
nodes,
      gltfSamplers :: Vector Sampler
gltfSamplers = Maybe (Vector Sampler) -> Vector Sampler
adaptSamplers Maybe (Vector Sampler)
samplers,
      gltfTextures :: Vector Texture
gltfTextures = Maybe (Vector Texture) -> Vector Texture
adaptTextures Maybe (Vector Texture)
textures
    }

adaptAsset :: Asset.Asset -> Asset
adaptAsset :: Asset -> Asset
adaptAsset Asset.Asset{Maybe Text
Maybe Value
Maybe Object
Text
$sel:version:Asset :: Asset -> Text
$sel:copyright:Asset :: Asset -> Maybe Text
$sel:generator:Asset :: Asset -> Maybe Text
$sel:minVersion:Asset :: Asset -> Maybe Text
$sel:extensions:Asset :: Asset -> Maybe Object
$sel:extras:Asset :: Asset -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
minVersion :: Maybe Text
generator :: Maybe Text
copyright :: Maybe Text
version :: Text
..} = Asset
  { assetVersion :: Text
assetVersion = Text
version,
    assetCopyright :: Maybe Text
assetCopyright = Maybe Text
copyright,
    assetGenerator :: Maybe Text
assetGenerator = Maybe Text
generator,
    assetMinVersion :: Maybe Text
assetMinVersion = Maybe Text
minVersion
  }

adaptImages :: Maybe (Vector Image.Image) -> Adapter (Vector Image)
adaptImages :: Maybe (Vector Image) -> Adapter (Vector Image)
adaptImages Maybe (Vector Image)
codecImages = do
  Vector GltfImageData
imageData <- Reader AdaptEnv (Vector GltfImageData)
getImages

  let images' :: Vector Image
images' = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (Vector Image)
codecImages
      iforM :: Vector Image
-> (Int -> Image -> ReaderT AdaptEnv Identity Image)
-> Adapter (Vector Image)
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)
V.imapM

  Vector Image
-> (Int -> Image -> ReaderT AdaptEnv Identity Image)
-> Adapter (Vector Image)
iforM Vector Image
images' forall a b. (a -> b) -> a -> b
$ \Int
imgId Image
img ->
    GltfImageData -> Image -> ReaderT AdaptEnv Identity Image
adaptImage (Vector GltfImageData
imageData forall (v :: * -> *) a. Vector v a => v a -> Int -> a
! Int
imgId) Image
img

adaptMaterials :: Maybe (Vector Material.Material) -> Vector Material
adaptMaterials :: Maybe (Vector Material) -> Vector Material
adaptMaterials = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Material -> Material
adaptMaterial)

adaptMeshes :: Maybe (Vector Mesh.Mesh) -> Adapter (Vector Mesh)
adaptMeshes :: Maybe (Vector Mesh) -> Adapter (Vector Mesh)
adaptMeshes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) (forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(a -> m b) -> v a -> m (v b)
V.mapM Mesh -> Adapter Mesh
adaptMesh)

adaptNodes :: Maybe (Vector Node.Node) -> Vector Node
adaptNodes :: Maybe (Vector Node) -> Vector Node
adaptNodes = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node -> Node
adaptNode)

adaptSamplers :: Maybe (Vector Sampler.Sampler) -> Vector Sampler
adaptSamplers :: Maybe (Vector Sampler) -> Vector Sampler
adaptSamplers = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Sampler -> Sampler
adaptSampler)

adaptTextures :: Maybe (Vector Texture.Texture) -> Vector Texture
adaptTextures :: Maybe (Vector Texture) -> Vector Texture
adaptTextures = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Texture -> Texture
adaptTexture)

adaptImage :: GltfImageData -> Image.Image -> Adapter Image
adaptImage :: GltfImageData -> Image -> ReaderT AdaptEnv Identity Image
adaptImage GltfImageData
imgData Image.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
  Maybe ByteString
payload <- GltfImageData -> Adapter (Maybe ByteString)
getImageData GltfImageData
imgData

  -- Note that we treat mimeType as required, even though it may not be in the
  -- specification. Tests in Blender suggest it's ALWAYS provided; When we come
  -- across an example where it isn't, we'll address it then.
  case Maybe Text
mimeType of
    Maybe Text
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"Invalid Image: no mime-type specified"
    Just Text
mimeType' -> forall (m :: * -> *) a. Monad m => a -> m a
return Image
      { imageData :: Maybe ByteString
imageData = Maybe ByteString
payload,
        imageMimeType :: Text
imageMimeType = Text
mimeType',
        imageName :: Maybe Text
imageName = Maybe Text
name
      }

adaptMaterial :: Material.Material -> Material
adaptMaterial :: Material -> Material
adaptMaterial Material.Material{Bool
Float
Maybe Text
Maybe Value
Maybe Object
Maybe PbrMetallicRoughness
Maybe (TextureInfo MaterialNormal)
Maybe (TextureInfo MaterialOcclusion)
Maybe TextureInfo_
(Float, Float, Float)
MaterialAlphaMode
$sel:emissiveFactor:Material :: Material -> (Float, Float, Float)
$sel:alphaMode:Material :: Material -> MaterialAlphaMode
$sel:alphaCutoff:Material :: Material -> Float
$sel:doubleSided:Material :: Material -> Bool
$sel:pbrMetallicRoughness:Material :: Material -> Maybe PbrMetallicRoughness
$sel:normalTexture:Material :: Material -> Maybe (TextureInfo MaterialNormal)
$sel:occlusionTexture:Material :: Material -> Maybe (TextureInfo MaterialOcclusion)
$sel:emissiveTexture:Material :: Material -> Maybe TextureInfo_
$sel:name:Material :: Material -> Maybe Text
$sel:extensions:Material :: Material -> Maybe Object
$sel:extras:Material :: Material -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
emissiveTexture :: Maybe TextureInfo_
occlusionTexture :: Maybe (TextureInfo MaterialOcclusion)
normalTexture :: Maybe (TextureInfo MaterialNormal)
pbrMetallicRoughness :: Maybe PbrMetallicRoughness
doubleSided :: Bool
alphaCutoff :: Float
alphaMode :: MaterialAlphaMode
emissiveFactor :: (Float, Float, Float)
..} = Material
  { materialAlphaCutoff :: Float
materialAlphaCutoff = Float
alphaCutoff,
    materialAlphaMode :: MaterialAlphaMode
materialAlphaMode = MaterialAlphaMode -> MaterialAlphaMode
adaptAlphaMode MaterialAlphaMode
alphaMode,
    materialDoubleSided :: Bool
materialDoubleSided = Bool
doubleSided,
    materialEmissiveFactor :: V3 Float
materialEmissiveFactor = forall a. (a, a, a) -> V3 a
toV3 (Float, Float, Float)
emissiveFactor,
    materialName :: Maybe Text
materialName = Maybe Text
name,
    materialPbrMetallicRoughness :: Maybe PbrMetallicRoughness
materialPbrMetallicRoughness = PbrMetallicRoughness -> PbrMetallicRoughness
adaptPbrMetallicRoughness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PbrMetallicRoughness
pbrMetallicRoughness
  }

adaptMesh :: Mesh.Mesh -> Adapter Mesh
adaptMesh :: Mesh -> Adapter Mesh
adaptMesh Mesh.Mesh{Maybe Text
Maybe Value
Maybe Object
Maybe (Vector Float)
Vector MeshPrimitive
$sel:primitives:Mesh :: Mesh -> Vector MeshPrimitive
$sel:weights:Mesh :: Mesh -> Maybe (Vector Float)
$sel:name:Mesh :: Mesh -> Maybe Text
$sel:extensions:Mesh :: Mesh -> Maybe Object
$sel:extras:Mesh :: Mesh -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
weights :: Maybe (Vector Float)
primitives :: Vector MeshPrimitive
..} = do
  Vector MeshPrimitive
primitives' <- Vector MeshPrimitive -> Adapter (Vector MeshPrimitive)
adaptMeshPrimitives Vector MeshPrimitive
primitives
  
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Mesh
    { meshPrimitives :: Vector MeshPrimitive
meshPrimitives = Vector MeshPrimitive
primitives',
      meshWeights :: Vector Float
meshWeights = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (Vector Float)
weights,
      meshName :: Maybe Text
meshName = Maybe Text
name
    }

adaptNode :: Node.Node -> Node
adaptNode :: Node -> Node
adaptNode Node.Node{Maybe (Float, Float, Float)
Maybe (Float, Float, Float, Float)
Maybe Text
Maybe Value
Maybe Object
Maybe NodeMatrix
Maybe SkinIx
Maybe MeshIx
Maybe CameraIx
Maybe (Vector Float)
Maybe (Vector NodeIx)
$sel:camera:Node :: Node -> Maybe CameraIx
$sel:children:Node :: Node -> Maybe (Vector NodeIx)
$sel:skin:Node :: Node -> Maybe SkinIx
$sel:matrix:Node :: Node -> Maybe NodeMatrix
$sel:mesh:Node :: Node -> Maybe MeshIx
$sel:rotation:Node :: Node -> Maybe (Float, Float, Float, Float)
$sel:scale:Node :: Node -> Maybe (Float, Float, Float)
$sel:translation:Node :: Node -> Maybe (Float, Float, Float)
$sel:weights:Node :: Node -> Maybe (Vector Float)
$sel:name:Node :: Node -> Maybe Text
$sel:extensions:Node :: Node -> Maybe Object
$sel:extras:Node :: Node -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
weights :: Maybe (Vector Float)
translation :: Maybe (Float, Float, Float)
scale :: Maybe (Float, Float, Float)
rotation :: Maybe (Float, Float, Float, Float)
mesh :: Maybe MeshIx
matrix :: Maybe NodeMatrix
skin :: Maybe SkinIx
children :: Maybe (Vector NodeIx)
camera :: Maybe CameraIx
..} = Node
  { nodeChildren :: Vector Int
nodeChildren = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NodeIx -> Int
Node.unNodeIx) Maybe (Vector NodeIx)
children,
    nodeMeshId :: Maybe Int
nodeMeshId = MeshIx -> Int
Mesh.unMeshIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MeshIx
mesh,
    nodeName :: Maybe Text
nodeName = Maybe Text
name,
    nodeRotation :: Maybe (V4 Float)
nodeRotation = forall a. (a, a, a, a) -> V4 a
toV4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Float, Float, Float, Float)
rotation,
    nodeScale :: Maybe (V3 Float)
nodeScale = forall a. (a, a, a) -> V3 a
toV3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Float, Float, Float)
scale,
    nodeTranslation :: Maybe (V3 Float)
nodeTranslation = forall a. (a, a, a) -> V3 a
toV3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Float, Float, Float)
translation,
    nodeWeights :: [Float]
nodeWeights = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Vector Float)
weights
  }

adaptSampler :: Sampler.Sampler -> Sampler
adaptSampler :: Sampler -> Sampler
adaptSampler Sampler.Sampler{Maybe Text
Maybe Value
Maybe Object
Maybe SamplerMagFilter
Maybe SamplerMinFilter
SamplerWrap
$sel:wrapS:Sampler :: Sampler -> SamplerWrap
$sel:wrapT:Sampler :: Sampler -> SamplerWrap
$sel:magFilter:Sampler :: Sampler -> Maybe SamplerMagFilter
$sel:minFilter:Sampler :: Sampler -> Maybe SamplerMinFilter
$sel:name:Sampler :: Sampler -> Maybe Text
$sel:extensions:Sampler :: Sampler -> Maybe Object
$sel:extras:Sampler :: Sampler -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
minFilter :: Maybe SamplerMinFilter
magFilter :: Maybe SamplerMagFilter
wrapT :: SamplerWrap
wrapS :: SamplerWrap
..} = Sampler
  { samplerMagFilter :: Maybe MagFilter
samplerMagFilter = SamplerMagFilter -> MagFilter
adaptMagFilter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SamplerMagFilter
magFilter,
    samplerMinFilter :: Maybe MinFilter
samplerMinFilter = SamplerMinFilter -> MinFilter
adaptMinFilter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SamplerMinFilter
minFilter,
    samplerName :: Maybe Text
samplerName = Maybe Text
name,
    samplerWrapS :: SamplerWrap
samplerWrapS = SamplerWrap -> SamplerWrap
adaptSamplerWrap SamplerWrap
wrapS,
    samplerWrapT :: SamplerWrap
samplerWrapT = SamplerWrap -> SamplerWrap
adaptSamplerWrap SamplerWrap
wrapT
  }

adaptTexture :: Texture.Texture -> Texture
adaptTexture :: Texture -> Texture
adaptTexture Texture.Texture{Maybe Text
Maybe Value
Maybe Object
Maybe ImageIx
Maybe SamplerIx
$sel:sampler:Texture :: Texture -> Maybe SamplerIx
$sel:source:Texture :: Texture -> Maybe ImageIx
$sel:name:Texture :: Texture -> Maybe Text
$sel:extensions:Texture :: Texture -> Maybe Object
$sel:extras:Texture :: Texture -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
name :: Maybe Text
source :: Maybe ImageIx
sampler :: Maybe SamplerIx
..} = Texture
  { textureName :: Maybe Text
textureName = Maybe Text
name,
    textureSamplerId :: Maybe Int
textureSamplerId = SamplerIx -> Int
Sampler.unSamplerIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SamplerIx
sampler,
    textureSourceId :: Maybe Int
textureSourceId = ImageIx -> Int
Image.unImageIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ImageIx
source
  }

getImageData :: GltfImageData -> Adapter (Maybe ByteString)
getImageData :: GltfImageData -> Adapter (Maybe ByteString)
getImageData (ImageData ByteString
payload) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ByteString
payload
getImageData GltfImageData
NoImageData = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
getImageData (ImageBufferView BufferViewIx
bufferViewId) = GlTF -> Vector GltfBuffer -> Maybe ByteString
imageDataRaw' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader AdaptEnv GlTF
getGltf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader AdaptEnv (Vector GltfBuffer)
getBuffers
  where imageDataRaw' :: GlTF -> Vector GltfBuffer -> Maybe ByteString
imageDataRaw' GlTF
gltf Vector GltfBuffer
buffers' = GlTF -> Vector GltfBuffer -> BufferViewIx -> Maybe ByteString
imageDataRaw GlTF
gltf Vector GltfBuffer
buffers' BufferViewIx
bufferViewId

adaptAlphaMode :: Material.MaterialAlphaMode -> MaterialAlphaMode
adaptAlphaMode :: MaterialAlphaMode -> MaterialAlphaMode
adaptAlphaMode MaterialAlphaMode
Material.BLEND = MaterialAlphaMode
Blend
adaptAlphaMode MaterialAlphaMode
Material.MASK = MaterialAlphaMode
Mask
adaptAlphaMode MaterialAlphaMode
Material.OPAQUE = MaterialAlphaMode
Opaque
adaptAlphaMode (Material.MaterialAlphaMode Text
alphaMode)
  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid MaterialAlphaMode: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Text
alphaMode

adaptPbrMetallicRoughness
  :: PbrMetallicRoughness.PbrMetallicRoughness
  -> PbrMetallicRoughness
adaptPbrMetallicRoughness :: PbrMetallicRoughness -> PbrMetallicRoughness
adaptPbrMetallicRoughness PbrMetallicRoughness.PbrMetallicRoughness{Float
Maybe Value
Maybe Object
Maybe TextureInfo_
(Float, Float, Float, Float)
$sel:baseColorFactor:PbrMetallicRoughness :: PbrMetallicRoughness -> (Float, Float, Float, Float)
$sel:metallicFactor:PbrMetallicRoughness :: PbrMetallicRoughness -> Float
$sel:roughnessFactor:PbrMetallicRoughness :: PbrMetallicRoughness -> Float
$sel:metallicRoughnessTexture:PbrMetallicRoughness :: PbrMetallicRoughness -> Maybe TextureInfo_
$sel:baseColorTexture:PbrMetallicRoughness :: PbrMetallicRoughness -> Maybe TextureInfo_
$sel:extensions:PbrMetallicRoughness :: PbrMetallicRoughness -> Maybe Object
$sel:extras:PbrMetallicRoughness :: PbrMetallicRoughness -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
baseColorTexture :: Maybe TextureInfo_
metallicRoughnessTexture :: Maybe TextureInfo_
roughnessFactor :: Float
metallicFactor :: Float
baseColorFactor :: (Float, Float, Float, Float)
..}
  = PbrMetallicRoughness
    { pbrBaseColorFactor :: V4 Float
pbrBaseColorFactor = forall a. (a, a, a, a) -> V4 a
toV4 (Float, Float, Float, Float)
baseColorFactor,
      pbrBaseColorTexture :: Maybe TextureInfo
pbrBaseColorTexture = forall a. TextureInfo a -> TextureInfo
adaptTextureInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TextureInfo_
baseColorTexture,
      pbrMetallicFactor :: Float
pbrMetallicFactor = Float
metallicFactor,
      pbrRoughnessFactor :: Float
pbrRoughnessFactor = Float
roughnessFactor
    }

adaptMeshPrimitives :: Vector Mesh.MeshPrimitive -> Adapter (Vector MeshPrimitive)
adaptMeshPrimitives :: Vector MeshPrimitive -> Adapter (Vector MeshPrimitive)
adaptMeshPrimitives = forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a, Vector v b) =>
(a -> m b) -> v a -> m (v b)
V.mapM MeshPrimitive -> Adapter MeshPrimitive
adaptMeshPrimitive

adaptMagFilter :: Sampler.SamplerMagFilter -> MagFilter
adaptMagFilter :: SamplerMagFilter -> MagFilter
adaptMagFilter SamplerMagFilter
Sampler.MAG_LINEAR = MagFilter
MagLinear
adaptMagFilter SamplerMagFilter
Sampler.MAG_NEAREST = MagFilter
MagNearest
adaptMagFilter SamplerMagFilter
mode = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid MagFilter: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show SamplerMagFilter
mode

adaptMinFilter :: Sampler.SamplerMinFilter -> MinFilter
adaptMinFilter :: SamplerMinFilter -> MinFilter
adaptMinFilter SamplerMinFilter
Sampler.MIN_NEAREST = MinFilter
MinNearest
adaptMinFilter SamplerMinFilter
Sampler.MIN_LINEAR = MinFilter
MinLinear
adaptMinFilter SamplerMinFilter
Sampler.MIN_NEAREST_MIPMAP_NEAREST = MinFilter
MinNearestMipmapNearest
adaptMinFilter SamplerMinFilter
Sampler.MIN_NEAREST_MIPMAP_LINEAR = MinFilter
MinNearestMipmapLinear
adaptMinFilter SamplerMinFilter
Sampler.MIN_LINEAR_MIPMAP_NEAREST = MinFilter
MinLinearMipmapNearest
adaptMinFilter SamplerMinFilter
Sampler.MIN_LINEAR_MIPMAP_LINEAR = MinFilter
MinLinearMipmapLinear
adaptMinFilter SamplerMinFilter
mode = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid MinFilter: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show SamplerMinFilter
mode

adaptSamplerWrap :: Sampler.SamplerWrap -> SamplerWrap
adaptSamplerWrap :: SamplerWrap -> SamplerWrap
adaptSamplerWrap SamplerWrap
Sampler.CLAMP_TO_EDGE = SamplerWrap
ClampToEdge
adaptSamplerWrap SamplerWrap
Sampler.MIRRORED_REPEAT = SamplerWrap
MirroredRepeat
adaptSamplerWrap SamplerWrap
Sampler.REPEAT = SamplerWrap
Repeat
adaptSamplerWrap SamplerWrap
mode = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid SamplerWrap: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show SamplerWrap
mode

adaptTextureInfo :: TextureInfo.TextureInfo a -> TextureInfo
adaptTextureInfo :: forall a. TextureInfo a -> TextureInfo
adaptTextureInfo TextureInfo.TextureInfo{a
Int
Maybe Value
Maybe Object
$sel:index:TextureInfo :: forall a. TextureInfo a -> Int
$sel:texCoord:TextureInfo :: forall a. TextureInfo a -> Int
$sel:subtype:TextureInfo :: forall a. TextureInfo a -> a
$sel:extensions:TextureInfo :: forall a. TextureInfo a -> Maybe Object
$sel:extras:TextureInfo :: forall a. TextureInfo a -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
subtype :: a
texCoord :: Int
index :: Int
..} = TextureInfo
  { textureId :: Int
textureId = Int
index,
    textureTexCoord :: Int
textureTexCoord = Int
texCoord
  }

adaptMeshPrimitive :: Mesh.MeshPrimitive -> Adapter MeshPrimitive
adaptMeshPrimitive :: MeshPrimitive -> Adapter MeshPrimitive
adaptMeshPrimitive Mesh.MeshPrimitive{Maybe Value
Maybe Object
Maybe AccessorIx
Maybe MaterialIx
Maybe (Vector (HashMap Text AccessorIx))
HashMap Text AccessorIx
MeshPrimitiveMode
$sel:attributes:MeshPrimitive :: MeshPrimitive -> HashMap Text AccessorIx
$sel:mode:MeshPrimitive :: MeshPrimitive -> MeshPrimitiveMode
$sel:indices:MeshPrimitive :: MeshPrimitive -> Maybe AccessorIx
$sel:material:MeshPrimitive :: MeshPrimitive -> Maybe MaterialIx
$sel:targets:MeshPrimitive :: MeshPrimitive -> Maybe (Vector (HashMap Text AccessorIx))
$sel:extensions:MeshPrimitive :: MeshPrimitive -> Maybe Object
$sel:extras:MeshPrimitive :: MeshPrimitive -> Maybe Value
extras :: Maybe Value
extensions :: Maybe Object
targets :: Maybe (Vector (HashMap Text AccessorIx))
material :: Maybe MaterialIx
indices :: Maybe AccessorIx
mode :: MeshPrimitiveMode
attributes :: HashMap Text AccessorIx
..} = do
  GlTF
gltf <- Reader AdaptEnv GlTF
getGltf
  Vector GltfBuffer
buffers' <- Reader AdaptEnv (Vector GltfBuffer)
getBuffers
  
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MeshPrimitive
    { meshPrimitiveIndices :: Vector Word16
meshPrimitiveIndices = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Word16
vertexIndices GlTF
gltf Vector GltfBuffer
buffers') Maybe AccessorIx
indices,
      meshPrimitiveMaterial :: Maybe Int
meshPrimitiveMaterial = MaterialIx -> Int
Material.unMaterialIx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MaterialIx
material,
      meshPrimitiveMode :: MeshPrimitiveMode
meshPrimitiveMode = MeshPrimitiveMode -> MeshPrimitiveMode
adaptMeshPrimitiveMode MeshPrimitiveMode
mode,
      meshPrimitiveNormals :: Vector (V3 Float)
meshPrimitiveNormals = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float)
vertexNormals GlTF
gltf Vector GltfBuffer
buffers') Maybe AccessorIx
normals,
      meshPrimitivePositions :: Vector (V3 Float)
meshPrimitivePositions = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V3 Float)
vertexPositions GlTF
gltf Vector GltfBuffer
buffers') Maybe AccessorIx
positions,
      meshPrimitiveTexCoords :: Vector (V2 Float)
meshPrimitiveTexCoords = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (GlTF -> Vector GltfBuffer -> AccessorIx -> Vector (V2 Float)
vertexTexCoords GlTF
gltf Vector GltfBuffer
buffers') Maybe AccessorIx
texCoords
    }
    where positions :: Maybe AccessorIx
positions = HashMap Text AccessorIx
attributes forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
HashMap.!? Text
attributePosition
          normals :: Maybe AccessorIx
normals = HashMap Text AccessorIx
attributes forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
HashMap.!? Text
attributeNormal
          texCoords :: Maybe AccessorIx
texCoords = HashMap Text AccessorIx
attributes forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
HashMap.!? Text
attributeTexCoord
          

adaptMeshPrimitiveMode :: Mesh.MeshPrimitiveMode -> MeshPrimitiveMode
adaptMeshPrimitiveMode :: MeshPrimitiveMode -> MeshPrimitiveMode
adaptMeshPrimitiveMode = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeshPrimitiveMode -> Int
Mesh.unMeshPrimitiveMode

toV3 :: (a, a, a) -> V3 a
toV3 :: forall a. (a, a, a) -> V3 a
toV3 (a
x, a
y, a
z) = forall a. a -> a -> a -> V3 a
V3 a
x a
y a
z

toV4 :: (a, a, a, a) -> V4 a
toV4 :: forall a. (a, a, a, a) -> V4 a
toV4 (a
w, a
x, a
y, a
z) = forall a. a -> a -> a -> a -> V4 a
V4 a
w a
x a
y a
z