diff --git a/pituicat.cabal b/pituicat.cabal index 81c5033..b43f795 100644 --- a/pituicat.cabal +++ b/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 diff --git a/res/tiles/00_test/00_test.kra b/res/tiles/00_test/00_test.kra index 882c1ff..1050d7a 100644 Binary files a/res/tiles/00_test/00_test.kra and b/res/tiles/00_test/00_test.kra differ diff --git a/shell.nix b/shell.nix index 49ed0a9..7a6ef85 100644 --- a/shell.nix +++ b/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"; diff --git a/src/Classes/Graphics/Buffer.hs b/src/Classes/Graphics/Buffer.hs index 46fe645..ae620c8 100644 --- a/src/Classes/Graphics/Buffer.hs +++ b/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 () diff --git a/src/Types/GameMap.hs b/src/Types/GameMap.hs index 13b96ab..d10a2f2 100644 --- a/src/Types/GameMap.hs +++ b/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) diff --git a/src/Types/Graphics/VertexArray.hs b/src/Types/Graphics/VertexArray.hs index df8dad9..2711715 100644 --- a/src/Types/Graphics/VertexArray.hs +++ b/src/Types/Graphics/VertexArray.hs @@ -26,7 +26,7 @@ instance Buffer VertexArray where target _ = undefined - glId = vArrId + glId = return . vArrId initialize va = return () diff --git a/src/Types/Graphics/VertexBuffer.hs b/src/Types/Graphics/VertexBuffer.hs index dd38d69..25c1432 100644 --- a/src/Types/Graphics/VertexBuffer.hs +++ b/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