module Resource.Gltf.Model
  ( Mesh
  , MeshPrimitive

  , Stuff(..)
  , mergeStuff
  , unzipStuff

  , StuffLike
  , mergeStuffLike

  , VertexAttrs(..)
  ) where

import RIO

import Codec.GlTF.Material qualified as GlTF (Material)
import Foreign qualified
import Data.Semigroup (Semigroup(..))
import Geomancy (Vec2)
import Geomancy.Vec3 qualified as Vec3
import RIO.List qualified as List
import RIO.Vector qualified as Vector

type Mesh = Vector MeshPrimitive

type MeshPrimitive = (Maybe (Int, GlTF.Material), Stuff)

data Stuff = Stuff
  { Stuff -> Vector Packed
sPositions :: Vector Vec3.Packed
  , Stuff -> Vector Word32
sIndices   :: Vector Word32
  , Stuff -> Vector VertexAttrs
sAttrs     :: Vector VertexAttrs
  }
  deriving (Stuff -> Stuff -> Bool
(Stuff -> Stuff -> Bool) -> (Stuff -> Stuff -> Bool) -> Eq Stuff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stuff -> Stuff -> Bool
$c/= :: Stuff -> Stuff -> Bool
== :: Stuff -> Stuff -> Bool
$c== :: Stuff -> Stuff -> Bool
Eq, Int -> Stuff -> ShowS
[Stuff] -> ShowS
Stuff -> String
(Int -> Stuff -> ShowS)
-> (Stuff -> String) -> ([Stuff] -> ShowS) -> Show Stuff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stuff] -> ShowS
$cshowList :: [Stuff] -> ShowS
show :: Stuff -> String
$cshow :: Stuff -> String
showsPrec :: Int -> Stuff -> ShowS
$cshowsPrec :: Int -> Stuff -> ShowS
Show, (forall x. Stuff -> Rep Stuff x)
-> (forall x. Rep Stuff x -> Stuff) -> Generic Stuff
forall x. Rep Stuff x -> Stuff
forall x. Stuff -> Rep Stuff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stuff x -> Stuff
$cfrom :: forall x. Stuff -> Rep Stuff x
Generic)

instance Semigroup Stuff where
  {-# INLINE (<>) #-}
  Stuff
a <> :: Stuff -> Stuff -> Stuff
<> Stuff
b = [Stuff] -> Stuff
forall (t :: * -> *). Foldable t => t Stuff -> Stuff
mergeStuff [Stuff
a, Stuff
b]

  {-# INLINE sconcat #-}
  sconcat :: NonEmpty Stuff -> Stuff
sconcat = NonEmpty Stuff -> Stuff
forall (t :: * -> *). Foldable t => t Stuff -> Stuff
mergeStuff

instance Monoid Stuff where
  mempty :: Stuff
mempty = Stuff :: Vector Packed -> Vector Word32 -> Vector VertexAttrs -> Stuff
Stuff
    { $sel:sPositions:Stuff :: Vector Packed
sPositions = Vector Packed
forall a. Monoid a => a
mempty
    , $sel:sIndices:Stuff :: Vector Word32
sIndices   = Vector Word32
forall a. Monoid a => a
mempty
    , $sel:sAttrs:Stuff :: Vector VertexAttrs
sAttrs     = Vector VertexAttrs
forall a. Monoid a => a
mempty
    }

  {-# INLINE mconcat #-}
  mconcat :: [Stuff] -> Stuff
mconcat = [Stuff] -> Stuff
forall (t :: * -> *). Foldable t => t Stuff -> Stuff
mergeStuff

mergeStuff :: Foldable t => t Stuff -> Stuff
mergeStuff :: forall (t :: * -> *). Foldable t => t Stuff -> Stuff
mergeStuff t Stuff
source = Stuff :: Vector Packed -> Vector Word32 -> Vector VertexAttrs -> Stuff
Stuff
  { $sel:sPositions:Stuff :: Vector Packed
sPositions = [Vector Packed] -> Vector Packed
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Packed]
allPositions
  , $sel:sIndices:Stuff :: Vector Word32
sIndices   = [Vector Word32] -> Vector Word32
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Word32]
offsetIndices
  , $sel:sAttrs:Stuff :: Vector VertexAttrs
sAttrs     = [Vector VertexAttrs] -> Vector VertexAttrs
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector VertexAttrs]
allAttrs
  }
  where
    ([Vector Packed]
allPositions, [Vector VertexAttrs]
allAttrs, [Word32]
numPositions, [Vector Word32]
allIndices) = t Stuff
-> ([Vector Packed], [Vector VertexAttrs], [Word32],
    [Vector Word32])
