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

-- | 2 clockwise ordered triangles
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)