try out some freshly discovered magic tricks

This commit is contained in:
nek0 2020-12-04 05:22:56 +01:00
parent 171f71180f
commit de5e692305
7 changed files with 85 additions and 27 deletions

View File

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

Binary file not shown.

View File

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

View File

@ -9,18 +9,31 @@ import SDL (($=), get)
import Classes.Graphics.Bindable 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. -- 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) => Buffer a where
type ObjName a :: * type ObjName a :: *
-- what buffer target does te buffer bind to -- | what buffer target does the buffer bind to
target :: a -> GL.BufferTarget target :: a -> GL.BufferTarget
-- what ID does the buffer have -- | retrieve ID from buffer object
glId :: a -> ObjName a 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 () 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 ()

View File

@ -23,7 +23,7 @@ newtype MapLayer = MapLayer
deriving (Eq, Show) deriving (Eq, Show)
data Tile = Tile 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 , tileType :: TileType -- | Type of tile
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -36,7 +36,7 @@ data TileType
data TileMap = TileMap data TileMap = TileMap
{ tileMapDimensions :: V2 Word -- | Dimensions of tile map image in pixels { 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) deriving (Eq, Show)

View File

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

View File

@ -1,24 +1,31 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
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.Concurrent.STM
import Linear import Linear
import Foreign import Foreign
import Foreign.C.Types import Foreign.C.Types
import Foreign.Storable.Generic
import GHC.Generics
-- internal imports -- internal imports
import Classes.Graphics.Bindable import Classes.Graphics.Bindable
import Classes.Graphics.Buffer import Classes.Graphics.Buffer
-- layout of the VertexBuffer data object -- | layout of the VertexBuffer data object
data VertexBuffer = VertexBuffer data VertexBuffer = VertexBuffer
{ vBufId :: GL.BufferObject -- buffer id { vBufId :: TVar GL.BufferObject -- ^ buffer id
, vBufSize :: GL.GLsizeiptr -- size of data , vBufSize :: TVar GL.GLsizeiptr -- ^ size of data
-- , vBufData :: Ptr a -- pointer to data -- , vBufData :: Ptr a -- pointer to data
} }
@ -29,6 +36,13 @@ data Vertex = Vertex
, vertTexID :: GL.GLfloat , vertTexID :: GL.GLfloat
, vertSize :: GL.GLsizei , 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 -- | Smart constructor for a new Vertex
newVertex newVertex
@ -45,46 +59,76 @@ newVertex pos color texcoord index =
index index
(fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat))) (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 instance Buffer VertexBuffer where
type ObjName VertexBuffer = GL.BufferObject type ObjName VertexBuffer = GL.BufferObject
target _ = GL.ArrayBuffer target _ = GL.ArrayBuffer
glId = vBufId glId = readTVarIO . vBufId
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
bind buf bind buf
size <- readTVarIO (vBufSize buf)
-- fill in the data -- fill in the data
GL.bufferData (target buf) $= GL.bufferData (target buf) $=
( vBufSize buf ( size
, nullPtr , 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
-- | 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 instance Bindable VertexBuffer where
-- bind the buffer -- 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 the buffer
unbind buf = GL.bindBuffer (target buf) $= Nothing unbind buf =
GL.bindBuffer (target buf) $= Nothing
-- | smart constructor for a VertexBuffer data object
newVertexBuffer newVertexBuffer
:: IO VertexBuffer -- newly built VertexBuffer data object :: Word -- ^ initial Buffer size
newVertexBuffer = do -> Vertex -- ^ (empty) dummy vertex for determining buffer size
let dummyVertex = newVertex (V3 0 0 0) (V4 0 0 0 0) (V2 0 0) 0 -> 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 -- create the buffer object in applicative style
buf <- VertexBuffer buf <- VertexBuffer
-- generate the ID -- generate the ID
<$> GL.genObjectName <$> (newTVarIO =<< GL.genObjectName)
-- compute buffer size -- compute buffer size
<*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex)) <*> (newTVarIO (CPtrdiff (fromIntegral $
fromIntegral initSize * vertSize dummyVertex)))
-- 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