try out some freshly discovered magic tricks

pituicat.cabal

@@ -44,7 +44,7 @@ executable pituicat
                      , StateMachine
                      , Texture
   -- other-extensions:
-  build-depends:       base ^>=4.13.0.0
+  build-depends:       base >=4.13.0.0
                      , affection
                      , stm
                      , OpenGL
@@ -58,5 +58,6 @@ executable pituicat
                      , JuicyPixels
                      , JuicyPixels-extra
                      , bytestring
+                     , derive-storable
   hs-source-dirs:      src
   default-language:    Haskell2010

shell.nix

@@ -25,9 +25,9 @@ let
       license = stdenv.lib.licenses.lgpl3;
     }) {};
 
-  f = { mkDerivation, aeson, base, bytestring, containers, JuicyPixels
-      , JuicyPixels-extra, linear, OpenGL, OpenGLRaw, stdenv , sdl2, stm, text
-      , vector}:
+  f = { mkDerivation, aeson, base, bytestring, containers, derive-storable
+      , JuicyPixels, JuicyPixels-extra, linear, OpenGL, OpenGLRaw, stdenv
+      , sdl2, stm, text, vector}:
       mkDerivation {
         pname = "pituicat";
         version = "0.0.0.0";

src/Classes/Graphics/Buffer.hs

@@ -9,18 +9,31 @@ import SDL (($=), get)
 
 import Classes.Graphics.Bindable
 
--- this aims to be a typeclass for all used buffer objects throughout the
--- game.
--- think of it as some kind of interface in the object oriented context
+-- | 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
 
   type ObjName a :: *
 
-  -- what buffer target does te buffer bind to
+  -- | what buffer target does the buffer bind to
   target :: a -> GL.BufferTarget
 
-  -- what ID does the buffer have
-  glId :: a -> ObjName a
+  -- | retrieve ID from buffer object
+  glId :: a -> IO (ObjName a)
 
-  -- bind the buffer object and fill it with data
+  -- | bind the buffer object and fill it with null data
   initialize :: a -> IO ()
+
+  -- | fill the buffer with actual data
+  write
+    :: 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.
+  expand :: a -> IO ()
+
+  -- | free resources and delete the object
+  delete :: a -> IO ()

src/Types/GameMap.hs

@@ -23,7 +23,7 @@ newtype MapLayer = MapLayer
   deriving (Eq, Show)
 
 data Tile = Tile
-  { tileOffset :: V2 Word -- | Offset of this tile on the tile map
+  { tileOffset :: V2 Word  -- | Offset of this tile on the tile map
   , tileType   :: TileType -- | Type of tile
   }
   deriving (Eq, Show)
@@ -36,7 +36,7 @@ data TileType
 
 data TileMap = TileMap
   { tileMapDimensions :: V2 Word  -- | Dimensions of tile map image in pixels
-  , tileMapTecture    :: Texture  -- | Texture object on GPU
+  , tileMapTexture    :: Texture  -- | Texture object on GPU
   }
   deriving (Eq, Show)
 

src/Types/Graphics/VertexArray.hs

@@ -26,7 +26,7 @@ instance Buffer VertexArray where
 
   target _ = undefined
 
-  glId = vArrId
+  glId = return . vArrId
 
   initialize va = return ()
 

src/Types/Graphics/VertexBuffer.hs

@@ -1,24 +1,31 @@
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
 module Types.Graphics.VertexBuffer where
 
 import qualified Graphics.Rendering.OpenGL as GL
 
 import SDL (($=), get)
 
+import Control.Concurrent.STM
+
 import Linear
 
 import Foreign
 import Foreign.C.Types
+import Foreign.Storable.Generic
+
+import GHC.Generics
 
 -- internal imports
 
 import Classes.Graphics.Bindable
 import Classes.Graphics.Buffer
 
--- layout of the VertexBuffer data object
+-- | layout of the VertexBuffer data object
 data VertexBuffer = VertexBuffer
-  { vBufId   :: GL.BufferObject -- buffer id
-  , vBufSize :: GL.GLsizeiptr   -- size of data
+  { vBufId   :: TVar GL.BufferObject -- ^ buffer id
+  , vBufSize :: TVar GL.GLsizeiptr   -- ^ size of data
   -- , vBufData :: Ptr a           -- pointer to data
   }
 
@@ -29,6 +36,13 @@ data Vertex = Vertex
   , vertTexID    :: GL.GLfloat
   , vertSize     :: GL.GLsizei
   }
+  deriving (Generic)
+
+-- | make vertices instances of 'Storable'. it's a kind of magic ^.^
+instance GStorable Vertex
+instance GStorable (V2 GL.GLfloat)
+instance GStorable (V3 GL.GLfloat)
+instance GStorable (V4 GL.GLfloat)
 
 -- | Smart constructor for a new Vertex
 newVertex
@@ -45,46 +59,76 @@ newVertex pos color texcoord index =
     index
     (fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat)))
 
--- instanciate typeclass from BufferClass and fill in missing implementations
+-- | Instanciate typeclass Buffer and fill in missing implementations
 instance Buffer VertexBuffer where
 
   type ObjName VertexBuffer = GL.BufferObject
 
   target _ = GL.ArrayBuffer
 
-  glId = vBufId
+  glId = readTVarIO . vBufId
 
   initialize buf = do
     -- bind the buffer using the default iplementation of the typeclass
     bind buf
+    size <- readTVarIO (vBufSize buf)
     -- fill in the data
     GL.bufferData (target buf) $=
-      ( vBufSize buf
+      ( size
       , nullPtr
       , GL.DynamicDraw
       )
     -- release the buffer using the default implementation of the typeclass
     unbind buf
 
+  -- | 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
+    -- unbind the buffer before meddling with its innards
+    unbind buf
+    -- free the old buffer
+    delete buf
+    -- generate new buffer
+    newId <- GL.genObjectName
+    -- calculate new size
+    newSize <- (2 *) <$> readTVarIO (vBufSize buf)
+    -- update data object
+    atomically $ do
+      writeTVar (vBufId buf) newId
+      writeTVar (vBufSize buf) newSize
+    -- allocate and fill buffer with null data
+    initialize buf
 
+  delete buf = do
+    unbind buf
+    GL.deleteObjectName =<< (readTVarIO $ vBufId buf)
+
+-- | Instanciate Bindable typeclass required by Buffer typeclass implement it
 instance Bindable VertexBuffer where
 
   -- bind the buffer
-  bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
+  bind buf =
+    (\a -> GL.bindBuffer (target buf) $= Just a) =<< glId buf
 
   -- unbind the buffer
-  unbind buf = GL.bindBuffer (target buf) $= Nothing
+  unbind buf =
+    GL.bindBuffer (target buf) $= Nothing
 
+-- | smart constructor for a VertexBuffer data object
 newVertexBuffer
-  :: IO VertexBuffer  -- newly built VertexBuffer data object
-newVertexBuffer = do
-  let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0
+  :: Word             -- ^ initial Buffer size
+  -> Vertex           -- ^ (empty) dummy vertex for determining buffer size
+  -> IO VertexBuffer  -- ^ newly built VertexBuffer data object
+newVertexBuffer initSize dummyVertex = 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
     -- generate the ID
-    <$> GL.genObjectName
+    <$> (newTVarIO =<< GL.genObjectName)
     -- compute buffer size
-    <*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex))
+    <*> (newTVarIO (CPtrdiff (fromIntegral $
+      fromIntegral initSize * vertSize dummyVertex)))
     -- make pointer out of list
     -- <*> newArray list
   -- fill the data in to the buffer