diff --git a/pituicat.cabal b/pituicat.cabal index 34463d9..88074e6 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -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 diff --git a/res/maps/00_test/00_test.bmp b/res/maps/00_test/00_test.bmp index 565eea8..203e49a 100644 Binary files a/res/maps/00_test/00_test.bmp and b/res/maps/00_test/00_test.bmp differ diff --git a/res/maps/00_test/00_test.kra b/res/maps/00_test/00_test.kra index 1a28659..2006d19 100644 Binary files a/res/maps/00_test/00_test.kra and b/res/maps/00_test/00_test.kra differ diff --git a/src/Classes.hs b/src/Classes.hs index ec1d9be..1668bd5 100644 --- a/src/Classes.hs +++ b/src/Classes.hs @@ -2,4 +2,4 @@ module Classes ( module C ) where -import Classes.Bindable as C +import Classes.Graphics as C diff --git a/src/Classes/Graphics.hs b/src/Classes/Graphics.hs new file mode 100644 index 0000000..baba09c --- /dev/null +++ b/src/Classes/Graphics.hs @@ -0,0 +1,5 @@ +module Classes.Graphics + ( module G + ) where + +import Classes.Graphics.Bindable as G diff --git a/src/Classes/Bindable.hs b/src/Classes/Graphics/Bindable.hs similarity index 84% rename from src/Classes/Bindable.hs rename to src/Classes/Graphics/Bindable.hs index a6c9b1c..e590b21 100644 --- a/src/Classes/Bindable.hs +++ b/src/Classes/Graphics/Bindable.hs @@ -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 diff --git a/src/Classes/Graphics/Buffer.hs b/src/Classes/Graphics/Buffer.hs new file mode 100644 index 0000000..46fe645 --- /dev/null +++ b/src/Classes/Graphics/Buffer.hs @@ -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 () diff --git a/src/Main.hs b/src/Main.hs index 622437c..6ab6d7b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -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 () diff --git a/src/Map.hs b/src/Map.hs index 9e6ea53..34fa4d9 100644 --- a/src/Map.hs +++ b/src/Map.hs @@ -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) diff --git a/src/State/MainGame/Load.hs b/src/State/MainGame/Load.hs index d92a5f7..b34d595 100644 --- a/src/State/MainGame/Load.hs +++ b/src/State/MainGame/Load.hs @@ -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 diff --git a/src/Texture.hs b/src/Texture.hs index fd14f42..052ab4c 100644 --- a/src/Texture.hs +++ b/src/Texture.hs @@ -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) diff --git a/src/Types.hs b/src/Types.hs index b42bb70..6ea5273 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -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 diff --git a/src/Types/Graphics.hs b/src/Types/Graphics.hs new file mode 100644 index 0000000..a703f30 --- /dev/null +++ b/src/Types/Graphics.hs @@ -0,0 +1,6 @@ +module Types.Graphics + ( module G + ) where + +import Types.Graphics.VertexArray as G +import Types.Graphics.VertexBuffer as G diff --git a/src/Types/Graphics/IndexBuffer.hs b/src/Types/Graphics/IndexBuffer.hs new file mode 100644 index 0000000..88c8926 --- /dev/null +++ b/src/Types/Graphics/IndexBuffer.hs @@ -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 diff --git a/src/Types/Graphics/VertexArray.hs b/src/Types/Graphics/VertexArray.hs new file mode 100644 index 0000000..df8dad9 --- /dev/null +++ b/src/Types/Graphics/VertexArray.hs @@ -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 + ] + ) diff --git a/src/Types/Graphics/VertexBuffer.hs b/src/Types/Graphics/VertexBuffer.hs new file mode 100644 index 0000000..dd38d69 --- /dev/null +++ b/src/Types/Graphics/VertexBuffer.hs @@ -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 diff --git a/src/Types/Texture.hs b/src/Types/Texture.hs index 486fdb0..e819acc 100644 --- a/src/Types/Texture.hs +++ b/src/Types/Texture.hs @@ -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