Browse Source

lots of plumbing to automate stuff

master
nek0 1 year ago
parent
commit
0fb10b0981
  1. 2
      pituicat.cabal
  2. 4
      shell.nix
  3. 2
      src/Classes/Graphics.hs
  4. 46
      src/Classes/Graphics/Buffer.hs
  5. 5
      src/Scenes/Test.hs
  6. 95
      src/Types/Graphics/IndexBuffer.hs
  7. 124
      src/Types/Graphics/VertexArray.hs
  8. 59
      src/Types/Graphics/VertexBuffer.hs

2
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

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

2
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

46
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
-- | datatype inside the buffer
type StoreType a :: *
type ObjName a :: *
-- | container datatype for 'StoreType's
type StoreContainer a :: * -> *
-- | what buffer target does the buffer bind to
target :: a -> GL.BufferTarget
-- | what buffer target does the buffer bind to
target :: a -> GL.BufferTarget
-- | retrieve ID from buffer object
glId :: a -> IO (ObjName a)
-- | retrieve ID from buffer object
glId :: a -> IO (GL.BufferObject)
-- | bind the buffer object and fill it with null data
initialize :: a -> IO ()
-- | 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 ()
-- | 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 ()
-- | expand the buffer to double of it's previous size.
expand :: a -> IO ()
-- | expand the buffer to double of it's previous size.
expand :: a -> IO ()
-- | free resources and delete the object
delete :: a -> IO ()
-- | free resources and delete the object
delete :: a -> IO ()

5
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

95
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

124
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
, 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)
)
)
list
unbind va
unbind vb
data VertexBufferLayout = VertexBufferLayout
{ vblElements :: MVar [VertexBufferLayoutElement]
, vblStride :: GL.GLsizei
}
instance VertexLayout Vertex where
data VertexBufferLayoutElement = VertexBufferLayoutElement
{ vbleIndex :: GL.GLuint
, vbleType :: GL.DataType
, vbleCount :: GL.GLint
, vbleOffset :: Int
, vbleHandling :: GL.IntegerHandling
}
type VertArray Vertex = VertexArray
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_
layoutElements vert =
foldr
(\a@(index, count) acc ->
( index
, GL.VertexArrayDescriptor
count
offset
GL.ToNormalizedFloat
]
GL.Float
(fromIntegral $ sizeOf (undefined :: Vertex))
(nullPtr `plusPtr` (sizeOf (undefined :: GL.GLfloat) * fromIntegral
(sum (map ((\(GL.VertexArrayDescriptor c _ _ _) -> c) . snd) acc))))
) : acc
)
[]
(zip [0 ..] [3, 4, 2, 1])
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

59
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

Loading…
Cancel
Save