{-# LANGUAGE CPP                  #-}
{-# LANGUAGE EmptyDataDecls       #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wno-unused-foralls #-}
module Graphics.GPipe.Internal.PrimitiveArray where

#if __GLASGOW_HASKELL__ < 804
import           Data.Semigroup
#endif

import           Data.IORef                     (IORef)
import           Data.Text.Lazy                 (Text)
import           Data.Word                      (Word16, Word32, Word8)
import           Graphics.GL.Core45
import           Graphics.GL.Types              (GLuint)
import           Graphics.GPipe.Internal.Buffer (B, BInput (..), BPacked,
                                                 Buffer (bufBElement, bufName, bufferLength),
                                                 BufferFormat (getGlType))
import           Graphics.GPipe.Internal.Shader (Render (Render))

-- | A vertex array is the basic building block for a primitive array. It is created from the contents of a 'Buffer', but unlike a 'Buffer',
--   it may be truncated, zipped with other vertex arrays, and even morphed into arrays of a different type with the provided 'Functor' instance.
--   A @VertexArray t a@ has elements of type @a@, and @t@ indicates whether the vertex array may be used as instances or not.
data VertexArray t a = VertexArray  {
    -- | Retrieve the number of elements in a 'VertexArray'.
    VertexArray t a -> Int
vertexArrayLength :: Int,
    VertexArray t a -> Int
vertexArraySkip   :: Int,
    VertexArray t a -> BInput -> a
bArrBFunc         :: BInput -> a
    }

-- | A phantom type to indicate that a 'VertexArray' may only be used for instances (in 'toPrimitiveArrayInstanced' and 'toPrimitiveArrayIndexedInstanced').
data Instances

-- | Create a 'VertexArray' from a 'Buffer'. The vertex array will have the same number of elements as the buffer, use 'takeVertices' and 'dropVertices' to make it smaller.
newVertexArray :: Buffer os a -> Render os (VertexArray t a)
newVertexArray :: Buffer os a -> Render os (VertexArray t a)
newVertexArray Buffer os a
buffer = ExceptT
  String
  (ReaderT RenderEnv (StateT RenderState IO))
  (VertexArray t a)
-> Render os (VertexArray t a)
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT
   String
   (ReaderT RenderEnv (StateT RenderState IO))
   (VertexArray t a)
 -> Render os (VertexArray t a))
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (VertexArray t a)
-> Render os (VertexArray t a)
forall a b. (a -> b) -> a -> b
$ VertexArray t a
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (VertexArray t a)
forall (m :: * -> *) a. Monad m => a -> m a
return (VertexArray t a
 -> ExceptT
      String
      (ReaderT RenderEnv (StateT RenderState IO))
      (VertexArray t a))
-> VertexArray t a
-> ExceptT
     String
     (ReaderT RenderEnv (StateT RenderState IO))
     (VertexArray t a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (BInput -> a) -> VertexArray t a
forall t a. Int -> Int -> (BInput -> a) -> VertexArray t a
VertexArray (Buffer os a -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os a
buffer) Int
0 ((BInput -> a) -> VertexArray t a)
-> (BInput -> a) -> VertexArray t a
forall a b. (a -> b) -> a -> b
$ Buffer os a -> BInput -> a
forall os b. Buffer os b -> BInput -> b
bufBElement Buffer os a
buffer

instance Functor (VertexArray t) where
    fmap :: (a -> b) -> VertexArray t a -> VertexArray t b
fmap a -> b
f (VertexArray Int
n Int
s BInput -> a
g) = Int -> Int -> (BInput -> b) -> VertexArray t b
forall t a. Int -> Int -> (BInput -> a) -> VertexArray t a
VertexArray Int
n Int
s (a -> b
f (a -> b) -> (BInput -> a) -> BInput -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BInput -> a
g)

-- | Zip two 'VertexArray's using the function given as first argument. If either of the argument 'VertexArray's are restriced to 'Instances' only, then so will the resulting
--   array be, as depicted by the 'Combine' type family.
zipVertices :: (a -> b -> c) -> VertexArray t a -> VertexArray t' b -> VertexArray (Combine t t') c
zipVertices :: (a -> b -> c)
-> VertexArray t a
-> VertexArray t' b
-> VertexArray (Combine t t') c
zipVertices a -> b -> c
h (VertexArray Int
n Int
s BInput -> a
f) (VertexArray Int
m Int
t BInput -> b
g) = Int -> Int -> (BInput -> c) -> VertexArray (Combine t t') c
forall t a. Int -> Int -> (BInput -> a) -> VertexArray t a
VertexArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
m) Int
totSkip BInput -> c
newArrFun
    where totSkip :: Int
totSkip = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
s Int
t
          newArrFun :: BInput -> c
newArrFun BInput
x = let baseSkip :: Int
baseSkip = BInput -> Int
bInSkipElems BInput
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
totSkip in a -> b -> c
h (BInput -> a
f BInput
x { bInSkipElems :: Int
bInSkipElems = Int
baseSkip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s}) (BInput -> b
g BInput
x { bInSkipElems :: Int
bInSkipElems = Int
baseSkip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
t})

type family Combine t t' where
    Combine () Instances = Instances
    Combine Instances () = Instances
    Combine Instances Instances = Instances
    Combine () () = ()

-- | @takeVertices n a@ creates a shorter vertex array by taking the @n@ first elements of the array @a@.
takeVertices :: Int -> VertexArray t a -> VertexArray t a
takeVertices :: Int -> VertexArray t a -> VertexArray t a
takeVertices Int
n (VertexArray Int
l Int
s BInput -> a
f) = Int -> Int -> (BInput -> a) -> VertexArray t a
forall t a. Int -> Int -> (BInput -> a) -> VertexArray t a
VertexArray (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0) Int
l) Int
s BInput -> a
f

-- | @dropVertices n a@ creates a shorter vertex array by dropping the @n@ first elements of the array @a@. The argument array @a@ must not be
--   constrained to only 'Instances'.
dropVertices :: Int -> VertexArray () a -> VertexArray t a
dropVertices :: Int -> VertexArray () a -> VertexArray t a
dropVertices Int
n (VertexArray Int
l Int
s BInput -> a
f) = Int -> Int -> (BInput -> a) -> VertexArray t a
forall t a. Int -> Int -> (BInput -> a) -> VertexArray t a
VertexArray (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n') (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n') BInput -> a
f where n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0) Int
l

