lots of plumbing to automate stuff

This commit is contained in:
nek0 2020-12-05 10:10:37 +01:00
parent de5e692305
commit 0fb10b0981
8 changed files with 203 additions and 132 deletions

View File

@ -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

View File

@ -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";

View File

@ -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

View File

@ -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 ()

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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