preparing for graphics
This commit is contained in:
parent
2e280d6e19
commit
00ac2ef5b2
|
@ -22,8 +22,13 @@ executable pituicat
|
||||||
, Types.Subsystems
|
, Types.Subsystems
|
||||||
, Types.GameMap
|
, Types.GameMap
|
||||||
, Types.Texture
|
, Types.Texture
|
||||||
|
, Types.Graphics
|
||||||
|
, Types.Graphics.VertexArray
|
||||||
|
, Types.Graphics.VertexBuffer
|
||||||
, Classes
|
, Classes
|
||||||
, Classes.Bindable
|
, Classes.Graphics
|
||||||
|
, Classes.Graphics.Bindable
|
||||||
|
, Classes.Graphics.Buffer
|
||||||
, State.Loading
|
, State.Loading
|
||||||
, State.Loading.Load
|
, State.Loading.Load
|
||||||
, State.Loading.Update
|
, State.Loading.Update
|
||||||
|
|
Binary file not shown.
Before Width: | Height: | Size: 12 KiB After Width: | Height: | Size: 12 KiB |
Binary file not shown.
|
@ -2,4 +2,4 @@ module Classes
|
||||||
( module C
|
( module C
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Classes.Bindable as C
|
import Classes.Graphics as C
|
||||||
|
|
5
src/Classes/Graphics.hs
Normal file
5
src/Classes/Graphics.hs
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
module Classes.Graphics
|
||||||
|
( module G
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Classes.Graphics.Bindable as G
|
|
@ -1,4 +1,4 @@
|
||||||
module Classes.Bindable where
|
module Classes.Graphics.Bindable where
|
||||||
|
|
||||||
-- | typeclass for bindable objects like buffers, vertex arrays or shaders
|
-- | typeclass for bindable objects like buffers, vertex arrays or shaders
|
||||||
class Bindable a where
|
class Bindable a where
|
26
src/Classes/Graphics/Buffer.hs
Normal file
26
src/Classes/Graphics/Buffer.hs
Normal 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 ()
|
11
src/Main.hs
11
src/Main.hs
|
@ -48,8 +48,15 @@ main = do
|
||||||
withAffection config
|
withAffection config
|
||||||
|
|
||||||
preLoad :: GameData -> Affection ()
|
preLoad :: GameData -> Affection ()
|
||||||
preLoad gd = do
|
preLoad gd =
|
||||||
liftIO $ atomically $ writeTVar (gameState gd) Loading
|
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 ()
|
handle :: GameData -> [SDL.EventPayload] -> Affection ()
|
||||||
|
|
23
src/Map.hs
23
src/Map.hs
|
@ -50,15 +50,20 @@ readLayer (idx, path) = do
|
||||||
img <- either error convertRGBA8 <$> readImage path
|
img <- either error convertRGBA8 <$> readImage path
|
||||||
let width = imageWidth img
|
let width = imageWidth img
|
||||||
height = imageHeight img
|
height = imageHeight img
|
||||||
layer = V.map
|
layer = V.foldl
|
||||||
(\(py, px) -> case (pixelAt img px py) of
|
(\acc (py, px) -> case (pixelAt img px py) of
|
||||||
(PixelRGBA8 r g b _) -> Tile
|
(PixelRGBA8 r g b _) -> if r >= 253
|
||||||
(V2 (255 - fromIntegral g) (255 - fromIntegral b))
|
then
|
||||||
(case r of
|
acc `V.snoc` Tile
|
||||||
255 -> Solid
|
(V2 (255 - fromIntegral g) (255 - fromIntegral b))
|
||||||
254 -> Platform
|
(case r of
|
||||||
_ -> Decoration
|
255 -> Solid
|
||||||
)
|
254 -> Platform
|
||||||
|
_ -> Decoration
|
||||||
|
)
|
||||||
|
else
|
||||||
|
acc
|
||||||
)
|
)
|
||||||
|
V.empty
|
||||||
(V.fromList ((,) <$> [0 .. height - 1] <*> [0 .. width - 1]))
|
(V.fromList ((,) <$> [0 .. height - 1] <*> [0 .. width - 1]))
|
||||||
return (MapLayer layer, V2 width height)
|
return (MapLayer layer, V2 width height)
|
||||||
|
|
|
@ -32,6 +32,7 @@ loadFork dataContainer progress = do
|
||||||
_ <- takeTMVar progress
|
_ <- takeTMVar progress
|
||||||
putTMVar progress (0, "Loading test level...")
|
putTMVar progress (0, "Loading test level...")
|
||||||
testData <- TestData <$> constructMap testLevelDesc 0
|
testData <- TestData <$> constructMap testLevelDesc 0
|
||||||
|
print testData
|
||||||
atomically $ do
|
atomically $ do
|
||||||
_ <- takeTMVar dataContainer
|
_ <- takeTMVar dataContainer
|
||||||
putTMVar dataContainer testData
|
putTMVar dataContainer testData
|
||||||
|
|
|
@ -16,7 +16,7 @@ import Foreign.Ptr
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Classes.Bindable
|
import Classes.Graphics.Bindable
|
||||||
import Types.Texture
|
import Types.Texture
|
||||||
|
|
||||||
newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture)
|
newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture)
|
||||||
|
|
|
@ -6,3 +6,4 @@ import Types.Application as T
|
||||||
import Types.Subsystems as T
|
import Types.Subsystems as T
|
||||||
import Types.GameMap as T
|
import Types.GameMap as T
|
||||||
import Types.Texture as T
|
import Types.Texture as T
|
||||||
|
import Types.Graphics as T
|
||||||
|
|
6
src/Types/Graphics.hs
Normal file
6
src/Types/Graphics.hs
Normal file
|
@ -0,0 +1,6 @@
|
||||||
|
module Types.Graphics
|
||||||
|
( module G
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Types.Graphics.VertexArray as G
|
||||||
|
import Types.Graphics.VertexBuffer as G
|
70
src/Types/Graphics/IndexBuffer.hs
Normal file
70
src/Types/Graphics/IndexBuffer.hs
Normal 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
|
116
src/Types/Graphics/VertexArray.hs
Normal file
116
src/Types/Graphics/VertexArray.hs
Normal 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
|
||||||
|
]
|
||||||
|
)
|
93
src/Types/Graphics/VertexBuffer.hs
Normal file
93
src/Types/Graphics/VertexBuffer.hs
Normal 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
|
|
@ -6,7 +6,7 @@ import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Classes.Bindable
|
import Classes.Graphics.Bindable
|
||||||
|
|
||||||
data Texture = Texture
|
data Texture = Texture
|
||||||
{ textureId :: GL.TextureObject
|
{ textureId :: GL.TextureObject
|
||||||
|
|
Loading…
Reference in a new issue