forall (t :: * -> *).
Foldable t =>
t Stuff
-> ([Vector Packed], [Vector VertexAttrs], [Word32],
    [Vector Word32])
unzipStuff t Stuff
source

    offsetIndices :: [Vector Word32]
offsetIndices = (Word32 -> Vector Word32 -> Vector Word32)
-> [Word32] -> [Vector Word32] -> [Vector Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith Word32 -> Vector Word32 -> Vector Word32
forall {f :: * -> *} {b}. (Functor f, Num b) => b -> f b -> f b
applyOffset [Word32]
chunkOffsets [Vector Word32]
allIndices
      where
        applyOffset :: b -> f b -> f b
applyOffset b
off = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b -> b
forall a. Num a => a -> a -> a
+ b
off)

        chunkOffsets :: [Word32]
chunkOffsets = (Word32 -> Word32 -> Word32) -> Word32 -> [Word32] -> [Word32]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
List.scanl' Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(+) Word32
0 [Word32]
numPositions

unzipStuff
  :: Foldable t
  => t Stuff
  -> ( [Vector Vec3.Packed]
     , [Vector VertexAttrs]
     , [Word32]
     , [Vector Word32]
     )
unzipStuff :: forall (t :: * -> *).
Foldable t =>
t Stuff
-> ([Vector Packed], [Vector VertexAttrs], [Word32],
    [Vector Word32])
unzipStuff t Stuff
source = [(Vector Packed, Vector VertexAttrs, Word32, Vector Word32)]
-> ([Vector Packed], [Vector VertexAttrs], [Word32],
    [Vector Word32])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
List.unzip4 do
  Stuff{Vector Word32
Vector Packed
Vector VertexAttrs
sAttrs :: Vector VertexAttrs
sIndices :: Vector Word32
sPositions :: Vector Packed
$sel:sAttrs:Stuff :: Stuff -> Vector VertexAttrs
$sel:sIndices:Stuff :: Stuff -> Vector Word32
$sel:sPositions:Stuff :: Stuff -> Vector Packed
..} <- t Stuff -> [Stuff]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Stuff
source
  (Vector Packed, Vector VertexAttrs, Word32, Vector Word32)
-> [(Vector Packed, Vector VertexAttrs, Word32, Vector Word32)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Vector Packed
sPositions
    , Vector VertexAttrs
sAttrs
    , Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Vector Packed -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.length Vector Packed
sPositions {- sic! -}
    , Vector Word32
sIndices
    )

type StuffLike attrs = (Vector Vec3.Packed, Vector Word32, Vector attrs)

mergeStuffLike :: Foldable t => t (StuffLike attrs) -> (StuffLike attrs)
mergeStuffLike :: forall (t :: * -> *) attrs.
Foldable t =>
t (StuffLike attrs) -> StuffLike attrs
mergeStuffLike t (StuffLike attrs)
source =
  ( [Vector Packed] -> Vector Packed
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Packed]
allPositions
  , [Vector Word32] -> Vector Word32
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Word32]
offsetIndices
  , [Vector attrs] -> Vector attrs
forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector attrs]
allAttrs
  )
  where
    ([Vector Packed]
allPositions, [Vector Word32]
allIndices, [Vector attrs]
allAttrs) = [StuffLike attrs]
-> ([Vector Packed], [Vector Word32], [Vector attrs])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
List.unzip3 (t (StuffLike attrs) -> [StuffLike attrs]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (StuffLike attrs)
source)

    offsetIndices :: [Vector Word32]
offsetIndices = (Int -> Vector Word32 -> Vector Word32)
-> [Int] -> [Vector Word32] -> [Vector Word32]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith Int -> Vector Word32 -> Vector Word32
forall {f :: * -> *} {a} {b}.
(Functor f, Integral a, Num b) =>
a -> f b -> f b
applyOffset [Int]
chunkOffsets [Vector Word32]
allIndices
      where
        applyOffset :: a -> f b -> f b
applyOffset a
off = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b -> b
forall a. Num a => a -> a -> a
+ a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
off)

    chunkOffsets :: [Int]
chunkOffsets = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
List.scanl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Vector Packed -> Int) -> [Vector Packed] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Vector Packed -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.length [Vector Packed]
allPositions

