module Graphics.GPipe.Internal.PrimitiveArray where
import Graphics.GPipe.Internal.Buffer
import Graphics.GPipe.Internal.Shader
import Data.Monoid
import Data.IORef
import Data.Word
import Graphics.GL.Core33
import Graphics.GL.Types
data VertexArray t a = VertexArray {
vertexArrayLength :: Int,
bArrBFunc:: BInput -> a
}
data Instances
newVertexArray :: Buffer os a -> Render os f (VertexArray t a)
newVertexArray buffer = Render $ return $ VertexArray (bufferLength buffer) $ bufBElement buffer
instance Functor (VertexArray t) where
fmap f (VertexArray n g) = VertexArray n (f . g)
zipVertices :: (a -> b -> c) -> VertexArray t a -> VertexArray t' b -> VertexArray (Combine t t') c
zipVertices h (VertexArray n f) (VertexArray m g) = VertexArray (min n m) (\x -> h (f x) (g x))
type family Combine t t' where
Combine () Instances = Instances
Combine Instances () = Instances
Combine Instances Instances = Instances
Combine () () = ()
takeVertices :: Int -> VertexArray t a -> VertexArray t a
takeVertices n (VertexArray m f) = VertexArray (min n m) f
dropVertices :: Int -> VertexArray () a -> VertexArray t a
dropVertices n (VertexArray m f) = VertexArray n' g
where
n' = max (m n) 0
g bIn = f $ bIn { bInSkipElems = bInSkipElems bIn + n'}
replicateEach :: Int -> VertexArray t a -> VertexArray Instances a
replicateEach n (VertexArray m f) = VertexArray (n*m) (\x -> f $ x {bInInstanceDiv = bInInstanceDiv x * n})
type family IndexFormat a where
IndexFormat (B Word32) = Word32
IndexFormat (BPacked Word16) = Word16
IndexFormat (BPacked Word8) = Word8
data IndexArray = IndexArray {
iArrName :: IORef GLuint,
indexArrayLength:: Int,
offset:: Int,
restart:: Maybe Int,
indexType :: GLuint
}
newIndexArray :: forall os f b a. (BufferFormat b, Integral a, IndexFormat b ~ a) => Buffer os b -> Maybe a -> Render os f IndexArray
newIndexArray buf r = let a = undefined :: b in Render $ return $ IndexArray (bufName buf) (bufferLength buf) 0 (fmap fromIntegral r) (getGlType a)
takeIndices :: Int -> IndexArray -> IndexArray
takeIndices n i = i { indexArrayLength = min n (indexArrayLength i) }
dropIndices :: Int -> IndexArray -> IndexArray
dropIndices n i = i { indexArrayLength = max (l n) 0, offset = offset i + n } where l = indexArrayLength i
data Triangles
data Lines
data Points
data PrimitiveTopology p where
TriangleList :: PrimitiveTopology Triangles
TriangleStrip :: PrimitiveTopology Triangles
TriangleFan :: PrimitiveTopology Triangles
LineList :: PrimitiveTopology Lines
LineStrip :: PrimitiveTopology Lines
LineLoop :: PrimitiveTopology Lines
PointList :: PrimitiveTopology Points
toGLtopology :: PrimitiveTopology p -> GLuint
toGLtopology TriangleList = GL_TRIANGLES
toGLtopology TriangleStrip = GL_TRIANGLE_STRIP
toGLtopology TriangleFan = GL_TRIANGLE_FAN
toGLtopology LineList = GL_LINES
toGLtopology LineStrip = GL_LINE_STRIP
toGLtopology LineLoop = GL_LINE_LOOP
toGLtopology PointList = GL_POINTS
type InstanceCount = Int
data PrimitiveArrayInt p a = PrimitiveArraySimple (PrimitiveTopology p) Int a
| PrimitiveArrayIndexed (PrimitiveTopology p) IndexArray a
| PrimitiveArrayInstanced (PrimitiveTopology p) InstanceCount Int a
| PrimitiveArrayIndexedInstanced (PrimitiveTopology p) IndexArray InstanceCount a
newtype PrimitiveArray p a = PrimitiveArray {getPrimitiveArray :: [PrimitiveArrayInt p a]}
instance Monoid (PrimitiveArray p a) where
mempty = PrimitiveArray []
mappend (PrimitiveArray a) (PrimitiveArray b) = PrimitiveArray (a ++ b)
instance Functor (PrimitiveArray p) where
fmap f (PrimitiveArray xs) = PrimitiveArray $ fmap g xs
where g (PrimitiveArraySimple p l a) = PrimitiveArraySimple p l (f a)
g (PrimitiveArrayIndexed p i a) = PrimitiveArrayIndexed p i (f a)
g (PrimitiveArrayInstanced p il l a) = PrimitiveArrayInstanced p il l (f a)
g (PrimitiveArrayIndexedInstanced p i il a) = PrimitiveArrayIndexedInstanced p i il (f a)
toPrimitiveArray :: PrimitiveTopology p -> VertexArray () a -> PrimitiveArray p a
toPrimitiveArray p va = PrimitiveArray [PrimitiveArraySimple p (vertexArrayLength va) (bArrBFunc va (BInput 0 0))]
toPrimitiveArrayIndexed :: PrimitiveTopology p -> IndexArray -> VertexArray () a -> PrimitiveArray p a
toPrimitiveArrayIndexed p ia va = PrimitiveArray [PrimitiveArrayIndexed p ia (bArrBFunc va (BInput 0 0))]
toPrimitiveArrayInstanced :: PrimitiveTopology p -> (a -> b -> c) -> VertexArray () a -> VertexArray t b -> PrimitiveArray p c
toPrimitiveArrayInstanced p f va ina = PrimitiveArray [PrimitiveArrayInstanced p (vertexArrayLength ina) (vertexArrayLength va) (f (bArrBFunc va $ BInput 0 0) (bArrBFunc ina $ BInput 0 1))]
toPrimitiveArrayIndexedInstanced :: PrimitiveTopology p -> IndexArray -> (a -> b -> c) -> VertexArray () a -> VertexArray t b -> PrimitiveArray p c
toPrimitiveArrayIndexedInstanced p ia f va ina = PrimitiveArray [PrimitiveArrayIndexedInstanced p ia (vertexArrayLength ina) (f (bArrBFunc va $ BInput 0 0) (bArrBFunc ina $ BInput 0 1))]