preparing for graphics

This commit is contained in:
nek0 2020-10-17 16:18:42 +02:00
parent 2e280d6e19
commit 00ac2ef5b2
17 changed files with 351 additions and 16 deletions

View file

@ -22,8 +22,13 @@ executable pituicat
, Types.Subsystems
, Types.GameMap
, Types.Texture
, Types.Graphics
, Types.Graphics.VertexArray
, Types.Graphics.VertexBuffer
, Classes
, Classes.Bindable
, Classes.Graphics
, Classes.Graphics.Bindable
, Classes.Graphics.Buffer
, State.Loading
, State.Loading.Load
, State.Loading.Update

Binary file not shown.

Before

Width:  |  Height:  |  Size: 12 KiB

After

Width:  |  Height:  |  Size: 12 KiB

Binary file not shown.

View file

@ -2,4 +2,4 @@ module Classes
( module C
) where
import Classes.Bindable as C
import Classes.Graphics as C

5
src/Classes/Graphics.hs Normal file
View file

@ -0,0 +1,5 @@
module Classes.Graphics
( module G
) where
import Classes.Graphics.Bindable as G

View file

@ -1,4 +1,4 @@
module Classes.Bindable where
module Classes.Graphics.Bindable where
-- | typeclass for bindable objects like buffers, vertex arrays or shaders
class Bindable a where

View file

@ -0,0 +1,26 @@
{-# LANGUAGE TypeFamilies #-}
module Classes.Graphics.Buffer where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
-- internal imports
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
class (Bindable a) => Buffer a where
type ObjName a :: *
-- what buffer target does te buffer bind to
target :: a -> GL.BufferTarget
-- what ID does the buffer have
glId :: a -> ObjName a
-- bind the buffer object and fill it with data
initialize :: a -> IO ()

View file

@ -48,8 +48,15 @@ main = do
withAffection config
preLoad :: GameData -> Affection ()
preLoad gd = do
liftIO $ atomically $ writeTVar (gameState gd) Loading
preLoad gd =
liftIO $ do
let projection = ortho 0 800 0 600 (-1) 1 :: M44 GL.GLfloat
view = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
model = mkTransformationMat (identity :: M33 GL.GLfloat) (V3 0 0 0)
vertexArrayObject <- GL.genObjectName
va <- newVertexArray
atomically $ writeTVar (gameState gd) Loading
handle :: GameData -> [SDL.EventPayload] -> Affection ()

View file

@ -50,15 +50,20 @@ readLayer (idx, path) = do
img <- either error convertRGBA8 <$> readImage path
let width = imageWidth img
height = imageHeight img
layer = V.map
(\(py, px) -> case (pixelAt img px py) of
(PixelRGBA8 r g b _) -> Tile
(V2 (255 - fromIntegral g) (255 - fromIntegral b))
(case r of
255 -> Solid
254 -> Platform
_ -> Decoration
)
layer = V.foldl
(\acc (py, px) -> case (pixelAt img px py) of
(PixelRGBA8 r g b _) -> if r >= 253
then
acc `V.snoc` Tile
(V2 (255 - fromIntegral g) (255 - fromIntegral b))
(case r of
255 -> Solid
254 -> Platform
_ -> Decoration
)
else
acc
)
V.empty
(V.fromList ((,) <$> [0 .. height - 1] <*> [0 .. width - 1]))
return (MapLayer layer, V2 width height)

View file

@ -32,6 +32,7 @@ loadFork dataContainer progress = do
_ <- takeTMVar progress
putTMVar progress (0, "Loading test level...")
testData <- TestData <$> constructMap testLevelDesc 0
print testData
atomically $ do
_ <- takeTMVar dataContainer
putTMVar dataContainer testData

View file

@ -16,7 +16,7 @@ import Foreign.Ptr
-- internal imports
import Classes.Bindable
import Classes.Graphics.Bindable
import Types.Texture
newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture)

View file

@ -6,3 +6,4 @@ import Types.Application as T
import Types.Subsystems as T
import Types.GameMap as T
import Types.Texture as T
import Types.Graphics as T

6
src/Types/Graphics.hs Normal file
View file

@ -0,0 +1,6 @@
module Types.Graphics
( module G
) where
import Types.Graphics.VertexArray as G
import Types.Graphics.VertexBuffer as G

View file

@ -0,0 +1,70 @@
{-# LANGUAGE TypeFamilies #-}
module Types.Graphics.IndexBuffer where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
import Foreign
-- internal imports
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
}
-- instanciate typeclass from BufferClass and fill in missing implementations
instance Buffer (IndexBuffer a) where
type ObjName (IndexBuffer a) = GL.BufferObject
target _ = GL.ElementArrayBuffer
glId = iBufId
initialize buf = do
-- bind the buffer using the default iplementation of the typeclass
bind buf
-- fill in the data
GL.bufferData (target buf) $=
( iBufSize buf
, iBufData buf
, GL.DynamicDraw
)
-- release the buffer using the default implementation of the typeclass
unbind buf
instance Bindable (IndexBuffer a) where
-- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- 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
-- 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)
-- fill the data in to the buffer
initialize buf
-- return the data object
return buf