data VertexAttrs = VertexAttrs
  { VertexAttrs -> Vec2
vaTexCoord :: Vec2
  , VertexAttrs -> Packed
vaNormal   :: Vec3.Packed
  , VertexAttrs -> Packed
vaTangent  :: Vec3.Packed
  } deriving (VertexAttrs -> VertexAttrs -> Bool
(VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool) -> Eq VertexAttrs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexAttrs -> VertexAttrs -> Bool
$c/= :: VertexAttrs -> VertexAttrs -> Bool
== :: VertexAttrs -> VertexAttrs -> Bool
$c== :: VertexAttrs -> VertexAttrs -> Bool
Eq, Eq VertexAttrs
Eq VertexAttrs
-> (VertexAttrs -> VertexAttrs -> Ordering)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> Bool)
-> (VertexAttrs -> VertexAttrs -> VertexAttrs)
-> (VertexAttrs -> VertexAttrs -> VertexAttrs)
-> Ord VertexAttrs
VertexAttrs -> VertexAttrs -> Bool
VertexAttrs -> VertexAttrs -> Ordering
VertexAttrs -> VertexAttrs -> VertexAttrs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VertexAttrs -> VertexAttrs -> VertexAttrs
$cmin :: VertexAttrs -> VertexAttrs -> VertexAttrs
max :: VertexAttrs -> VertexAttrs -> VertexAttrs
$cmax :: VertexAttrs -> VertexAttrs -> VertexAttrs
>= :: VertexAttrs -> VertexAttrs -> Bool
$c>= :: VertexAttrs -> VertexAttrs -> Bool
> :: VertexAttrs -> VertexAttrs -> Bool
$c> :: VertexAttrs -> VertexAttrs -> Bool
<= :: VertexAttrs -> VertexAttrs -> Bool
$c<= :: VertexAttrs -> VertexAttrs -> Bool
< :: VertexAttrs -> VertexAttrs -> Bool
$c< :: VertexAttrs -> VertexAttrs -> Bool
compare :: VertexAttrs -> VertexAttrs -> Ordering
$ccompare :: VertexAttrs -> VertexAttrs -> Ordering
Ord, Int -> VertexAttrs -> ShowS
[VertexAttrs] -> ShowS
VertexAttrs -> String
(Int -> VertexAttrs -> ShowS)
-> (VertexAttrs -> String)
-> ([VertexAttrs] -> ShowS)
-> Show VertexAttrs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexAttrs] -> ShowS
$cshowList :: [VertexAttrs] -> ShowS
show :: VertexAttrs -> String
$cshow :: VertexAttrs -> String
showsPrec :: Int -> VertexAttrs -> ShowS
$cshowsPrec :: Int -> VertexAttrs -> ShowS
Show)

instance Storable VertexAttrs where
  alignment :: VertexAttrs -> Int
alignment ~VertexAttrs
_ = Int
16

  sizeOf :: VertexAttrs -> Int
sizeOf ~VertexAttrs
_ = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12

  peek :: Ptr VertexAttrs -> IO VertexAttrs
peek Ptr VertexAttrs
ptr = do
    Vec2
vaTexCoord <- Ptr VertexAttrs -> Int -> IO Vec2
forall a b. Storable a => Ptr b -> Int -> IO a
Foreign.peekByteOff Ptr VertexAttrs
ptr  Int
0 -- +8
    Packed
vaNormal   <- Ptr VertexAttrs -> Int -> IO Packed
forall a b. Storable a => Ptr b -> Int -> IO a
Foreign.peekByteOff Ptr VertexAttrs
ptr  Int
8 -- +12
    Packed
vaTangent  <- Ptr VertexAttrs -> Int -> IO Packed
forall a b. Storable a => Ptr b -> Int -> IO a
Foreign.peekByteOff Ptr VertexAttrs
ptr Int
20 -- +12
    pure VertexAttrs :: Vec2 -> Packed -> Packed -> VertexAttrs
VertexAttrs{Vec2
Packed
vaTangent :: Packed
vaNormal :: Packed
vaTexCoord :: Vec2
$sel:vaTangent:VertexAttrs :: Packed
$sel:vaNormal:VertexAttrs :: Packed
$sel:vaTexCoord:VertexAttrs :: Vec2
..}

  poke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
poke Ptr VertexAttrs
ptr VertexAttrs{Vec2
Packed
vaTangent :: Packed
vaNormal :: Packed
vaTexCoord :: Vec2
$sel:vaTangent:VertexAttrs :: VertexAttrs -> Packed
$sel:vaNormal:VertexAttrs :: VertexAttrs -> Packed
$sel:vaTexCoord:VertexAttrs :: VertexAttrs -> Vec2
..} = do
    Ptr VertexAttrs -> Int -> Vec2 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Foreign.pokeByteOff Ptr VertexAttrs
ptr  Int
0 Vec2
vaTexCoord
    Ptr VertexAttrs -> Int -> Packed -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Foreign.pokeByteOff Ptr VertexAttrs
ptr  Int
8 Packed
vaNormal
    Ptr VertexAttrs -> Int -> Packed -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Foreign.pokeByteOff Ptr VertexAttrs
ptr Int
20 Packed
vaTangent