{-# 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.Gl.Block (Block)
import Geomancy.Gl.Block qualified as Block
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
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
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. 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 = forall (t :: * -> *). Foldable t => t Stuff -> Stuff
mergeStuff [Stuff
a, Stuff
b]

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

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

  {-# INLINE mconcat #-}
  mconcat :: [Stuff] -> Stuff
mconcat = 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 = forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Packed]
allPositions
  , $sel:sIndices:Stuff :: Vector Word32
sIndices   = forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Word32]
offsetIndices
  , $sel:sAttrs:Stuff :: Vector VertexAttrs
sAttrs     = 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) = forall (t :: * -> *).
Foldable t =>
t Stuff
-> ([Vector Packed], [Vector VertexAttrs], [Word32],
    [Vector Word32])
unzipStuff t Stuff
source

    offsetIndices :: [Vector Word32]
offsetIndices = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ b
off)

        chunkOffsets :: [Word32]
chunkOffsets = forall b a. (b -> a -> b) -> b -> [a] -> [b]
List.scanl' 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 = 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
..} <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t Stuff
source
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Vector Packed
sPositions
    , Vector VertexAttrs
sAttrs
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 =
  ( forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Packed]
allPositions
  , forall (v :: * -> *) a. Vector v a => [v a] -> v a
Vector.concat [Vector Word32]
offsetIndices
  , 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) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
List.unzip3 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (StuffLike attrs)
source)

    offsetIndices :: [Vector Word32]
offsetIndices = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
off)

    chunkOffsets :: [Int]
chunkOffsets = forall b a. (b -> a -> b) -> b -> [a] -> [b]
List.scanl' forall a. Num a => a -> a -> a
(+) Int
0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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
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
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
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, 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
$cto :: forall x. Rep VertexAttrs x -> VertexAttrs
$cfrom :: forall x. VertexAttrs -> Rep VertexAttrs x
Generic, 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 ()
writePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$cwritePacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
readPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$creadPacked :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
sizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOfPacked :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
write430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$cwrite430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
read430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cread430 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
sizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$calignment430 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
write140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
$cwrite140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> VertexAttrs -> m ()
read140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
$cread140 :: forall (m :: * -> *) a.
MonadIO m =>
Ptr a -> Diff a VertexAttrs -> m VertexAttrs
isStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
$cisStruct :: forall (proxy :: * -> *). proxy VertexAttrs -> Bool
sizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$csizeOf140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
alignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
$calignment140 :: forall (proxy :: * -> *). proxy VertexAttrs -> Int
Block)
  deriving Ptr VertexAttrs -> IO VertexAttrs
Ptr VertexAttrs -> Int -> IO VertexAttrs
Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
Ptr VertexAttrs -> VertexAttrs -> IO ()
VertexAttrs -> Int
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
poke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
$cpoke :: Ptr VertexAttrs -> VertexAttrs -> IO ()
peek :: Ptr VertexAttrs -> IO VertexAttrs
$cpeek :: Ptr VertexAttrs -> IO VertexAttrs
pokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> VertexAttrs -> IO ()
peekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
$cpeekByteOff :: forall b. Ptr b -> Int -> IO VertexAttrs
pokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
$cpokeElemOff :: Ptr VertexAttrs -> Int -> VertexAttrs -> IO ()
peekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
$cpeekElemOff :: Ptr VertexAttrs -> Int -> IO VertexAttrs
alignment :: VertexAttrs -> Int
$calignment :: VertexAttrs -> Int
sizeOf :: VertexAttrs -> Int
$csizeOf :: VertexAttrs -> Int
Storable via (Block.Packed VertexAttrs)