-- | @replicateEach n a@ will create a longer vertex array, only to be used for instances, by replicating each element of the array @a@ @n@ times. E.g.
--   @replicateEach 3 {ABCD...}@ will yield @{AAABBBCCCDDD...}@. This is particulary useful before zipping the array with another that has a different replication rate.
replicateEach :: Int -> VertexArray t a -> VertexArray Instances a
replicateEach :: Int -> VertexArray t a -> VertexArray Instances a
replicateEach Int
n (VertexArray Int
l Int
s BInput -> a
f) = Int -> Int -> (BInput -> a) -> VertexArray Instances a
forall t a. Int -> Int -> (BInput -> a) -> VertexArray t a
VertexArray (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l) Int
s (\BInput
x -> BInput -> a
f (BInput -> a) -> BInput -> a
forall a b. (a -> b) -> a -> b
$ BInput
x {bInInstanceDiv :: Int
bInInstanceDiv = BInput -> Int
bInInstanceDiv BInput
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n})

type family IndexFormat a where
    IndexFormat (B Word32) = Word32
    IndexFormat (BPacked Word16) = Word16
    IndexFormat (BPacked Word8) = Word8

-- | An index array is like a vertex array, but contains only integer indices. These indices must come from a tightly packed 'Buffer', hence the lack of
--   a 'Functor' instance and no conversion from 'VertexArray's.
data IndexArray = IndexArray {
    IndexArray -> IORef GLuint
iArrName         :: IORef GLuint,
    -- | Numer of indices in an 'IndexArray'.
    IndexArray -> Int
indexArrayLength :: Int,
    IndexArray -> Int
offset           :: Int,
    IndexArray -> Maybe Int
restart          :: Maybe Int,
    IndexArray -> GLuint
indexType        :: GLuint
    }

-- | Create an 'IndexArray' from a 'Buffer' of unsigned integers (as constrained by the closed 'IndexFormat' type family instances). The index array will have the same number of elements as the buffer, use 'takeIndices' and 'dropIndices' to make it smaller.
--   The @Maybe a@ argument is used to optionally denote a primitive restart index.
newIndexArray :: forall os f b a. (BufferFormat b, Integral a, IndexFormat b ~ a) => Buffer os b -> Maybe a -> Render os IndexArray
newIndexArray :: Buffer os b -> Maybe a -> Render os IndexArray
newIndexArray Buffer os b
buf Maybe a
r = let a :: b
a = b
forall a. HasCallStack => a
undefined :: b in ExceptT
  String (ReaderT RenderEnv (StateT RenderState IO)) IndexArray
