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
, 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
Packed
vaNormal <- Ptr VertexAttrs -> Int -> IO Packed
forall a b. Storable a => Ptr b -> Int -> IO a
Foreign.peekByteOff Ptr VertexAttrs
ptr Int
8
Packed
vaTangent <- Ptr VertexAttrs -> Int -> IO Packed
forall a b. Storable a => Ptr b -> Int -> IO a
Foreign.peekByteOff Ptr VertexAttrs
ptr Int
20
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