This is a Haskell implementation of the ideas presented in [chapter two](http://duriansoftware.com/joe/An-intro-to-modern-OpenGL.-Chapter-2.1:-Buffers-and-Textures.html) of Joe Groff's excellent tutorial on modern OpenGL. This post is a complete program that relies on the [OpenGL](http://hackage.haskell.org/package/OpenGL) and [GLUT](http://hackage.haskell.org/package/GLUT) Haskell packages. It also makes use of some data files: - Textures: [hello1.tga](/PostData/GLTutorial/hello1.tga) and [hello2.tga](/PostData/GLTutorial/hello2.tga) - Shaders: [hello-gl.frag](/PostData/GLTutorial/hello-gl.frag) and [hello-gl.vert](/PostData/GLTutorial/hello-gl.vert) You may copy and paste this post into a `.lhs` file, or [download it](/PostData/GLTutorial/lesson3b.lhs). 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 > import System.FilePath (()) We use a very small [library for loading TGA images](/PostData/GLTutorial/TGA.hs)... > import TGA ... and a handy [utility library](http://github.com/acowley/GLUtil) 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 > , getProgram :: 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 VertexShader $ "shaders" "hello-gl.vert" > fs <- loadShader FragmentShader $ "shaders" "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 . ("images" )) > ["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 (getProgram (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