Quad.hs

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)