Modern OpenGL with Haskell

July 18, 2013: See a newer article on modern OpenGL and Haskell for the current state of affairs of texture loading, geometry specification and loading, and GLSL binding.

This is a Haskell implementation of the ideas presented in chapter two of Joe Groff’s excellent tutorial on modern OpenGL.

This post is a complete program that relies on the OpenGL and GLUT Haskell packages. It also makes use of some data files (all available in the GLUtil repository):

You may copy and paste this post into a .lhs file, or download it.

We begin by importing the necessary libraries.

> import Graphics.Rendering.OpenGL
> import Graphics.UI.GLUT
> import Foreign.Storable (sizeOf)
> import Control.Concurrent (threadDelay)
> import Control.Applicative

We use a very small library for loading TGA images

> import TGA

… and a handy utility library for loading data into OpenGL.

> import Graphics.GLUtil

Optimism dictates that any exit is a successful exit.

> import System.Exit (exitWith, ExitCode(ExitSuccess))

Application state is shared between the rendering and animation functions with an IORef.

> import Data.IORef (IORef, newIORef, readIORef, modifyIORef)

We begin our program by defining the data structures used to carry program state between frames.

Shader state is a record of compiled shader programs, the uniform parameters to the shader, and an attribute accessed by the shader.

> data Shaders = Shaders { vertexShader   :: VertexShader
> , fragmentShader :: FragmentShader
> , program :: Program
> , fadeFactorU :: UniformLocation
> , texturesU :: [UniformLocation]
> , positionA :: AttribLocation }

Application state is carried in a record. State, in this case, is made up of some vertex data, some primitive data (e.g. polygons), two textures, shader state, and a scalar we use to fade between the two textures.

> data Resources = Resources { vertexBuffer  :: BufferObject
> , elementBuffer :: BufferObject
> , textures :: [TextureObject]
> , shaders :: Shaders
> , fadeFactor :: GLfloat }

The data that we actually want to render starts life as a list of 2D vertices,

> vertexBufferData :: [GLfloat]
> vertexBufferData = [-1, -1, 1, -1, -1, 1, 1, 1]

and a list of indices into that list,

> elementBufferData :: [GLuint]
> elementBufferData = [0..3]

Textures are prepared by loading them from disk, then setting various texture rendering modes.

> makeTexture :: FilePath -> IO TextureObject
> makeTexture filename =
> do (width,height,pixels) <- readTGA filename
> texture <- loadTexture $ texInfo width height TexBGR pixels

We set texturing parameters to linear filtering for minification and magnification, while disabling mip mapping. Texture wrapping is set to clamp both horizontally and vertically, S and T, respectively.