View file

@ -0,0 +1,116 @@
{-# LANGUAGE TypeFamilies #-}
module Types.Graphics.VertexArray where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
import Foreign
import Control.Concurrent.MVar
-- internal imports
import Classes.Graphics.Bindable
import Classes.Graphics.Buffer
import Types.Graphics.VertexBuffer
data VertexArray = VertexArray
{ vArrId :: GL.VertexArrayObject
}
deriving (Eq, Show)
instance Buffer VertexArray where
type ObjName VertexArray = GL.VertexArrayObject
target _ = undefined
glId = vArrId
initialize va = return ()
instance Bindable VertexArray where
bind va = GL.bindVertexArrayObject $= Just (vArrId va)
unbind va = GL.bindVertexArrayObject $= Nothing
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
}
data VertexBufferLayoutElement = VertexBufferLayoutElement
{ vbleIndex :: GL.GLuint
, vbleType :: GL.DataType
, vbleCount :: GL.GLint
, vbleOffset :: Int
, vbleHandling :: GL.IntegerHandling
}
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
]
)

View file

@ -0,0 +1,93 @@
{-# LANGUAGE TypeFamilies #-}
module Types.Graphics.VertexBuffer where
import qualified Graphics.Rendering.OpenGL as GL
import SDL (($=), get)
import Linear
import Foreign
import Foreign.C.Types
-- internal imports
import Classes.Graphics.Bindable
import Classes.Graphics.Buffer
-- layout of the VertexBuffer data object
data VertexBuffer = VertexBuffer
{ vBufId :: GL.BufferObject -- buffer id
, vBufSize :: GL.GLsizeiptr -- size of data
-- , vBufData :: Ptr a -- pointer to data
}
data Vertex = Vertex
{ vertPosition :: V3 GL.GLfloat
, vertColor :: V4 GL.GLfloat
, vertTexCoord :: V2 GL.GLfloat
, vertTexID :: GL.GLfloat
, vertSize :: GL.GLsizei
}
-- | Smart constructor for a new Vertex
newVertex
:: V3 GL.GLfloat
-> V4 GL.GLfloat
-> V2 GL.GLfloat
-> GL.GLfloat
-> Vertex
newVertex pos color texcoord index =
Vertex
pos
color
texcoord
index
(fromIntegral $ 10 * (sizeOf (undefined :: GL.GLfloat)))
-- instanciate typeclass from BufferClass and fill in missing implementations
instance Buffer VertexBuffer where
type ObjName VertexBuffer = GL.BufferObject
target _ = GL.ArrayBuffer
glId = vBufId
initialize buf = do
-- bind the buffer using the default iplementation of the typeclass
bind buf
-- fill in the data
GL.bufferData (target buf) $=
( vBufSize buf
, nullPtr
, GL.DynamicDraw
)
-- release the buffer using the default implementation of the typeclass
unbind buf
instance Bindable VertexBuffer where
-- bind the buffer
bind buf = GL.bindBuffer (target buf) $= Just (glId buf)
-- unbind the buffer
unbind buf = GL.bindBuffer (target buf) $= Nothing
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
-- create the buffer object in applicative style
buf <- VertexBuffer
-- generate the ID
<$> GL.genObjectName
-- compute buffer size
<*> pure (CPtrdiff (fromIntegral $ 1024 * vertSize dummyVertex))
-- make pointer out of list
-- <*> newArray list
-- fill the data in to the buffer
initialize buf
-- return the data object
return buf

View file

@ -6,7 +6,7 @@ import qualified Graphics.Rendering.OpenGL as GL
-- internal imports
import Classes.Bindable
import Classes.Graphics.Bindable
data Texture = Texture
{ textureId :: GL.TextureObject