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

import Text.GLTF.Loader.BufferAccessor
import Text.GLTF.Loader.Gltf

import Linear (V3(..), V4(..))
import RIO
import RIO.Partial (toEnum)
import qualified Codec.GlTF as GlTF
import qualified Codec.GlTF.Asset as GlTF.Asset
import qualified Codec.GlTF.Material as GlTF.Material
import qualified Codec.GlTF.PbrMetallicRoughness as GlTF.PbrMetallicRoughness
import qualified Codec.GlTF.Mesh as GlTF.Mesh
import qualified Codec.GlTF.Node as GlTF.Node
import qualified Data.HashMap.Strict as HashMap

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

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

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

adaptGltf :: GlTF.GlTF -> Vector GltfBuffer -> Gltf
adaptGltf :: GlTF -> Vector GltfBuffer -> Gltf
adaptGltf gltf :: GlTF
gltf@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
..} Vector GltfBuffer
buffers' = Gltf
    { gltfAsset :: Asset
gltfAsset = Asset -> Asset
adaptAsset Asset
asset,
      gltfMaterials :: Vector Material
gltfMaterials = Maybe (Vector Material) -> Vector Material
adaptMaterials Maybe (Vector Material)
materials,
      gltfMeshes :: Vector Mesh
gltfMeshes = GlTF -> Vector GltfBuffer -> Maybe (Vector Mesh) -> Vector Mesh
adaptMeshes GlTF
gltf Vector GltfBuffer
buffers' Maybe (Vector Mesh)
meshes,
      gltfNodes :: Vector Node
gltfNodes = Maybe (Vector Node) -> Vector Node
adaptNodes Maybe (Vector Node)
nodes
    }

adaptAsset :: GlTF.Asset.Asset -> Asset
adaptAsset :: Asset -> Asset
adaptAsset GlTF.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
  }

adaptMaterials :: Maybe (Vector GlTF.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
  :: GlTF.GlTF
  -> Vector GltfBuffer
  -> Maybe (Vector GlTF.Mesh.Mesh)
  -> Vector Mesh
adaptMeshes :: GlTF -> Vector GltfBuffer -> Maybe (Vector Mesh) -> Vector Mesh
adaptMeshes GlTF
gltf Vector GltfBuffer
buffers' = 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 forall a b. (a -> b) -> a -> b
$ GlTF -> Vector GltfBuffer -> Mesh -> Mesh
adaptMesh GlTF
gltf Vector GltfBuffer
buffers')

adaptNodes :: Maybe (Vector GlTF.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)

adaptMaterial :: GlTF.Material.Material -> Material
adaptMaterial :: Material -> Material
adaptMaterial GlTF.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
  :: GlTF.GlTF
  -> Vector GltfBuffer
  -> GlTF.Mesh.Mesh
  -> Mesh
adaptMesh :: GlTF -> Vector GltfBuffer -> Mesh -> Mesh
adaptMesh GlTF
gltf Vector GltfBuffer
buffers' GlTF.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
..} = Mesh
    { meshPrimitives :: Vector MeshPrimitive
meshPrimitives = GlTF
-> Vector GltfBuffer
-> Vector MeshPrimitive
-> Vector MeshPrimitive
adaptMeshPrimitives GlTF
gltf Vector GltfBuffer
buffers' 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 :: GlTF.Node.Node -> Node
adaptNode :: Node -> Node
adaptNode GlTF.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
  { nodeMeshId :: Maybe Int
nodeMeshId = MeshIx -> Int
GlTF.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
  }

adaptAlphaMode :: GlTF.Material.MaterialAlphaMode -> MaterialAlphaMode
adaptAlphaMode :: MaterialAlphaMode -> MaterialAlphaMode
adaptAlphaMode MaterialAlphaMode
GlTF.Material.BLEND = MaterialAlphaMode
Blend
adaptAlphaMode MaterialAlphaMode
GlTF.Material.MASK = MaterialAlphaMode
Mask
adaptAlphaMode MaterialAlphaMode
GlTF.Material.OPAQUE = MaterialAlphaMode
Opaque
adaptAlphaMode (GlTF.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
  :: GlTF.PbrMetallicRoughness.PbrMetallicRoughness
  -> PbrMetallicRoughness
adaptPbrMetallicRoughness :: PbrMetallicRoughness -> PbrMetallicRoughness
adaptPbrMetallicRoughness GlTF.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,
      pbrMetallicFactor :: Float
pbrMetallicFactor = Float
metallicFactor,
      pbrRoughnessFactor :: Float
pbrRoughnessFactor = Float
roughnessFactor
    }

adaptMeshPrimitives
  :: GlTF.GlTF
  -> Vector GltfBuffer
  -> Vector GlTF.Mesh.MeshPrimitive
  -> Vector MeshPrimitive
adaptMeshPrimitives :: GlTF
-> Vector GltfBuffer
-> Vector MeshPrimitive
-> Vector MeshPrimitive
adaptMeshPrimitives GlTF
gltf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlTF -> Vector GltfBuffer -> MeshPrimitive -> MeshPrimitive
adaptMeshPrimitive GlTF
gltf

adaptMeshPrimitive
  :: GlTF.GlTF
  -> Vector GltfBuffer
  -> GlTF.Mesh.MeshPrimitive
  -> MeshPrimitive
adaptMeshPrimitive :: GlTF -> Vector GltfBuffer -> MeshPrimitive -> MeshPrimitive
adaptMeshPrimitive GlTF
gltf Vector GltfBuffer
buffers' GlTF.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
..} = MeshPrimitive
    { meshPrimitiveIndices :: Vector Int
meshPrimitiveIndices = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (GlTF -> Vector GltfBuffer -> AccessorIx -> Vector Int
vertexIndices GlTF
gltf Vector GltfBuffer
buffers') Maybe AccessorIx
indices,
      meshPrimitiveMaterial :: Maybe Int
meshPrimitiveMaterial = MaterialIx -> Int
GlTF.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 :: GlTF.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
GlTF.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