lots of plumbing to automate stuff
This commit is contained in:
parent
de5e692305
commit
0fb10b0981
|
@ -31,6 +31,7 @@ executable pituicat
|
||||||
, Classes.Graphics
|
, Classes.Graphics
|
||||||
, Classes.Graphics.Bindable
|
, Classes.Graphics.Bindable
|
||||||
, Classes.Graphics.Buffer
|
, Classes.Graphics.Buffer
|
||||||
|
, Classes.Graphics.VertexLayout
|
||||||
, State.Loading
|
, State.Loading
|
||||||
, State.Loading.Load
|
, State.Loading.Load
|
||||||
, State.Loading.Update
|
, State.Loading.Update
|
||||||
|
@ -59,5 +60,6 @@ executable pituicat
|
||||||
, JuicyPixels-extra
|
, JuicyPixels-extra
|
||||||
, bytestring
|
, bytestring
|
||||||
, derive-storable
|
, derive-storable
|
||||||
|
, monad-loops
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -26,8 +26,8 @@ let
|
||||||
}) {};
|
}) {};
|
||||||
|
|
||||||
f = { mkDerivation, aeson, base, bytestring, containers, derive-storable
|
f = { mkDerivation, aeson, base, bytestring, containers, derive-storable
|
||||||
, JuicyPixels, JuicyPixels-extra, linear, OpenGL, OpenGLRaw, stdenv
|
, JuicyPixels, JuicyPixels-extra, linear, monad-loops, OpenGL, OpenGLRaw
|
||||||
, sdl2, stm, text, vector}:
|
, stdenv, sdl2, stm, text, vector}:
|
||||||
mkDerivation {
|
mkDerivation {
|
||||||
pname = "pituicat";
|
pname = "pituicat";
|
||||||
version = "0.0.0.0";
|
version = "0.0.0.0";
|
||||||
|
|
|
@ -3,3 +3,5 @@ module Classes.Graphics
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Classes.Graphics.Bindable as G
|
import Classes.Graphics.Bindable as G
|
||||||
|
import Classes.Graphics.Buffer as G
|
||||||
|
import Classes.Graphics.VertexLayout as G
|
||||||
|
|
|
@ -1,10 +1,13 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
module Classes.Graphics.Buffer where
|
module Classes.Graphics.Buffer where
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import SDL (($=), get)
|
import SDL (($=), get)
|
||||||
|
|
||||||
|
import Foreign.Storable
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Classes.Graphics.Bindable
|
import Classes.Graphics.Bindable
|
||||||
|
@ -12,28 +15,35 @@ import Classes.Graphics.Bindable
|
||||||
-- | this aims to be a typeclass for all used buffer objects throughout the
|
-- | this aims to be a typeclass for all used buffer objects throughout the
|
||||||
-- game. all buffer objects have to instanciate the Bindable typeclass.
|
-- game. all buffer objects have to instanciate the Bindable typeclass.
|
||||||
-- think of it as some kind of interface in the object oriented context
|
-- think of it as some kind of interface in the object oriented context
|
||||||
class (Bindable a) => Buffer a where
|
class (Bindable a, Storable (StoreType a)) =>
|
||||||
|
Buffer a where
|
||||||
|
|
||||||
type ObjName a :: *
|
-- | datatype inside the buffer
|
||||||
|
type StoreType a :: *
|
||||||
|
|
||||||
-- | what buffer target does the buffer bind to
|
-- | container datatype for 'StoreType's
|
||||||
target :: a -> GL.BufferTarget
|
type StoreContainer a :: * -> *
|
||||||
|
|
||||||
-- | retrieve ID from buffer object
|
-- | what buffer target does the buffer bind to
|
||||||
glId :: a -> IO (ObjName a)
|
target :: a -> GL.BufferTarget
|
||||||
|
|
||||||
-- | bind the buffer object and fill it with null data
|
-- | retrieve ID from buffer object
|
||||||
initialize :: a -> IO ()
|
glId :: a -> IO (GL.BufferObject)
|
||||||
|
|
||||||
-- | fill the buffer with actual data
|
-- | bind the buffer object and fill it with null data
|
||||||
write
|
initialize :: a -> IO ()
|
||||||
:: a
|
|
||||||
-> Word -- ^ write offset from beginning of buffer in bytes
|
|
||||||
-> b -- ^ Data to write
|
|
||||||
-> IO ()
|
|
||||||
|
|
||||||
-- | expand the buffer to double of it's previous size.
|
-- | fill the buffer with actual data
|
||||||
expand :: a -> IO ()
|
write
|
||||||
|
:: a
|
||||||
|
-> Word
|
||||||
|
-- ^ write offset from beginning of buffer in bytes
|
||||||
|
-> StoreContainer a (StoreType a)
|
||||||
|
-- ^ Data to write
|
||||||
|
-> IO ()
|
||||||
|
|
||||||
-- | free resources and delete the object
|
-- | expand the buffer to double of it's previous size.
|
||||||
delete :: a -> IO ()
|
expand :: a -> IO ()
|
||||||
|
|
||||||
|
-- | free resources and delete the object
|
||||||
|
delete :: a -> IO ()
|
||||||
|
|
|
@ -18,7 +18,7 @@ import Linear
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
import Map
|
import Map
|
||||||
import Classes.Scene
|
import Classes
|
||||||
|
|
||||||
data Test = Test
|
data Test = Test
|
||||||
{ testMap :: TMVar LevelMap
|
{ testMap :: TMVar LevelMap
|
||||||
|
@ -44,10 +44,9 @@ instance Scene Test where
|
||||||
view = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
|
view = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
|
||||||
model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
|
model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
|
||||||
|
|
||||||
vertexArrayObject <- GL.genObjectName
|
|
||||||
vertexArray <- newVertexArray
|
vertexArray <- newVertexArray
|
||||||
|
|
||||||
GL.bindVertexArrayObject $= Just vertexArrayObject
|
bind vertexArray
|
||||||
|
|
||||||
void $ atomically $ do
|
void $ atomically $ do
|
||||||
void $ takeTMVar progress
|
void $ takeTMVar progress
|
||||||
|
|
|
@ -5,6 +5,12 @@ import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import SDL (($=), get)
|
import SDL (($=), get)
|
||||||
|
|
||||||
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
|
import Control.Monad.Loops (whileM_)
|
||||||
|
|
||||||
|
import Control.Concurent.STM
|
||||||
|
|
||||||
import Foreign
|
import Foreign
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
@ -13,21 +19,23 @@ import Classes.Graphics.Bindable
|
||||||
import Classes.Graphics.Buffer
|
import Classes.Graphics.Buffer
|
||||||
|
|
||||||
-- layout of the IndexBuffer data object
|
-- layout of the IndexBuffer data object
|
||||||
data IndexBuffer a = IndexBuffer
|
data IndexBuffer = IndexBuffer
|
||||||
{ iBufId :: GL.BufferObject -- buffer id
|
{ iBufId :: TVar GL.BufferObject -- buffer id
|
||||||
, iBufSize :: GL.GLsizeiptr -- size of data
|
, iBufSize :: TVar GL.GLsizeiptr -- size of data
|
||||||
, iBufData :: Ptr a -- pointer to data
|
-- , iBufData :: Ptr a -- pointer to data
|
||||||
, iBufCount :: GL.GLint -- number of data elements
|
-- , iBufCount :: GL.GLint -- number of data elements
|
||||||
}
|
}
|
||||||
|
|
||||||
-- instanciate typeclass from BufferClass and fill in missing implementations
|
-- instanciate typeclass from Buffer and fill in missing implementations
|
||||||
instance Buffer (IndexBuffer a) where
|
instance Buffer IndexBuffer where
|
||||||
|
|
||||||
type ObjName (IndexBuffer a) = GL.BufferObject
|
type StoreType IndexBuffer = GL.GLuint
|
||||||
|
|
||||||
|
type StoreContainer IndexBuffer = VS.Vector
|
||||||
|
|
||||||
target _ = GL.ElementArrayBuffer
|
target _ = GL.ElementArrayBuffer
|
||||||
|
|
||||||
glId = iBufId
|
glId = readTVarIO . iBufId
|
||||||
|
|
||||||
initialize buf = do
|
initialize buf = do
|
||||||
-- bind the buffer using the default iplementation of the typeclass
|
-- bind the buffer using the default iplementation of the typeclass
|
||||||
|
@ -35,12 +43,60 @@ instance Buffer (IndexBuffer a) where
|
||||||
-- fill in the data
|
-- fill in the data
|
||||||
GL.bufferData (target buf) $=
|
GL.bufferData (target buf) $=
|
||||||
( iBufSize buf
|
( iBufSize buf
|
||||||
, iBufData buf
|
, nullPtr
|
||||||
, GL.DynamicDraw
|
, GL.DynamicDraw
|
||||||
)
|
)
|
||||||
-- release the buffer using the default implementation of the typeclass
|
-- release the buffer using the default implementation of the typeclass
|
||||||
unbind buf
|
unbind buf
|
||||||
|
|
||||||
|
write buf offset dat = do
|
||||||
|
currentBufSize <- readTVarIO (iBufSize buf)
|
||||||
|
whileM_
|
||||||
|
(pure $ offset + VS.length dat * sizeOf (undefined :: StoreType IndexBuffer)
|
||||||
|
> currentBufSize) $ do
|
||||||
|
allocaArray
|
||||||
|
(currentBufSize `div` sizeOf (undefined :: StoreType IndexBuffer))
|
||||||
|
$ \ ptr -> do
|
||||||
|
GL.bufferSubData
|
||||||
|
(target buf)
|
||||||
|
GL.ReadFromBuffer
|
||||||
|
0
|
||||||
|
currentBufSize
|
||||||
|
ptr
|
||||||
|
expand buf
|
||||||
|
bind buf
|
||||||
|
GL.bufferSubData
|
||||||
|
(target buf)
|
||||||
|
GL.WriteToBuffer
|
||||||
|
0
|
||||||
|
currentBufSize
|
||||||
|
ptr
|
||||||
|
-- bind buffer, just to be safe
|
||||||
|
bind buf
|
||||||
|
VS unsafeWith dat $ \ ptr ->
|
||||||
|
GL.bufferSubData
|
||||||
|
(target buf)
|
||||||
|
GL.WriteToBuffer
|
||||||
|
(CPtrdiff $ fromIntegral offset)
|
||||||
|
(CPtrdiff $ fromIntegral $
|
||||||
|
VS.length dat * sizeOf (undefined ::StoreType IndexBuffer))
|
||||||
|
ptr
|
||||||
|
|
||||||
|
expand buf = do
|
||||||
|
unbind buf
|
||||||
|
delete buf
|
||||||
|
newId <- GL.genObjectName
|
||||||
|
newSize <- (2 *) <$> readTVarIO (iBufSize buf)
|
||||||
|
atomically $ do
|
||||||
|
writeTvar (iBufId buf) newId
|
||||||
|
writeTvar (iBUfSize buf) newSize
|
||||||
|
initialize buf
|
||||||
|
|
||||||
|
delete buf = do
|
||||||
|
unbind buf
|
||||||
|
GL.deleteObjectname ==< (readTVarIO $ vBufId buf)
|
||||||
|
|
||||||
|
|
||||||
instance Bindable (IndexBuffer a) where
|
instance Bindable (IndexBuffer a) where
|
||||||
|
|
||||||
-- bind the buffer
|
-- bind the buffer
|
||||||
|
@ -49,21 +105,20 @@ instance Bindable (IndexBuffer a) where
|
||||||
-- unbind the buffer
|
-- unbind the buffer
|
||||||
unbind buf = GL.bindBuffer (target buf) $= Nothing
|
unbind buf = GL.bindBuffer (target buf) $= Nothing
|
||||||
|
|
||||||
newIndexBuffer ::
|
newIndexBuffer
|
||||||
(Storable a) => -- we have to be able to get a pointer to provided data
|
:: Word
|
||||||
[a] -> -- list of data elements
|
-> IO IndexBuffer -- newly built IndexBuffer data object
|
||||||
IO (IndexBuffer a) -- newly built IndexBuffer data object
|
newIndexBuffer initLength = do
|
||||||
newIndexBuffer list = do
|
|
||||||
-- create the buffer object in applicative style
|
-- create the buffer object in applicative style
|
||||||
buf <- IndexBuffer
|
buf <- IndexBuffer
|
||||||
-- generate the ID
|
-- generate the ID
|
||||||
<$> GL.genObjectName
|
<$> GL.genObjectName
|
||||||
-- compute buffer size
|
-- compute buffer size
|
||||||
<*> pure (fromIntegral (length list * sizeOf (head list)))
|
<*> pure (fromIntegral initLength)
|
||||||
-- make pointer out of list
|
-- -- make pointer out of list
|
||||||
<*> newArray list
|
-- <*> newArray list
|
||||||
-- get count
|
-- -- get count
|
||||||
<*> pure (fromIntegral $ length list)
|
-- <*> pure (fromIntegral $ length list)
|
||||||
-- fill the data in to the buffer
|
-- fill the data in to the buffer
|
||||||
initialize buf
|
initialize buf
|
||||||
-- return the data object
|
-- return the data object
|
||||||
|
|
|
@ -5,32 +5,27 @@ import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import SDL (($=), get)
|
import SDL (($=), get)
|
||||||
|
|
||||||
import Foreign
|
import qualified Data.Vector as V
|
||||||
|
|
||||||
import Control.Concurrent.MVar
|
import Foreign (sizeOf)
|
||||||
|
import Foreign.Ptr
|
||||||
|
|
||||||
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Classes.Graphics.Bindable
|
import Classes.Graphics.Bindable
|
||||||
import Classes.Graphics.Buffer
|
import Classes.Graphics.Buffer
|
||||||
|
import Classes.Graphics.VertexLayout
|
||||||
import Types.Graphics.VertexBuffer
|
import Types.Graphics.VertexBuffer
|
||||||
|
|
||||||
data VertexArray = VertexArray
|
newtype VertexArray = VertexArray
|
||||||
{ vArrId :: GL.VertexArrayObject
|
{ vArrId :: GL.VertexArrayObject
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
instance Buffer VertexArray where
|
|
||||||
|
|
||||||
type ObjName VertexArray = GL.VertexArrayObject
|
|
||||||
|
|
||||||
target _ = undefined
|
|
||||||
|
|
||||||
glId = return . vArrId
|
|
||||||
|
|
||||||
initialize va = return ()
|
|
||||||
|
|
||||||
|
|
||||||
instance Bindable VertexArray where
|
instance Bindable VertexArray where
|
||||||
|
|
||||||
bind va = GL.bindVertexArrayObject $= Just (vArrId va)
|
bind va = GL.bindVertexArrayObject $= Just (vArrId va)
|
||||||
|
@ -41,76 +36,39 @@ newVertexArray :: IO VertexArray
|
||||||
newVertexArray = VertexArray
|
newVertexArray = VertexArray
|
||||||
<$> GL.genObjectName
|
<$> GL.genObjectName
|
||||||
|
|
||||||
addBuffer
|
instance VertexLayout Vertex where
|
||||||
:: (Buffer buf)
|
|
||||||
=> VertexArray
|
type VertArray Vertex = VertexArray
|
||||||
-> buf
|
|
||||||
-> VertexBufferLayout
|
layoutElements vert =
|
||||||
-> IO ()
|
foldr
|
||||||
addBuffer va vb layout = do
|
(\a@(index, count) acc ->
|
||||||
-- bind the provided vertex buffer
|
( index
|
||||||
bind va
|
|
||||||
bind vb
|
|
||||||
-- enable and fill out the vertex attrib pointer(s)
|
|
||||||
list <- readMVar (vblElements layout)
|
|
||||||
let dataElementSize e = case e of
|
|
||||||
GL.Float -> sizeOf (undefined :: GL.GLfloat)
|
|
||||||
x -> error ("No size computation implemented fof: " <> show x)
|
|
||||||
mapM_
|
|
||||||
(\(VertexBufferLayoutElement index type_ count offset handling) -> do
|
|
||||||
GL.vertexAttribArray (GL.AttribLocation index) $=
|
|
||||||
GL.Enabled
|
|
||||||
GL.vertexAttribPointer (GL.AttribLocation index) $=
|
|
||||||
( handling
|
|
||||||
, GL.VertexArrayDescriptor
|
, GL.VertexArrayDescriptor
|
||||||
-- number of components to our attribute
|
|
||||||
count
|
count
|
||||||
-- datatype of elements
|
GL.Float
|
||||||
type_
|
(fromIntegral $ sizeOf (undefined :: Vertex))
|
||||||
-- Stride (How big is one Vertex in bytes)
|
(nullPtr `plusPtr` (sizeOf (undefined :: GL.GLfloat) * fromIntegral
|
||||||
(vblStride layout)
|
(sum (map ((\(GL.VertexArrayDescriptor c _ _ _) -> c) . snd) acc))))
|
||||||
-- offset from beginnning of vertex in bytes
|
) : acc
|
||||||
(plusPtr nullPtr offset)
|
|
||||||
)
|
)
|
||||||
)
|
[]
|
||||||
list
|
(zip [0 ..] [3, 4, 2, 1])
|
||||||
unbind va
|
|
||||||
unbind vb
|
|
||||||
|
|
||||||
data VertexBufferLayout = VertexBufferLayout
|
addBuffer vert va vb = do
|
||||||
{ vblElements :: MVar [VertexBufferLayoutElement]
|
-- bind vertex array and vertex buffer ot associate them
|
||||||
, vblStride :: GL.GLsizei
|
bind va
|
||||||
}
|
bind vb
|
||||||
|
-- enable and fill vertex attrib pointer(s)
|
||||||
data VertexBufferLayoutElement = VertexBufferLayoutElement
|
let list = layoutElements vert
|
||||||
{ vbleIndex :: GL.GLuint
|
mapM_
|
||||||
, vbleType :: GL.DataType
|
(\(index, descriptor) -> do
|
||||||
, vbleCount :: GL.GLint
|
GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled
|
||||||
, vbleOffset :: Int
|
GL.vertexAttribPointer (GL.AttribLocation index) $=
|
||||||
, vbleHandling :: GL.IntegerHandling
|
( GL.ToNormalizedFloat
|
||||||
}
|
, descriptor
|
||||||
|
)
|
||||||
newVertexBufferLayout :: GL.GLsizei -> IO VertexBufferLayout
|
|
||||||
newVertexBufferLayout stride = VertexBufferLayout
|
|
||||||
<$> newMVar []
|
|
||||||
<*> pure stride
|
|
||||||
|
|
||||||
pushElements
|
|
||||||
:: VertexBufferLayout
|
|
||||||
-> GL.GLuint
|
|
||||||
-> GL.DataType
|
|
||||||
-> GL.GLint
|
|
||||||
-> Int
|
|
||||||
-> IO ()
|
|
||||||
pushElements vbl index type_ count offset = do
|
|
||||||
modifyMVar_ (vblElements vbl) $ \list ->
|
|
||||||
return
|
|
||||||
(list ++
|
|
||||||
[VertexBufferLayoutElement
|
|
||||||
index
|
|
||||||
type_
|
|
||||||
count
|
|
||||||
offset
|
|
||||||
GL.ToNormalizedFloat
|
|
||||||
]
|
|
||||||
)
|
)
|
||||||
|
list
|
||||||
|
unbind va
|
||||||
|
unbind vb
|
||||||
|
|
|
@ -1,16 +1,22 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
module Types.Graphics.VertexBuffer where
|
module Types.Graphics.VertexBuffer where
|
||||||
|
|
||||||
import qualified Graphics.Rendering.OpenGL as GL
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
import SDL (($=), get)
|
import SDL (($=), get)
|
||||||
|
|
||||||
|
import Control.Monad.Loops (whileM_)
|
||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
|
||||||
|
import qualified Data.Vector.Storable as VS
|
||||||
|
|
||||||
import Linear
|
import Linear
|
||||||
|
|
||||||
|
import Foreign
|
||||||
import Foreign
|
import Foreign
|
||||||
import Foreign.C.Types
|
import Foreign.C.Types
|
||||||
import Foreign.Storable.Generic
|
import Foreign.Storable.Generic
|
||||||
|
@ -34,7 +40,6 @@ data Vertex = Vertex
|
||||||
, vertColor :: V4 GL.GLfloat
|
, vertColor :: V4 GL.GLfloat
|
||||||
, vertTexCoord :: V2 GL.GLfloat
|
, vertTexCoord :: V2 GL.GLfloat
|
||||||
, vertTexID :: GL.GLfloat
|
, vertTexID :: GL.GLfloat
|
||||||
, vertSize :: GL.GLsizei
|
|
||||||
}
|
}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
|
@ -57,12 +62,13 @@ newVertex pos color texcoord index =
|
||||||
color
|
color
|
||||||
texcoord
|
texcoord
|
||||||
index
|
index
|
||||||
(fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat)))
|
|
||||||
|
|
||||||
-- | Instanciate typeclass Buffer and fill in missing implementations
|
-- | Instanciate typeclass Buffer and fill in missing implementations
|
||||||
instance Buffer VertexBuffer where
|
instance Buffer VertexBuffer where
|
||||||
|
|
||||||
type ObjName VertexBuffer = GL.BufferObject
|
type StoreType VertexBuffer = Vertex
|
||||||
|
|
||||||
|
type StoreContainer VertexBuffer = VS.Vector
|
||||||
|
|
||||||
target _ = GL.ArrayBuffer
|
target _ = GL.ArrayBuffer
|
||||||
|
|
||||||
|
@ -81,7 +87,47 @@ instance Buffer VertexBuffer where
|
||||||
-- release the buffer using the default implementation of the typeclass
|
-- release the buffer using the default implementation of the typeclass
|
||||||
unbind buf
|
unbind buf
|
||||||
|
|
||||||
-- | expand the buffer to double of it's previous size.
|
write buf offset dat = do
|
||||||
|
currentBufSize <- readTVarIO (vBufSize buf)
|
||||||
|
whileM_
|
||||||
|
(pure $ fromIntegral offset +
|
||||||
|
VS.length dat * sizeOf (undefined :: StoreType VertexBuffer)
|
||||||
|
> fromIntegral currentBufSize) $ do
|
||||||
|
allocaArray
|
||||||
|
(fromIntegral currentBufSize `div`
|
||||||
|
sizeOf (undefined :: StoreType VertexBuffer))
|
||||||
|
$ \ (ptr :: Ptr (StoreType VertexBuffer)) -> do
|
||||||
|
GL.bufferSubData
|
||||||
|
(target buf)
|
||||||
|
GL.ReadFromBuffer
|
||||||
|
0
|
||||||
|
currentBufSize
|
||||||
|
ptr
|
||||||
|
expand buf
|
||||||
|
bind buf
|
||||||
|
GL.bufferSubData
|
||||||
|
(target buf)
|
||||||
|
GL.WriteToBuffer
|
||||||
|
0
|
||||||
|
currentBufSize
|
||||||
|
ptr
|
||||||
|
-- bind buffer, just to be safe
|
||||||
|
bind buf
|
||||||
|
VS.unsafeWith dat $ \ ptr ->
|
||||||
|
GL.bufferSubData
|
||||||
|
(target buf)
|
||||||
|
-- target buffer type
|
||||||
|
GL.WriteToBuffer
|
||||||
|
-- data access direction
|
||||||
|
(CPtrdiff $ fromIntegral offset)
|
||||||
|
-- offset from buffer start
|
||||||
|
(CPtrdiff $ fromIntegral $
|
||||||
|
VS.length dat * sizeOf (undefined :: StoreType VertexBuffer))
|
||||||
|
-- length of data to write
|
||||||
|
ptr
|
||||||
|
-- pointer to first data object
|
||||||
|
|
||||||
|
--le | expand the buffer to double of it's previous size.
|
||||||
-- This discards all previously written data and layouts, as internally the
|
-- This discards all previously written data and layouts, as internally the
|
||||||
-- old buffer is discarded and a new buffer allocated.
|
-- old buffer is discarded and a new buffer allocated.
|
||||||
expand buf = do
|
expand buf = do
|
||||||
|
@ -118,9 +164,8 @@ instance Bindable VertexBuffer where
|
||||||
-- | smart constructor for a VertexBuffer data object
|
-- | smart constructor for a VertexBuffer data object
|
||||||
newVertexBuffer
|
newVertexBuffer
|
||||||
:: Word -- ^ initial Buffer size
|
:: Word -- ^ initial Buffer size
|
||||||
-> Vertex -- ^ (empty) dummy vertex for determining buffer size
|
|
||||||
-> IO VertexBuffer -- ^ newly built VertexBuffer data object
|
-> IO VertexBuffer -- ^ newly built VertexBuffer data object
|
||||||
newVertexBuffer initSize dummyVertex = do
|
newVertexBuffer initSize = do
|
||||||
-- let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0
|
-- let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0
|
||||||
-- create the buffer object in applicative style
|
-- create the buffer object in applicative style
|
||||||
buf <- VertexBuffer
|
buf <- VertexBuffer
|
||||||
|
@ -128,7 +173,7 @@ newVertexBuffer initSize dummyVertex = do
|
||||||
<$> (newTVarIO =<< GL.genObjectName)
|
<$> (newTVarIO =<< GL.genObjectName)
|
||||||
-- compute buffer size
|
-- compute buffer size
|
||||||
<*> (newTVarIO (CPtrdiff (fromIntegral $
|
<*> (newTVarIO (CPtrdiff (fromIntegral $
|
||||||
fromIntegral initSize * vertSize dummyVertex)))
|
fromIntegral initSize * sizeOf (undefined :: StoreType VertexBuffer))))
|
||||||
-- make pointer out of list
|
-- make pointer out of list
|
||||||
-- <*> newArray list
|
-- <*> newArray list
|
||||||
-- fill the data in to the buffer
|
-- fill the data in to the buffer
|
||||||
|
|
Loading…
Reference in New Issue