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 { quadLT :: a , quadRT :: a , quadLB :: a , quadRB :: a } deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic1) deriving Applicative via Generically1 Quad -- | 2 clockwise ordered triangles toVertices :: Quad (Vertex pos attrs) -> [Vertex pos attrs] toVertices Quad{..} = [ quadLT, quadRT, quadLB , quadLB, quadRT, quadRB ] toVertices2 :: Quad (Vertex pos attrs) -> [Vertex pos attrs] toVertices2 q = vertices <> reverse vertices where vertices = toVertices q {-# SPECIALIZE indicesQuad :: [Word32] #-} indicesQuad :: Num a => [a] indicesQuad = [ quadLT, quadRT, quadLB , quadLB, quadRT, quadRB ] where Quad{..} = indices {-# SPECIALIZE indicesWire :: [Word32] #-} indicesWire :: Num a => [a] indicesWire = [ quadLT, quadRT , quadRT, quadRB , quadRB, quadLB , quadLB, quadLT ] where Quad{..} = indices {-# SPECIALIZE indices :: Quad Int #-} {-# SPECIALIZE indices :: Quad Word32 #-} indices :: Num a => Quad a indices = fmap fst . enumerate $ pure () coloredQuad :: Vec4 -> Quad (Vertex Vec3.Packed Vec4) coloredQuad color = Vertex <$> quadPositions <*> pure color texturedQuad :: Quad (Vertex Vec3.Packed Vec2) texturedQuad = Vertex <$> quadPositions <*> quadUV quadPositions :: Quad Vec3.Packed quadPositions = fmap Vec3.Packed Quad { quadLT = vec3 (-0.5) (-0.5) 0 , quadRT = vec3 0.5 (-0.5) 0 , quadLB = vec3 (-0.5) 0.5 0 , quadRB = vec3 0.5 0.5 0 } quadUV :: Quad Vec2 quadUV = Quad { quadLT = vec2 0 0 , quadRT = vec2 1 0 , quadLB = vec2 0 1 , quadRB = vec2 1 1 } quadNormals :: Quad Vec3.Packed quadNormals = pure . Vec3.Packed $ vec3 0 0 (-1)