{-# LANGUAGE DeriveAnyClass #-}

module Resource.Gltf.Model
  ( Mesh
  , MeshPrimitive

  , Stuff(..)
  , mergeStuff
  , unzipStuff

  , StuffLike
  , mergeStuffLike

  , VertexAttrs(..)
  ) where

import RIO

import Codec.GlTF.Material qualified as GlTF (Material)
import Data.Semigroup (Semigroup(..))
import Geomancy (Vec2)
import Geomancy.Vec3 qualified as Vec3
import Graphics.Gl.Block (Block)
import Graphics.Gl.Block qualified as Block
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
$c== :: Stuff -> Stuff -> Bool
== :: Stuff -> Stuff -> Bool
$c/= :: Stuff -> Stuff -> Bool
/= :: 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
$cshowsPrec :: Int -> Stuff -> ShowS
showsPrec :: Int -> Stuff -> ShowS
$cshow :: Stuff -> String
show :: Stuff -> String
$cshowList :: [Stuff] -> ShowS
showList :: [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
$cfrom :: forall x. Stuff -> Rep Stuff x
from :: forall x. Stuff -> Rep Stuff x
$cto :: forall x. Rep Stuff x -> Stuff
to :: forall x. Rep Stuff x -> Stuff
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
    { $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
  { $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 a b. (a -> b) -> f a -> 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
$sel:sPositions:Stuff :: Stuff -> Vector Packed
$sel:sIndices:Stuff :: Stuff -> Vector Word32
$sel:sAttrs:Stuff :: Stuff -> Vector VertexAttrs
sPositions :: Vector Packed
sIndices :: Vector Word32
sAttrs :: Vector VertexAttrs
..} <- t Stuff -> [Stuff]
forall a. t a -> [a]
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 a. a -> [a]
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 a. t a -> [a]
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 a b. (a -> b) -> f a -> 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
$c== :: VertexAttrs -> VertexAttrs -> Bool
== :: VertexAttrs -> VertexAttrs -> Bool
$c/= :: VertexAttrs -> VertexAttrs -> Bool
/= :: 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
$ccompare :: VertexAttrs -> VertexAttrs -> Ordering
compare :: VertexAttrs -> VertexAttrs -> Ordering
$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
>= :: VertexAttrs -> VertexAttrs -> Bool
$cmax :: VertexAttrs -> VertexAttrs -> VertexAttrs
max :: VertexAttrs -> VertexAttrs -> VertexAttrs
$cmin :: VertexAttrs -> VertexAttrs -> VertexAttrs
min :: VertexAttrs -> VertexAttrs -> VertexAttrs
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
$cshowsPrec :: Int -> VertexAttrs -> ShowS
showsPrec :: Int -> VertexAttrs -> ShowS
$cshow :: VertexAttrs -> String
show :: VertexAttrs -> String
$cshowList :: [VertexAttrs] -> ShowS
showList :: [VertexAttrs] -> ShowS
Show, (forall x. VertexAttrs -> Rep VertexAttrs x)
-> (forall x. Rep VertexAttrs x -> VertexAttrs)
-> Generic VertexAttrs
forall x. Rep VertexAttrs x -> VertexAttrs
forall x. VertexAttrs -> Rep VertexAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VertexAttrs -> Rep VertexAttrs x
from :: forall x. VertexAttrs -> Rep VertexAttrs x
$cto :: forall x. Rep VertexAttrs x -> VertexAttrs
to :: forall x. Rep VertexAttrs x -> VertexAttrs
Generic, (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Bool)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> m VertexAttrs)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ())
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> m VertexAttrs)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ())
-> (forall (proxy :: * -> *). proxy VertexAttrs -> Int)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> m VertexAttrs)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ())
-> Block VertexAttrs
forall b.
(forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Bool)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> (forall (proxy :: * -> *). proxy b -> Int)
-> (forall (m :: * -> *) a. MonadIO m => Ptr a -> Diff a b -> m b)
-> (forall (m :: * -> *) a.
    MonadIO m =>
    Ptr a -> Diff a b -> b -> m ())
-> Block b
forall (proxy :: * -> *). proxy VertexAttrs -> Bool
forall (proxy :: * -> *). proxy VertexAttrs -> Int
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$calignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
sizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$cisStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
isStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
$cread140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cwrite140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$calignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
sizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$cread430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cwrite430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$csizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
sizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$creadPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cwritePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
Block)
  deriving Ptr VertexAttrs -> IO VertexAttrs
Ptr VertexAttrs -> Int -> IO VertexAttrs
Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
Ptr VertexAttrs -> VertexAttrs -> IO ()
VertexAttrs -> Int
(VertexAttrs -> Int)
-> (VertexAttrs -> Int)
-> (Ptr VertexAttrs -> Int -> IO VertexAttrs)
-> (Ptr VertexAttrs -> Int -> VertexAttrs -> IO ())
-> (forall b. Ptr b -> Int -> IO VertexAttrs)
-> (forall b. Ptr b -> Int -> VertexAttrs -> IO ())
-> (Ptr VertexAttrs -> IO VertexAttrs)
-> (Ptr VertexAttrs -> VertexAttrs -> IO ())
-> Storable VertexAttrs
forall b. Ptr b -> Int -> IO VertexAttrs
forall b. Ptr b -> Int -> VertexAttrs -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: VertexAttrs -> Int
sizeOf :: VertexAttrs -> Int
$calignment :: VertexAttrs -> Int
alignment :: VertexAttrs -> Int
$cpeekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
peekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
$cpokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
pokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
peekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
$cpokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
$cpeek :: Ptr VertexAttrs -> IO VertexAttrs
peek :: Ptr VertexAttrs -> IO VertexAttrs
$cpoke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
poke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
Storable via (Block.Packed VertexAttrs)