Browse Source

try out some freshly discovered magic tricks

master
nek0 1 year ago
parent
commit
de5e692305
  1. 3
      pituicat.cabal
  2. BIN
      res/tiles/00_test/00_test.kra
  3. 6
      shell.nix
  4. 27
      src/Classes/Graphics/Buffer.hs
  5. 4
      src/Types/GameMap.hs
  6. 2
      src/Types/Graphics/VertexArray.hs
  7. 70
      src/Types/Graphics/VertexBuffer.hs

3
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

BIN
res/tiles/00_test/00_test.kra

Binary file not shown.

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

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

4
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)

2
src/Types/Graphics/VertexArray.hs

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

70
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

Loading…
Cancel
Save