-> Render os IndexArray
forall os a.
ExceptT String (ReaderT RenderEnv (StateT RenderState IO)) a
-> Render os a
Render (ExceptT
   String (ReaderT RenderEnv (StateT RenderState IO)) IndexArray
 -> Render os IndexArray)
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) IndexArray
-> Render os IndexArray
forall a b. (a -> b) -> a -> b
$ IndexArray
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) IndexArray
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexArray
 -> ExceptT
      String (ReaderT RenderEnv (StateT RenderState IO)) IndexArray)
-> IndexArray
-> ExceptT
     String (ReaderT RenderEnv (StateT RenderState IO)) IndexArray
forall a b. (a -> b) -> a -> b
$ IORef GLuint -> Int -> Int -> Maybe Int -> GLuint -> IndexArray
IndexArray (Buffer os b -> IORef GLuint
forall os b. Buffer os b -> IORef GLuint
bufName Buffer os b
buf) (Buffer os b -> Int
forall os b. Buffer os b -> Int
bufferLength Buffer os b
buf) Int
0 ((a -> Int) -> Maybe a -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe a
r) (b -> GLuint
forall f. BufferFormat f => f -> GLuint
getGlType b
a)

-- | @takeIndices n a@ creates a shorter index array by taking the @n@ first indices of the array @a@.
takeIndices :: Int -> IndexArray -> IndexArray
takeIndices :: Int -> IndexArray -> IndexArray
takeIndices Int
n IndexArray
i = IndexArray
i { indexArrayLength :: Int
indexArrayLength = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n) (IndexArray -> Int
indexArrayLength IndexArray
i) }

-- | @dropIndices n a@ creates a shorter index array by dropping the @n@ first indices of the array @a@.
dropIndices :: Int -> IndexArray -> IndexArray
dropIndices :: Int -> IndexArray -> IndexArray
dropIndices Int
n IndexArray
i = IndexArray
i{ indexArrayLength :: Int
indexArrayLength = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n', offset :: Int
offset = IndexArray -> Int
offset IndexArray
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n' }
    where
        l :: Int
l = IndexArray -> Int
indexArrayLength IndexArray
i
        n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
0) Int
l

data Points = PointList
data Lines = LineLoop | LineStrip | LineList
data LinesWithAdjacency = LineListAdjacency | LineStripAdjacency
data Triangles = TriangleList | TriangleStrip
data TrianglesWithAdjacency = TriangleListAdjacency | TriangleStripAdjacency

class PrimitiveTopology p where
    toGLtopology :: p -> GLuint
    toPrimitiveSize :: p -> Int
    toGeometryShaderOutputTopology :: p -> GLuint
    toLayoutIn :: p -> Text
    toLayoutOut :: p -> Text
    data Geometry p a

instance PrimitiveTopology Points where
    toGLtopology :: Points -> GLuint
toGLtopology Points
PointList = GLuint
forall a. (Eq a, Num a) => a
GL_POINTS
    toPrimitiveSize :: Points -> Int
toPrimitiveSize Points
_= Int
1
    toGeometryShaderOutputTopology :: Points -> GLuint
toGeometryShaderOutputTopology Points
_ = GLuint
forall a. (Eq a, Num a) => a
GL_POINTS
    toLayoutIn :: Points -> Text
toLayoutIn Points
_ = Text
"points"
    toLayoutOut :: Points -> Text
toLayoutOut Points
_ = Text
"points"
    data Geometry Points a = Point a

instance PrimitiveTopology Lines where
    toGLtopology :: Lines -> GLuint
toGLtopology Lines
LineList  = GLuint
forall a. (Eq a, Num a) => a
GL_LINES
    toGLtopology Lines
LineLoop  = GLuint
forall a. (Eq a, Num a) => a
GL_LINE_LOOP
    toGLtopology Lines
LineStrip = GLuint
forall a. (Eq a, Num a) => a
GL_LINE_STRIP
    toPrimitiveSize :: Lines -> Int
toPrimitiveSize Lines
_= Int
2
    toGeometryShaderOutputTopology :: Lines -> GLuint
toGeometryShaderOutputTopology Lines
_ = GLuint
forall a. (Eq a, Num a) => a
GL_LINES
    toLayoutIn :: Lines -> Text
