diff --git a/pituicat.cabal b/pituicat.cabal index b43f795..2d6bc4b 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -31,6 +31,7 @@ executable pituicat , Classes.Graphics , Classes.Graphics.Bindable , Classes.Graphics.Buffer + , Classes.Graphics.VertexLayout , State.Loading , State.Loading.Load , State.Loading.Update @@ -59,5 +60,6 @@ executable pituicat , JuicyPixels-extra , bytestring , derive-storable + , monad-loops hs-source-dirs: src default-language: Haskell2010 diff --git a/shell.nix b/shell.nix index 7a6ef85..0277c4c 100644 --- a/shell.nix +++ b/shell.nix @@ -26,8 +26,8 @@ let }) {}; f = { mkDerivation, aeson, base, bytestring, containers, derive-storable - , JuicyPixels, JuicyPixels-extra, linear, OpenGL, OpenGLRaw, stdenv - , sdl2, stm, text, vector}: + , JuicyPixels, JuicyPixels-extra, linear, monad-loops, OpenGL, OpenGLRaw + , stdenv, sdl2, stm, text, vector}: mkDerivation { pname = "pituicat"; version = "0.0.0.0"; diff --git a/src/Classes/Graphics.hs b/src/Classes/Graphics.hs index baba09c..9295e9a 100644 --- a/src/Classes/Graphics.hs +++ b/src/Classes/Graphics.hs @@ -3,3 +3,5 @@ module Classes.Graphics ) where import Classes.Graphics.Bindable as G +import Classes.Graphics.Buffer as G +import Classes.Graphics.VertexLayout as G diff --git a/src/Classes/Graphics/Buffer.hs b/src/Classes/Graphics/Buffer.hs index ae620c8..cbbc7ab 100644 --- a/src/Classes/Graphics/Buffer.hs +++ b/src/Classes/Graphics/Buffer.hs @@ -1,10 +1,13 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} module Classes.Graphics.Buffer where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) +import Foreign.Storable + -- internal imports 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 -- game. all buffer objects have to instanciate the Bindable typeclass. -- 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 - target :: a -> GL.BufferTarget + -- | container datatype for 'StoreType's + type StoreContainer a :: * -> * - -- | retrieve ID from buffer object - glId :: a -> IO (ObjName a) + -- | what buffer target does the buffer bind to + target :: a -> GL.BufferTarget - -- | bind the buffer object and fill it with null data - initialize :: a -> IO () + -- | retrieve ID from buffer object + glId :: a -> IO (GL.BufferObject) - -- | fill the buffer with actual data - write - :: a - -> Word -- ^ write offset from beginning of buffer in bytes - -> b -- ^ Data to write - -> IO () + -- | bind the buffer object and fill it with null data + initialize :: a -> IO () - -- | expand the buffer to double of it's previous size. - expand :: a -> IO () + -- | fill the buffer with actual data + 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 - delete :: a -> IO () + -- | expand the buffer to double of it's previous size. + expand :: a -> IO () + + -- | free resources and delete the object + delete :: a -> IO () diff --git a/src/Scenes/Test.hs b/src/Scenes/Test.hs index 003201a..4ee60ac 100644 --- a/src/Scenes/Test.hs +++ b/src/Scenes/Test.hs @@ -18,7 +18,7 @@ import Linear import Types import Map -import Classes.Scene +import Classes data Test = Test { testMap :: TMVar LevelMap @@ -44,10 +44,9 @@ instance Scene Test where view = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0) model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0) - vertexArrayObject <- GL.genObjectName vertexArray <- newVertexArray - GL.bindVertexArrayObject $= Just vertexArrayObject + bind vertexArray void $ atomically $ do void $ takeTMVar progress diff --git a/src/Types/Graphics/IndexBuffer.hs b/src/Types/Graphics/IndexBuffer.hs index 88c8926..1cce439 100644 --- a/src/Types/Graphics/IndexBuffer.hs +++ b/src/Types/Graphics/IndexBuffer.hs @@ -5,6 +5,12 @@ import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) +import qualified Data.Vector.Storable as VS + +import Control.Monad.Loops (whileM_) + +import Control.Concurent.STM + import Foreign -- internal imports @@ -13,21 +19,23 @@ import Classes.Graphics.Bindable import Classes.Graphics.Buffer -- layout of the IndexBuffer data object -data IndexBuffer a = IndexBuffer - { iBufId :: GL.BufferObject -- buffer id - , iBufSize :: GL.GLsizeiptr -- size of data - , iBufData :: Ptr a -- pointer to data - , iBufCount :: GL.GLint -- number of data elements +data IndexBuffer = IndexBuffer + { iBufId :: TVar GL.BufferObject -- buffer id + , iBufSize :: TVar GL.GLsizeiptr -- size of data + -- , iBufData :: Ptr a -- pointer to data + -- , iBufCount :: GL.GLint -- number of data elements } --- instanciate typeclass from BufferClass and fill in missing implementations -instance Buffer (IndexBuffer a) where +-- instanciate typeclass from Buffer and fill in missing implementations +instance Buffer IndexBuffer where - type ObjName (IndexBuffer a) = GL.BufferObject + type StoreType IndexBuffer = GL.GLuint + + type StoreContainer IndexBuffer = VS.Vector target _ = GL.ElementArrayBuffer - glId = iBufId + glId = readTVarIO . iBufId initialize buf = do -- bind the buffer using the default iplementation of the typeclass @@ -35,12 +43,60 @@ instance Buffer (IndexBuffer a) where -- fill in the data GL.bufferData (target buf) $= ( iBufSize buf - , iBufData buf + , nullPtr , GL.DynamicDraw ) -- release the buffer using the default implementation of the typeclass 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 -- bind the buffer @@ -49,21 +105,20 @@ instance Bindable (IndexBuffer a) where -- unbind the buffer unbind buf = GL.bindBuffer (target buf) $= Nothing -newIndexBuffer :: - (Storable a) => -- we have to be able to get a pointer to provided data - [a] -> -- list of data elements - IO (IndexBuffer a) -- newly built IndexBuffer data object -newIndexBuffer list = do +newIndexBuffer + :: Word + -> IO IndexBuffer -- newly built IndexBuffer data object +newIndexBuffer initLength = do -- create the buffer object in applicative style buf <- IndexBuffer -- generate the ID <$> GL.genObjectName -- compute buffer size - <*> pure (fromIntegral (length list * sizeOf (head list))) - -- make pointer out of list - <*> newArray list - -- get count - <*> pure (fromIntegral $ length list) + <*> pure (fromIntegral initLength) + -- -- make pointer out of list + -- <*> newArray list + -- -- get count + -- <*> pure (fromIntegral $ length list) -- fill the data in to the buffer initialize buf -- return the data object diff --git a/src/Types/Graphics/VertexArray.hs b/src/Types/Graphics/VertexArray.hs index 2711715..c8fbab0 100644 --- a/src/Types/Graphics/VertexArray.hs +++ b/src/Types/Graphics/VertexArray.hs @@ -5,32 +5,27 @@ import qualified Graphics.Rendering.OpenGL as GL 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 import Classes.Graphics.Bindable import Classes.Graphics.Buffer +import Classes.Graphics.VertexLayout import Types.Graphics.VertexBuffer -data VertexArray = VertexArray +newtype VertexArray = VertexArray { vArrId :: GL.VertexArrayObject } deriving (Eq, Show) -instance Buffer VertexArray where - - type ObjName VertexArray = GL.VertexArrayObject - - target _ = undefined - - glId = return . vArrId - - initialize va = return () - - instance Bindable VertexArray where bind va = GL.bindVertexArrayObject $= Just (vArrId va) @@ -41,76 +36,39 @@ newVertexArray :: IO VertexArray newVertexArray = VertexArray <$> GL.genObjectName -addBuffer - :: (Buffer buf) - => VertexArray - -> buf - -> VertexBufferLayout - -> IO () -addBuffer va vb layout = do - -- bind the provided vertex buffer - 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 +instance VertexLayout Vertex where + + type VertArray Vertex = VertexArray + + layoutElements vert = + foldr + (\a@(index, count) acc -> + ( index , GL.VertexArrayDescriptor - -- number of components to our attribute count - -- datatype of elements - type_ - -- Stride (How big is one Vertex in bytes) - (vblStride layout) - -- offset from beginnning of vertex in bytes - (plusPtr nullPtr offset) + GL.Float + (fromIntegral $ sizeOf (undefined :: Vertex)) + (nullPtr `plusPtr` (sizeOf (undefined :: GL.GLfloat) * fromIntegral + (sum (map ((\(GL.VertexArrayDescriptor c _ _ _) -> c) . snd) acc)))) + ) : acc ) - ) - list - unbind va - unbind vb + [] + (zip [0 ..] [3, 4, 2, 1]) -data VertexBufferLayout = VertexBufferLayout - { vblElements :: MVar [VertexBufferLayoutElement] - , vblStride :: GL.GLsizei - } - -data VertexBufferLayoutElement = VertexBufferLayoutElement - { vbleIndex :: GL.GLuint - , vbleType :: GL.DataType - , vbleCount :: GL.GLint - , vbleOffset :: Int - , vbleHandling :: GL.IntegerHandling - } - -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 - ] + addBuffer vert va vb = do + -- bind vertex array and vertex buffer ot associate them + bind va + bind vb + -- enable and fill vertex attrib pointer(s) + let list = layoutElements vert + mapM_ + (\(index, descriptor) -> do + GL.vertexAttribArray (GL.AttribLocation index) $= GL.Enabled + GL.vertexAttribPointer (GL.AttribLocation index) $= + ( GL.ToNormalizedFloat + , descriptor + ) ) + list + unbind va + unbind vb diff --git a/src/Types/Graphics/VertexBuffer.hs b/src/Types/Graphics/VertexBuffer.hs index 25c1432..98364be 100644 --- a/src/Types/Graphics/VertexBuffer.hs +++ b/src/Types/Graphics/VertexBuffer.hs @@ -1,16 +1,22 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} module Types.Graphics.VertexBuffer where import qualified Graphics.Rendering.OpenGL as GL import SDL (($=), get) +import Control.Monad.Loops (whileM_) + import Control.Concurrent.STM +import qualified Data.Vector.Storable as VS + import Linear +import Foreign import Foreign import Foreign.C.Types import Foreign.Storable.Generic @@ -34,7 +40,6 @@ data Vertex = Vertex , vertColor :: V4 GL.GLfloat , vertTexCoord :: V2 GL.GLfloat , vertTexID :: GL.GLfloat - , vertSize :: GL.GLsizei } deriving (Generic) @@ -57,12 +62,13 @@ newVertex pos color texcoord index = color texcoord index - (fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat))) -- | Instanciate typeclass Buffer and fill in missing implementations instance Buffer VertexBuffer where - type ObjName VertexBuffer = GL.BufferObject + type StoreType VertexBuffer = Vertex + + type StoreContainer VertexBuffer = VS.Vector target _ = GL.ArrayBuffer @@ -81,7 +87,47 @@ instance Buffer VertexBuffer where -- release the buffer using the default implementation of the typeclass 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 -- old buffer is discarded and a new buffer allocated. expand buf = do @@ -118,9 +164,8 @@ instance Bindable VertexBuffer where -- | smart constructor for a VertexBuffer data object newVertexBuffer :: Word -- ^ initial Buffer size - -> Vertex -- ^ (empty) dummy vertex for determining buffer size -> 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 -- create the buffer object in applicative style buf <- VertexBuffer @@ -128,7 +173,7 @@ newVertexBuffer initSize dummyVertex = do <$> (newTVarIO =<< GL.genObjectName) -- compute buffer size <*> (newTVarIO (CPtrdiff (fromIntegral $ - fromIntegral initSize * vertSize dummyVertex))) + fromIntegral initSize * sizeOf (undefined :: StoreType VertexBuffer)))) -- make pointer out of list -- <*> newArray list -- fill the data in to the buffer