-- |Transform a `Codec.GlTF.GlTF` to `Text.GLTF.Loader.Gltf.Gltf`
module Text.GLTF.Loader.Adapter
  ( attributePosition,
    attributeNormal,
    adaptGltf,
    adaptAsset,
    adaptMeshes,
    adaptNodes,
    adaptMesh,
    adaptNode,
    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.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"


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 :: Asset -> [Mesh] -> [Node] -> Gltf
Gltf
    { gltfAsset :: Asset
gltfAsset = Asset -> Asset
adaptAsset Asset
asset,
      gltfMeshes :: [Mesh]
gltfMeshes = GlTF -> Vector GltfBuffer -> Maybe (Vector Mesh) -> [Mesh]
adaptMeshes GlTF
gltf Vector GltfBuffer
buffers' Maybe (Vector Mesh)
meshes,
      gltfNodes :: [Node]
gltfNodes = Maybe (Vector Node) -> [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 :: Text -> Maybe Text -> Maybe Text -> Maybe Text -> Asset
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
  }

adaptMeshes
  :: GlTF.GlTF
  -> Vector GltfBuffer
  -> Maybe (Vector GlTF.Mesh.Mesh)
  -> [Mesh]
adaptMeshes :: GlTF -> Vector GltfBuffer -> Maybe (Vector Mesh) -> [Mesh]
adaptMeshes GlTF
gltf Vector GltfBuffer
buffers' = [Mesh] -> (Vector Mesh -> [Mesh]) -> Maybe (Vector Mesh) -> [Mesh]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Mesh -> Mesh) -> [Mesh] -> [Mesh]
forall a b. (a -> b) -> [a] -> [b]
map (GlTF -> Vector GltfBuffer -> Mesh -> Mesh
adaptMesh GlTF
gltf Vector GltfBuffer
buffers') ([Mesh] -> [Mesh])
-> (Vector Mesh -> [Mesh]) -> Vector Mesh -> [Mesh]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Mesh -> [Mesh]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)

adaptNodes :: Maybe (Vector GlTF.Node.Node) -> [Node]
adaptNodes :: Maybe (Vector Node) -> [Node]
adaptNodes = [Node] -> (Vector Node -> [Node]) -> Maybe (Vector Node) -> [Node]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Node -> Node) -> [Node] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Node
adaptNode ([Node] -> [Node])
-> (Vector Node -> [Node]) -> Vector Node -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Node -> [Node]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)

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 :: [MeshPrimitive] -> [Float] -> Maybe Text -> Mesh
Mesh
    { meshPrimitives :: [MeshPrimitive]
meshPrimitives = GlTF
-> Vector GltfBuffer -> Vector MeshPrimitive -> [MeshPrimitive]
adaptMeshPrimitives GlTF
gltf Vector GltfBuffer
buffers' Vector MeshPrimitive
primitives,
      meshWeights :: [Float]
meshWeights = [Float]
-> (Vector Float -> [Float]) -> Maybe (Vector Float) -> [Float]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Vector Float -> [Float]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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 :: Maybe Int
-> Maybe Text
-> Maybe (V4 Float)
-> Maybe (V3 Float)
-> Maybe (V3 Float)
-> [Float]
-> Node
Node
  { nodeMeshId :: Maybe Int
nodeMeshId = MeshIx -> Int
GlTF.Mesh.unMeshIx (MeshIx -> Int) -> Maybe MeshIx -> Maybe Int
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 = (Float, Float, Float, Float) -> V4 Float
forall a. (a, a, a, a) -> V4 a
toV4 ((Float, Float, Float, Float) -> V4 Float)
-> Maybe (Float, Float, Float, Float) -> Maybe (V4 Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Float, Float, Float, Float)
rotation,
    nodeScale :: Maybe (V3 Float)
nodeScale = (Float, Float, Float) -> V3 Float
forall a. (a, a, a) -> V3 a
toV3 ((Float, Float, Float) -> V3 Float)
-> Maybe (Float, Float, Float) -> Maybe (V3 Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Float, Float, Float)
scale,
    nodeTranslation :: Maybe (V3 Float)
nodeTranslation = (Float, Float, Float) -> V3 Float
forall a. (a, a, a) -> V3 a
toV3 ((Float, Float, Float) -> V3 Float)
-> Maybe (Float, Float, Float) -> Maybe (V3 Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Float, Float, Float)
translation,
    nodeWeights :: [Float]
nodeWeights = [Float]
-> (Vector Float -> [Float]) -> Maybe (Vector Float) -> [Float]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Vector Float -> [Float]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (Vector Float)
weights
  }

adaptMeshPrimitives
  :: GlTF.GlTF
  -> Vector GltfBuffer
  -> Vector GlTF.Mesh.MeshPrimitive
  -> [MeshPrimitive]
adaptMeshPrimitives :: GlTF
-> Vector GltfBuffer -> Vector MeshPrimitive -> [MeshPrimitive]
adaptMeshPrimitives GlTF
gltf Vector GltfBuffer
buffers' = (MeshPrimitive -> MeshPrimitive)
-> [MeshPrimitive] -> [MeshPrimitive]
forall a b. (a -> b) -> [a] -> [b]
map (GlTF -> Vector GltfBuffer -> MeshPrimitive -> MeshPrimitive
adaptMeshPrimitive GlTF
gltf Vector GltfBuffer
buffers') ([MeshPrimitive] -> [MeshPrimitive])
-> (Vector MeshPrimitive -> [MeshPrimitive])
-> Vector MeshPrimitive
-> [MeshPrimitive]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector MeshPrimitive -> [MeshPrimitive]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

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 :: MeshPrimitiveMode
-> [Int] -> [V3 Float] -> [V3 Float] -> MeshPrimitive
MeshPrimitive
    { meshPrimitiveMode :: MeshPrimitiveMode
meshPrimitiveMode = MeshPrimitiveMode -> MeshPrimitiveMode
adaptMeshPrimitiveMode MeshPrimitiveMode
mode,
      meshPrimitiveIndices :: [Int]
meshPrimitiveIndices = [Int] -> (AccessorIx -> [Int]) -> Maybe AccessorIx -> [Int]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (GlTF -> Vector GltfBuffer -> AccessorIx -> [Int]
vertexIndices GlTF
gltf Vector GltfBuffer
buffers') Maybe AccessorIx
indices,
      meshPrimitivePositions :: [V3 Float]
meshPrimitivePositions = [V3 Float]
-> (AccessorIx -> [V3 Float]) -> Maybe AccessorIx -> [V3 Float]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (GlTF -> Vector GltfBuffer -> AccessorIx -> [V3 Float]
vertexPositions GlTF
gltf Vector GltfBuffer
buffers') Maybe AccessorIx
positions,
      meshPrimitiveNormals :: [V3 Float]
meshPrimitiveNormals = []
    }
    where positions :: Maybe AccessorIx
positions = HashMap Text AccessorIx
attributes HashMap Text AccessorIx -> Text -> Maybe AccessorIx
forall k v. (Eq k, Hashable k) => HashMap k v -> k -> Maybe v
HashMap.!? Text
attributePosition

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

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

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