toLayoutIn Lines
_ = Text
"lines"
    toLayoutOut :: Lines -> Text
toLayoutOut Lines
_ = Text
"line_strip"
    data Geometry Lines a = Line a a

instance PrimitiveTopology LinesWithAdjacency where
    toGLtopology :: LinesWithAdjacency -> GLuint
toGLtopology LinesWithAdjacency
LineListAdjacency  = GLuint
forall a. (Eq a, Num a) => a
GL_LINES_ADJACENCY
    toGLtopology LinesWithAdjacency
LineStripAdjacency = GLuint
forall a. (Eq a, Num a) => a
GL_LINE_STRIP_ADJACENCY
    toPrimitiveSize :: LinesWithAdjacency -> Int
toPrimitiveSize LinesWithAdjacency
_= Int
2
    toGeometryShaderOutputTopology :: LinesWithAdjacency -> GLuint
toGeometryShaderOutputTopology LinesWithAdjacency
_ = GLuint
forall a. (Eq a, Num a) => a
GL_LINES
    toLayoutIn :: LinesWithAdjacency -> Text
toLayoutIn LinesWithAdjacency
_ = Text
"lines_adjacency"
    toLayoutOut :: LinesWithAdjacency -> Text
toLayoutOut LinesWithAdjacency
_ = Text
"line_strip"
    data Geometry LinesWithAdjacency a = LineWithAdjacency a a a a

instance PrimitiveTopology Triangles where
    toGLtopology :: Triangles -> GLuint
toGLtopology Triangles
TriangleList  = GLuint
forall a. (Eq a, Num a) => a
GL_TRIANGLES
    toGLtopology Triangles
TriangleStrip = GLuint
forall a. (Eq a, Num a) => a
GL_TRIANGLE_STRIP
    toPrimitiveSize :: Triangles -> Int
toPrimitiveSize Triangles
_= Int
3
    toGeometryShaderOutputTopology :: Triangles -> GLuint
toGeometryShaderOutputTopology Triangles
_ = GLuint
forall a. (Eq a, Num a) => a
GL_TRIANGLES
    toLayoutIn :: Triangles -> Text
toLayoutIn Triangles
_ = Text
"triangles"
    toLayoutOut :: Triangles -> Text
toLayoutOut Triangles
_ = Text
"triangle_strip"
    data Geometry Triangles a = Triangle a a a

instance PrimitiveTopology TrianglesWithAdjacency where
    toGLtopology :: TrianglesWithAdjacency -> GLuint
toGLtopology TrianglesWithAdjacency
TriangleListAdjacency  = GLuint
forall a. (Eq a, Num a) => a
GL_TRIANGLES_ADJACENCY
    toGLtopology TrianglesWithAdjacency
TriangleStripAdjacency = GLuint
forall a. (Eq a, Num a) => a
GL_TRIANGLE_STRIP_ADJACENCY
    toPrimitiveSize :: TrianglesWithAdjacency -> Int
toPrimitiveSize TrianglesWithAdjacency
_= Int
3
    toGeometryShaderOutputTopology :: TrianglesWithAdjacency -> GLuint
toGeometryShaderOutputTopology TrianglesWithAdjacency
_ = GLuint
forall a. (Eq a, Num a) => a
GL_TRIANGLES
    toLayoutIn :: TrianglesWithAdjacency -> Text
toLayoutIn TrianglesWithAdjacency
_ = Text
"triangles_adjacency"
    toLayoutOut :: TrianglesWithAdjacency -> Text
toLayoutOut TrianglesWithAdjacency
_ = Text
"triangle_strip"
    data Geometry TrianglesWithAdjacency a = TriangleWithAdjacency a a a a a a

type InstanceCount = Int
type BaseVertex = Int

-- PrimitiveTopology p =>
data PrimitiveArrayInt p a = PrimitiveArraySimple p Int BaseVertex a
                           | PrimitiveArrayIndexed p IndexArray BaseVertex a
                           | PrimitiveArrayInstanced p InstanceCount Int BaseVertex a
                           | PrimitiveArrayIndexedInstanced p IndexArray InstanceCount BaseVertex a

-- | An array of primitives
newtype PrimitiveArray p a = PrimitiveArray {PrimitiveArray p a -> [PrimitiveArrayInt p a]
getPrimitiveArray :: [PrimitiveArrayInt p a]}

instance Semigroup (PrimitiveArray p a) where
    PrimitiveArray [PrimitiveArrayInt p a]
