module Geometry.Quad
( coloredQuad
, texturedQuad
, Quad(..)
, toVertices
, toVertices2
, indicesQuad
, indicesWire
, indices
, quadPositions
, quadUV
, quadNormals
) where
import RIO
import Geomancy (Vec2, Vec4, vec2, vec3)
import Geomancy.Vec3 qualified as Vec3
import Resource.Model (Vertex(..))
import Resource.Collection (Generic1, Generically1(..), enumerate)
data Quad a = Quad
{ forall a. Quad a -> a
quadLT :: a
, forall a. Quad a -> a
quadRT :: a
, forall a. Quad a -> a
quadLB :: a
, forall a. Quad a -> a
quadRB :: a
}
deriving (Quad a -> Quad a -> Bool
forall a. Eq a => Quad a -> Quad a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quad a -> Quad a -> Bool
$c/= :: forall a. Eq a => Quad a -> Quad a -> Bool
== :: Quad a -> Quad a -> Bool
$c== :: forall a. Eq a => Quad a -> Quad a -> Bool
Eq, Quad a -> Quad a -> Bool
Quad a -> Quad a -> Ordering
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
forall {a}. Ord a => Eq (Quad a)
forall a. Ord a => Quad a -> Quad a -> Bool
forall a. Ord a => Quad a -> Quad a -> Ordering
forall a. Ord a => Quad a -> Quad a -> Quad a
min :: Quad a -> Quad a -> Quad a
$cmin :: forall a. Ord a => Quad a -> Quad a -> Quad a
max :: Quad a -> Quad a -> Quad a
$cmax :: forall a. Ord a => Quad a -> Quad a -> Quad a
>= :: Quad a -> Quad a -> Bool
$c>= :: forall a. Ord a => Quad a -> Quad a -> Bool
> :: Quad a -> Quad a -> Bool
$c> :: forall a. Ord a => Quad a -> Quad a -> Bool
<= :: Quad a -> Quad a -> Bool
$c<= :: forall a. Ord a => Quad a -> Quad a -> Bool
< :: Quad a -> Quad a -> Bool
$c< :: forall a. Ord a => Quad a -> Quad a -> Bool
compare :: Quad a -> Quad a -> Ordering
$ccompare :: forall a. Ord a => Quad a -> Quad a -> Ordering
Ord, Int -> Quad a -> ShowS
forall a. Show a => Int -> Quad a -> ShowS
forall a. Show a => [Quad a] -> ShowS
forall a. Show a => Quad a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Quad a] -> ShowS
$cshowList :: forall a. Show a => [Quad a] -> ShowS
show :: Quad a -> String
$cshow :: forall a. Show a => Quad a -> String
showsPrec :: Int -> Quad a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Quad a -> ShowS
Show, forall a b. a -> Quad b -> Quad a
forall a b. (a -> b) -> Quad a -> Quad b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Quad b -> Quad a
$c<$ :: forall a b. a -> Quad b -> Quad a
fmap :: forall a b. (a -> b) -> Quad a -> Quad b
$cfmap :: forall a b. (a -> b) -> Quad a -> Quad b
Functor, forall a. Eq a => a -> Quad a -> Bool
forall a. Num a => Quad a -> a
forall a. Ord a => Quad a -> a
forall m. Monoid m => Quad m -> m
forall a. Quad a -> Bool
forall a. Quad a -> Int
forall a. Quad a -> [a]
forall a. (a -> a -> a) -> Quad a -> a
forall m a. Monoid m => (a -> m) -> Quad a -> m
forall b a. (b -> a -> b) -> b -> Quad a -> b
forall a b. (a -> b -> b) -> b -> Quad a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Quad a -> a
$cproduct :: forall a. Num a => Quad a -> a
sum :: forall a. Num a => Quad a -> a
$csum :: forall a. Num a => Quad a -> a
minimum :: forall a. Ord a => Quad a -> a
$cminimum :: forall a. Ord a => Quad a -> a
maximum :: forall a. Ord a => Quad a -> a
$cmaximum :: forall a. Ord a => Quad a -> a
elem :: forall a. Eq a => a -> Quad a -> Bool
$celem :: forall a. Eq a => a -> Quad a -> Bool
length :: forall a. Quad a -> Int
$clength :: forall a. Quad a -> Int
null :: forall a. Quad a -> Bool
$cnull :: forall a. Quad a -> Bool
toList :: forall a. Quad a -> [a]
$ctoList :: forall a. Quad a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Quad a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Quad a -> a
foldr1 :: forall a. (a -> a -> a) -> Quad a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Quad a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Quad a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Quad a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Quad a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Quad a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Quad a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Quad a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Quad a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Quad a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Quad a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Quad a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Quad a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Quad a -> m
fold :: forall m. Monoid m => Quad m -> m
$cfold :: forall m. Monoid m => Quad m -> m
Foldable, Functor Quad
Foldable Quad
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Quad (m a) -> m (Quad a)
forall (f :: * -> *) a. Applicative f => Quad (f a) -> f (Quad a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Quad a -> m (Quad b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Quad a -> f (Quad b)
sequence :: forall (m :: * -> *) a. Monad m => Quad (m a) -> m (Quad a)
$csequence :: forall (m :: * -> *) a. Monad m => Quad (m a) -> m (Quad a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Quad a -> m (Quad b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Quad a -> m (Quad b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Quad (f a) -> f (Quad a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Quad (f a) -> f (Quad a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Quad a -> f (Quad b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Quad a -> f (Quad b)
Traversable, forall a. Rep1 Quad a -> Quad a
forall a. Quad a -> Rep1 Quad a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Quad a -> Quad a
$cfrom1 :: forall a. Quad a -> Rep1 Quad a
Generic1)
deriving Functor Quad
forall a. a -> Quad a
forall a b. Quad a -> Quad b -> Quad a
forall a b. Quad a -> Quad b -> Quad b
forall a b. Quad (a -> b) -> Quad a -> Quad b
forall a b c. (a -> b -> c) -> Quad a -> Quad b -> Quad c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Quad a -> Quad b -> Quad a
$c<* :: forall a b. Quad a -> Quad b -> Quad a
*> :: forall a b. Quad a -> Quad b -> Quad b
$c*> :: forall a b. Quad a -> Quad b -> Quad b
liftA2 :: forall a b c. (a -> b -> c) -> Quad a -> Quad b -> Quad c
$cliftA2 :: forall a b c. (a -> b -> c) -> Quad a -> Quad b -> Quad c
<*> :: forall a b. Quad (a -> b) -> Quad a -> Quad b
$c<*> :: forall a b. Quad (a -> b) -> Quad a -> Quad b
pure :: forall a. a -> Quad a
$cpure :: forall a. a -> Quad a
Applicative via Generically1 Quad
toVertices :: Quad (Vertex pos attrs) -> [Vertex pos attrs]
toVertices :: forall pos attrs. Quad (Vertex pos attrs) -> [Vertex pos attrs]
toVertices Quad{Vertex pos attrs
quadRB :: Vertex pos attrs
quadLB :: Vertex pos attrs
quadRT :: Vertex pos attrs
quadLT :: Vertex pos attrs
$sel:quadRB:Quad :: forall a. Quad a -> a
$sel:quadLB:Quad :: forall a. Quad a -> a
$sel:quadRT:Quad :: forall a. Quad a -> a
$sel:quadLT:Quad :: forall a. Quad a -> a
..} =
[ Vertex pos attrs
quadLT, Vertex pos attrs
quadRT, Vertex pos attrs
quadLB
, Vertex pos attrs
quadLB, Vertex pos attrs
quadRT, Vertex pos attrs
quadRB
]
toVertices2 :: Quad (Vertex pos attrs) -> [Vertex pos attrs]
toVertices2 :: forall pos attrs. Quad (Vertex pos attrs) -> [Vertex pos attrs]
toVertices2 Quad (Vertex pos attrs)
q = [Vertex pos attrs]
vertices forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [a]
reverse [Vertex pos attrs]
vertices
where
vertices :: [Vertex pos attrs]
vertices = forall pos attrs. Quad (Vertex pos attrs) -> [Vertex pos attrs]
toVertices Quad (Vertex pos attrs)
q
{-# SPECIALIZE indicesQuad :: [Word32] #-}
indicesQuad :: Num a => [a]
indicesQuad :: forall a. Num a => [a]
indicesQuad =
[ a
quadLT, a
quadRT, a
quadLB
, a
quadLB, a
quadRT, a
quadRB
]
where
Quad{a
quadRB :: a
quadLB :: a
quadRT :: a
quadLT :: a
$sel:quadRB:Quad :: forall a. Quad a -> a
$sel:quadLB:Quad :: forall a. Quad a -> a
$sel:quadRT:Quad :: forall a. Quad a -> a
$sel:quadLT:Quad :: forall a. Quad a -> a
..} = forall a. Num a => Quad a
indices
{-# SPECIALIZE indicesWire :: [Word32] #-}
indicesWire :: Num a => [a]
indicesWire :: forall a. Num a => [a]
indicesWire =
[ a
quadLT, a
quadRT
, a
quadRT, a
quadRB
, a
quadRB, a
quadLB
, a
quadLB, a
quadLT
]
where
Quad{a
quadLB :: a
quadRB :: a
quadRT :: a
quadLT :: a
$sel:quadRB:Quad :: forall a. Quad a -> a
$sel:quadLB:Quad :: forall a. Quad a -> a
$sel:quadRT:Quad :: forall a. Quad a -> a
$sel:quadLT:Quad :: forall a. Quad a -> a
..} = forall a. Num a => Quad a
indices
{-# SPECIALIZE indices :: Quad Int #-}
{-# SPECIALIZE indices :: Quad Word32 #-}
indices :: Num a => Quad a
indices :: forall a. Num a => Quad a
indices = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) ix a.
(Traversable t, Num ix) =>
t a -> t (ix, a)
enumerate forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
coloredQuad :: Vec4 -> Quad (Vertex Vec3.Packed Vec4)
coloredQuad :: Vec4 -> Quad (Vertex Packed Vec4)
coloredQuad Vec4
color = forall pos attrs. pos -> attrs -> Vertex pos attrs
Vertex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quad Packed
quadPositions forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Vec4
color
texturedQuad :: Quad (Vertex Vec3.Packed Vec2)
texturedQuad :: Quad (Vertex Packed Vec2)
texturedQuad = forall pos attrs. pos -> attrs -> Vertex pos attrs
Vertex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quad Packed
quadPositions forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Quad Vec2
quadUV
quadPositions :: Quad Vec3.Packed
quadPositions :: Quad Packed
quadPositions = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vec3 -> Packed
Vec3.Packed Quad
{ $sel:quadLT:Quad :: Vec3
quadLT = Float -> Float -> Float -> Vec3
vec3 (-Float
0.5) (-Float
0.5) Float
0
, $sel:quadRT:Quad :: Vec3
quadRT = Float -> Float -> Float -> Vec3
vec3 Float
0.5 (-Float
0.5) Float
0
, $sel:quadLB:Quad :: Vec3
quadLB = Float -> Float -> Float -> Vec3
vec3 (-Float
0.5) Float
0.5 Float
0
, $sel:quadRB:Quad :: Vec3
quadRB = Float -> Float -> Float -> Vec3
vec3 Float
0.5 Float
0.5 Float
0
}
quadUV :: Quad Vec2
quadUV :: Quad Vec2
quadUV = Quad
{ $sel:quadLT:Quad :: Vec2
quadLT = Float -> Float -> Vec2
vec2 Float
0 Float
0
, $sel:quadRT:Quad :: Vec2
quadRT = Float -> Float -> Vec2
vec2 Float
1 Float
0
, $sel:quadLB:Quad :: Vec2
quadLB = Float -> Float -> Vec2
vec2 Float
0 Float
1
, $sel:quadRB:Quad :: Vec2
quadRB = Float -> Float -> Vec2
vec2 Float
1 Float
1
}
quadNormals :: Quad Vec3.Packed
quadNormals :: Quad Packed
quadNormals = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec3 -> Packed
Vec3.Packed forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Vec3
vec3 Float
0 Float
0 (-Float
1)