preparing for graphics

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

src/Classes.hs

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

src/Classes/Graphics.hs

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

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

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

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

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)

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

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)

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

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

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

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
+        ]
+        )

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

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