a <> :: PrimitiveArray p a -> PrimitiveArray p a -> PrimitiveArray p a
<> PrimitiveArray [PrimitiveArrayInt p a]
b = [PrimitiveArrayInt p a] -> PrimitiveArray p a
forall p a. [PrimitiveArrayInt p a] -> PrimitiveArray p a
PrimitiveArray ([PrimitiveArrayInt p a]
a [PrimitiveArrayInt p a]
-> [PrimitiveArrayInt p a] -> [PrimitiveArrayInt p a]
forall a. [a] -> [a] -> [a]
++ [PrimitiveArrayInt p a]
b)

instance Monoid (PrimitiveArray p a) where
    mempty :: PrimitiveArray p a
mempty = [PrimitiveArrayInt p a] -> PrimitiveArray p a
forall p a. [PrimitiveArrayInt p a] -> PrimitiveArray p a
PrimitiveArray []
#if __GLASGOW_HASKELL__ < 804
    mappend = (<>)
#endif

instance Functor (PrimitiveArray p) where
    fmap :: (a -> b) -> PrimitiveArray p a -> PrimitiveArray p b
fmap a -> b
f (PrimitiveArray [PrimitiveArrayInt p a]
xs) = [PrimitiveArrayInt p b] -> PrimitiveArray p b
forall p a. [PrimitiveArrayInt p a] -> PrimitiveArray p a
PrimitiveArray ([PrimitiveArrayInt p b] -> PrimitiveArray p b)
-> [PrimitiveArrayInt p b] -> PrimitiveArray p b
forall a b. (a -> b) -> a -> b
$ (PrimitiveArrayInt p a -> PrimitiveArrayInt p b)
-> [PrimitiveArrayInt p a] -> [PrimitiveArrayInt p b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimitiveArrayInt p a -> PrimitiveArrayInt p b
g [PrimitiveArrayInt p a]
xs
        where g :: PrimitiveArrayInt p a -> PrimitiveArrayInt p b
g (PrimitiveArraySimple p
p Int
l Int
s a
a) = p -> Int -> Int -> b -> PrimitiveArrayInt p b
forall p a. p -> Int -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArraySimple p
p Int
l Int
s (a -> b
f a
a)
              g (PrimitiveArrayIndexed p
p IndexArray
i Int
s a
a) = p -> IndexArray -> Int -> b -> PrimitiveArrayInt p b
forall p a. p -> IndexArray -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArrayIndexed p
p IndexArray
i Int
s (a -> b
f a
a)
              g (PrimitiveArrayInstanced p
p Int
il Int
l Int
s a
a) = p -> Int -> Int -> Int -> b -> PrimitiveArrayInt p b
forall p a. p -> Int -> Int -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArrayInstanced p
p Int
il Int
l Int
s (a -> b
f a
a)
              g (PrimitiveArrayIndexedInstanced p
p IndexArray
i Int
il Int
s a
a) = p -> IndexArray -> Int -> Int -> b -> PrimitiveArrayInt p b
forall p a.
p -> IndexArray -> Int -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArrayIndexedInstanced p
p IndexArray
i Int
il Int
s (a -> b
f a
a)

toPrimitiveArray :: PrimitiveTopology p => p -> VertexArray () a -> PrimitiveArray p a
toPrimitiveArray :: p -> VertexArray () a -> PrimitiveArray p a
toPrimitiveArray p
p VertexArray () a
va = [PrimitiveArrayInt p a] -> PrimitiveArray p a
forall p a. [PrimitiveArrayInt p a] -> PrimitiveArray p a
PrimitiveArray [p -> Int -> Int -> a -> PrimitiveArrayInt p a
forall p a. p -> Int -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArraySimple p
p (VertexArray () a -> Int
forall t a. VertexArray t a -> Int
vertexArrayLength VertexArray () a
va) (VertexArray () a -> Int
forall t a. VertexArray t a -> Int
vertexArraySkip VertexArray () a
va) (VertexArray () a -> BInput -> a
forall t a. VertexArray t a -> BInput -> a
bArrBFunc VertexArray () a
va (Int -> Int -> BInput
BInput Int
0 Int
0))]
toPrimitiveArrayIndexed :: PrimitiveTopology p => p -> IndexArray -> VertexArray () a -> PrimitiveArray p a
toPrimitiveArrayIndexed :: p -> IndexArray -> VertexArray () a -> PrimitiveArray p a
toPrimitiveArrayIndexed p
p IndexArray
ia VertexArray () a
va = [PrimitiveArrayInt p a] -> PrimitiveArray p a
forall p a. [PrimitiveArrayInt p a] -> PrimitiveArray p a
PrimitiveArray [p -> IndexArray -> Int -> a -> PrimitiveArrayInt p a
forall p a. p -> IndexArray -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArrayIndexed p
p IndexArray
ia (VertexArray () a -> Int
forall t a. VertexArray t a -> Int
vertexArraySkip VertexArray () a
va) (VertexArray () a -> BInput -> a
forall t a. VertexArray t a -> BInput -> a
bArrBFunc VertexArray () a
va (Int -> Int -> BInput
BInput Int
0 Int
0))]
toPrimitiveArrayInstanced :: PrimitiveTopology p => p -> (a -> b -> c) -> VertexArray () a -> VertexArray t b -> PrimitiveArray p c
toPrimitiveArrayInstanced :: p
-> (a -> b -> c)
-> VertexArray () a
-> VertexArray t b
-> PrimitiveArray p c
toPrimitiveArrayInstanced p
p a -> b -> c
f VertexArray () a
va VertexArray t b
ina = [PrimitiveArrayInt p c] -> PrimitiveArray p c
forall p a. [PrimitiveArrayInt p a] -> PrimitiveArray p a
PrimitiveArray [p -> Int -> Int -> Int -> c -> PrimitiveArrayInt p c
forall p a. p -> Int -> Int -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArrayInstanced p
p (VertexArray t b -> Int
forall t a. VertexArray t a -> Int
vertexArrayLength VertexArray t b
ina) (VertexArray () a -> Int
forall t a. VertexArray t a -> Int
vertexArrayLength VertexArray () a
va) (VertexArray () a -> Int
forall t a. VertexArray t a -> Int
vertexArraySkip VertexArray () a
va) (a -> b -> c
f (VertexArray () a -> BInput -> a
forall t a. VertexArray t a -> BInput -> a
bArrBFunc VertexArray () a
va (BInput -> a) -> BInput -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BInput
BInput Int
0 Int
0) (VertexArray t b -> BInput -> b
forall t a. VertexArray t a -> BInput -> a
bArrBFunc VertexArray t b
ina (BInput -> b) -> BInput -> b
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BInput
BInput (VertexArray t b -> Int
forall t a. VertexArray t a -> Int
vertexArraySkip VertexArray t b
ina) Int
1))] -- Base instance not supported in GL < 4, so need to burn in
toPrimitiveArrayIndexedInstanced :: PrimitiveTopology p => p -> IndexArray -> (a -> b -> c) -> VertexArray () a -> VertexArray t b -> PrimitiveArray p c
toPrimitiveArrayIndexedInstanced :: p
-> IndexArray
-> (a -> b -> c)
-> VertexArray () a
-> VertexArray t b
-> PrimitiveArray p c
toPrimitiveArrayIndexedInstanced p
p IndexArray
ia a -> b -> c
f VertexArray () a
va VertexArray t b
ina = [PrimitiveArrayInt p c] -> PrimitiveArray p c
forall p a. [PrimitiveArrayInt p a] -> PrimitiveArray p a
PrimitiveArray [p -> IndexArray -> Int -> Int -> c -> PrimitiveArrayInt p c
forall p a.
p -> IndexArray -> Int -> Int -> a -> PrimitiveArrayInt p a
PrimitiveArrayIndexedInstanced p
p IndexArray
ia (VertexArray t b -> Int
forall t a. VertexArray t a -> Int
vertexArrayLength VertexArray t b
ina) (VertexArray () a -> Int
forall t a. VertexArray t a -> Int
vertexArraySkip VertexArray () a
va) (a -> b -> c
f (VertexArray () a -> BInput -> a
forall t a. VertexArray t a -> BInput -> a
bArrBFunc VertexArray () a
va (BInput -> a) -> BInput -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BInput
BInput Int
0 Int
0) (VertexArray t b -> BInput -> b
forall t a. VertexArray t a -> BInput -> a
bArrBFunc VertexArray t b
ina (BInput -> b) -> BInput -> b
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BInput
BInput (VertexArray t b -> Int
forall t a. VertexArray t a -> Int
vertexArraySkip VertexArray t b
ina) Int
1))] -- Base instance not supported in GL < 4, so need to burn in