>        textureFilter   Texture2D   $= ((Linear', Nothing), Linear')
> textureWrapMode Texture2D S $= (Mirrored, ClampToEdge)
> textureWrapMode Texture2D T $= (Mirrored, ClampToEdge)
> return texture

Now we can load the data we want to render into OpenGL, and track it using our state record.

Shaders are prepared by loading and compiling the individual vertex and fragment shaders, then linking them into a program. We then query the program to get addresses for the uniform parameters and attribute that we will use to communicate data to the shader program.

> initShaders = do vs <- loadShader "hello-gl.vert"
> fs <- loadShader "hello-gl.frag"
> p <- linkShaderProgram [vs] [fs]
> Shaders vs fs p
> <$> get (uniformLocation p "fade_factor")
> <*> mapM (get . uniformLocation p)
> ["textures[0]", "textures[1]"]
> <*> get (attribLocation p "position")

Our global state record is prepared by creating the buffer objects for our vertex and index data, loading the image files to be used as textures, compiling the shader program, and initializing the fadeFactor field to zero.

> makeResources =  Resources
> <$> makeBuffer ArrayBuffer vertexBufferData
> <*> makeBuffer ElementArrayBuffer elementBufferData
> <*> mapM makeTexture ["hello1.tga", "hello2.tga"]
> <*> initShaders
> <*> pure 0.0

The interesting part of our program is the function that puts things on the screen.

One step in rendering is preparing the textures for our shaders. We do this by activating a texture unit, binding a texture object to the active texture unit, then setting the uniform sampler2D value in the fragment shader to refer to the correct texture unit.

> setupTexturing :: Resources -> IO ()
> setupTexturing r = let [t1, t2] = textures r
> [tu1, tu2] = texturesU (shaders r)
> in do activeTexture $= TextureUnit 0
> textureBinding Texture2D $= Just t1
> uniform tu1 $= Index1 (0::GLint)
> activeTexture $= TextureUnit 1
> textureBinding Texture2D $= Just t2
> uniform tu2 $= Index1 (1::GLint)

Geometry rendering begins by binding the buffer containing the vertex data and telling OpenGL how this data is formatted. In our case, each vertex has two floating point fields.

> setupGeometry :: Resources -> IO ()
> setupGeometry r = let posn = positionA (shaders r)
> stride = fromIntegral $ sizeOf (undefined::GLfloat) * 2
> vad = VertexArrayDescriptor 2 Float stride offset0
> in do bindBuffer ArrayBuffer $= Just (vertexBuffer r)
> vertexAttribPointer posn $= (ToFloat, vad)
> vertexAttribArray posn $= Enabled

Finally, drawing is effected by clearing the screen, setting the fadeFactor uniform parameter of our shader program, then drawing our textured geometry.

> draw :: IORef Resources -> IO ()
> draw r' = do clearColor $= Color4 1 1 1 1
> clear [ColorBuffer]
> r <- readIORef r'
> currentProgram $= Just (program (shaders r))
> uniform (fadeFactorU (shaders r)) $= Index1 (fadeFactor r)
> setupTexturing r
> setupGeometry r
> bindBuffer ElementArrayBuffer $= Just (elementBuffer r)
> drawElements TriangleStrip 4 UnsignedInt offset0
> swapBuffers

The only user interaction we support is exiting when the escape key is pressed.

> basicKMHandler :: Key -> KeyState -> Modifiers -> Position -> IO ()
> basicKMHandler (Char '\27') Down _ _ = exitWith ExitSuccess
> basicKMHandler _ _ _ _ = return ()

The animation callback limits itself to run at less than 100Hz, then sets the fade parameter carried in our application state based on elapsed time.

> animate :: IORef Resources -> IdleCallback
> animate r = do threadDelay 10000
> milliseconds <- fromIntegral <$> get elapsedTime
> let fade = sin (milliseconds * 0.001) * 0.5 + 0.5
> modifyIORef r (\x -> x { fadeFactor = fade })
> postRedisplay Nothing

Finally, kick GLUT off to open our window and start things going.

> main = do initialDisplayMode $= [DoubleBuffered]
> initialWindowSize $= Size 500 500
> (progname,_) <- getArgsAndInitialize
> createWindow "Chapter 2"
> r <- makeResources >>= newIORef
> displayCallback $= draw r
> idleCallback $= Just (animate r)
> keyboardMouseCallback $= Just basicKMHandler
> mainLoop

2 thoughts on “Modern OpenGL with Haskell

  1. Hi,

    Nice article. However, several screenshots would have increased its quality.

    I know, I can take the code and run it but if I have some wrong library then it won’t work. And instead of thinking that I’m wrong, as an average joe programmer, I’ll think that there’s a mistake in the code. By seeing a screenshot, I will think that this code should work.

  2. @Mihai Maruseac
    That?s a good point, Mihai!

    This article isn?t, on its own merits, a very good tutorial on graphics in general or OpenGL in particular. For more verbiage on such matters, I encourage readers to check out Joe Groff?s linked tutorial. This is just a port of his code to demonstrate the techniques in Haskell. His tutorial even includes a screenshot of the final product, which looks the same no matter what programming language is used!

Comments are closed.