Skip to content
Browse files

Created VertexBuffer module which helps to load geometric data

into the GPU.

Created Geometry module. This module defines the Geometry
datatype, which holds the vertices, indices and vertex attributes
of a geometric entity. Also provided is a way of rendering
the geometry.

Created Triangle datatype, to exemplify the use of Geometry
in rendering.

Added triangle geometry to WorldState, since we need it in the
rendering callback.

Signed-off-by: Edward Tate <cmalune@gmail.com>
  • Loading branch information...
1 parent e0aeb4d commit a47666df45be0fc7a588efd95b9c3043dbafbeeb Edward Tate committed Jul 23, 2011
Showing with 119 additions and 18 deletions.
  1. +8 −18 Main.hs
  2. +41 −0 Resurrection/GL/VertexBuffer.hs
  3. +38 −0 Resurrection/Geometry.hs
  4. +32 −0 Resurrection/Geometry/Triangle.hs
View
26 Main.hs
@@ -21,6 +21,9 @@ import Data.StateVar (get)
import Resurrection.GL.Projection
import Resurrection.Window (windowSize, initWindow, defaultWindowState)
+import Resurrection.Geometry
+import Resurrection.Geometry.Triangle
+
------------------------------------------------------------------------------
-- | Initialize a font.
@@ -40,11 +43,12 @@ setWindowSize windowState s@(GLUT.Size w h) = do
set2dProjection w h
set3dProjection w h
-
+
------------------------------------------------------------------------------
-- |
data WorldState = WorldState {
- triangleAngle :: IORef GL.GLfloat
+ triangle :: Geometry
+ , triangleAngle :: IORef GL.GLfloat
, textAngle :: IORef GL.GLfloat
}
@@ -67,25 +71,10 @@ tick ws = do
------------------------------------------------------------------------------
-- |
-redColour :: GL.Color3 GL.GLfloat
-redColour = GL.Color3 1.0 0.0 0.0
-
-greenColour :: GL.Color3 GL.GLfloat
-greenColour = GL.Color3 0.0 1.0 0.0
-
-blueColour :: GL.Color3 GL.GLfloat
-blueColour = GL.Color3 0.0 0.0 1.0
-
renderTriangle ws = do
a <- get (triangleAngle ws)
GL.rotate a (GL.Vector3 (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (1.0 :: GL.GLfloat))
- GL.renderPrimitive GL.Triangles $ do
- GL.color redColour
- GL.vertex (GL.Vertex3 (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
- GL.color greenColour
- GL.vertex (GL.Vertex3 (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
- GL.color blueColour
- GL.vertex (GL.Vertex3 (1.0 :: GL.GLfloat) (1.0 :: GL.GLfloat) (0.0 :: GL.GLfloat))
+ renderGeometry (triangle ws)
------------------------------------------------------------------------------
@@ -129,6 +118,7 @@ main = do
font <- initFont "asset/font/cousine/regularLatin.ttf"
worldState <- WorldState <$>
+ makeTriangle <*>
newIORef 0.0 <*>
newIORef 0.0
View
41 Resurrection/GL/VertexBuffer.hs
@@ -0,0 +1,41 @@
+module Resurrection.GL.VertexBuffer
+ (
+ makeBuffer
+ , offsetPtr
+ , offset0
+ ) where
+
+
+import Graphics.Rendering.OpenGL
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.Storable
+import Data.Array.Storable
+
+
+------------------------------------------------------------------------------
+-- |
+makeBuffer target elts =
+ makeBufferLen target (length elts) elts
+
+
+------------------------------------------------------------------------------
+-- |
+makeBufferLen target len elts =
+ do [buffer] <- genObjectNames 1
+ bindBuffer target $= Just buffer
+ let n = fromIntegral $ len * sizeOf (head elts)
+ arr <- newListArray (0, len - 1) elts
+ withStorableArray arr $ \ ptr ->
+ bufferData target $= (n, ptr, StaticDraw)
+ return buffer
+
+
+------------------------------------------------------------------------------
+-- |
+offsetPtr = wordPtrToPtr . fromIntegral
+
+
+------------------------------------------------------------------------------
+-- |
+offset0 = offsetPtr 0
View
38 Resurrection/Geometry.hs
@@ -0,0 +1,38 @@
+module Resurrection.Geometry
+ (
+ Geometry(..)
+ , renderGeometry
+ ) where
+
+
+import Graphics.Rendering.OpenGL
+import Foreign.Storable
+import Resurrection.GL.VertexBuffer
+
+
+------------------------------------------------------------------------------
+-- |
+data Geometry = Geometry {
+ geometryPrimitiveMode :: PrimitiveMode
+ , geometryVertexBuffer :: BufferObject
+ , geometryVertexAttrib :: AttribLocation
+ , geometryElementBuffer :: BufferObject
+ }
+
+
+------------------------------------------------------------------------------
+-- |
+bindGeometry g =
+ let stride = fromIntegral $ sizeOf (undefined::GLfloat) * 2
+ vad = VertexArrayDescriptor 2 Float stride offset0 in
+ do bindBuffer ArrayBuffer $= Just (geometryVertexBuffer g)
+ vertexAttribPointer (geometryVertexAttrib g) $= (ToFloat, vad)
+ vertexAttribArray (geometryVertexAttrib g) $= Enabled
+
+
+------------------------------------------------------------------------------
+-- |
+renderGeometry g = do
+ bindGeometry g
+ bindBuffer ElementArrayBuffer $= Just (geometryElementBuffer g)
+ drawElements (geometryPrimitiveMode g) 4 UnsignedInt offset0
View
32 Resurrection/Geometry/Triangle.hs
@@ -0,0 +1,32 @@
+module Resurrection.Geometry.Triangle
+ (
+ makeTriangle
+ ) where
+
+
+import Control.Applicative ((<*>), pure)
+import Graphics.Rendering.OpenGL
+import Resurrection.GL.VertexBuffer
+import Resurrection.Geometry
+import Data.Functor ((<$>))
+
+
+------------------------------------------------------------------------------
+-- |
+triangleVertices :: [GLfloat]
+triangleVertices = [-0.5, -0.5, 0.5, -0.5, 0.0, 0.5]
+
+
+------------------------------------------------------------------------------
+-- |
+triangleIndices :: [GLuint]
+triangleIndices = [0..3]
+
+
+------------------------------------------------------------------------------
+-- |
+makeTriangle =
+ Geometry <$> pure TriangleStrip
+ <*> makeBuffer ArrayBuffer triangleVertices
+ <*> pure (AttribLocation 0)
+ <*> makeBuffer ElementArrayBuffer triangleIndices

0 comments on commit a47666d

Please sign in to comment.
Something went wrong with that request. Please try again.