lowgl-0.3.1.0: Basic gl wrapper and reference

Safe HaskellNone
LanguageHaskell2010

Graphics.GL.Low

Contents

Description

Basic low-level GL wrapper and reference.

Synopsis

Overview

OpenGL is a graphics rendering interface. This library exposes a vastly simplified subset of OpenGL that is hopefully still complete enough for many purposes, such as following tutorials, making simple games, and demos. In particular the intention is to concentrate on a subset of OpenGL 3.2 (Core Profile) roughly corresponding to ES 2.0.

A second primary purpose is to document the complex model behind the interface in a way that is more elaborate than tutorials and more concise than the spec. As such, this is an experimental project to aid my own process of understanding OpenGL. It seems that understanding the entire picture up-front is the only way to get started, so this should also serve as a quick reference guide to the core commands and concepts.

This library uses the gl package for raw bindings to OpenGL and the linear package for matrices.

Example

The hello world program shows a white triangle on a black background. It uses the packages `GLFW-b' and `monad-loops'. Note that it forces a 3.2 core profile when setting up the context through GLFW.

module Main where

import Control.Monad.Loops (whileM_)
import Data.Functor ((<$>))
import qualified Data.Vector.Storable as V

import qualified Graphics.UI.GLFW as GLFW
import Graphics.GL.Low

-- GLFW will be the shell of the demo
main = do
  GLFW.init
  GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 3)
  GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 2)
  GLFW.windowHint (GLFW.WindowHint'OpenGLForwardCompat True)
  GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core)
  mwin <- GLFW.createWindow 640 480 "Hello World" Nothing Nothing
  case mwin of
    Nothing  -> putStrLn "createWindow failed"
    Just win -> do
      GLFW.makeContextCurrent (Just win)
      GLFW.swapInterval 1
      (vao, prog) <- setup -- load and configure objects
      whileM_ (not <$> GLFW.windowShouldClose win) $ do
        GLFW.pollEvents
        draw vao prog -- render
        GLFW.swapBuffers win

setup = do
  -- establish a VAO
  vao <- newVAO
  bindVAO vao
  -- load shader program
  vsource <- readFile "hello.vert"
  fsource <- readFile "hello.frag"
  prog <- newProgram vsource fsource
  useProgram prog
  -- load vertex data: three 2D vertex positions
  let blob = V.fromList
        [ -0.5, -0.5
        ,    0,  0.5
        ,  0.5, -0.5 ] :: V.Vector Float
  vbo <- newVBO blob StaticDraw
  bindVBO vbo
  -- connect program to vertex data via the VAO
  setVertexLayout [Attrib "position" 2 GLFloat]
  return (vao, prog)

draw vao prog = do
  clearColorBuffer (0,0,0)
  bindVAO vao
  useProgram prog
  drawTriangles 3

The vertex shader file looks like

#version 150

in vec2 position;

void main()
{
   gl_Position = vec4(position, 0.0, 1.0);
}

And the corresponding fragment shader file

#version 150

out vec4 outColor;

void main()
{
  outColor = vec4(1.0, 1.0, 1.0, 1.0);
}

And the output should look like

OpenGL API Basically

The spec for OpenGL 3.2 is actually quite readable and is worth reviewing. The following is my synopsis of things which roughly coincide with the simplified OpenGL ES 2.0.

Objects

Objects may be created and destroyed by client code. They include:

Binding Targets

Objects are referenced with integers (called names in GL), so binding targets can be thought of as global variables to put those references. Many operations implicitly read from these globals to determine what the target object of the operation is. They include:

  • Vertex array binding target (for VAO)
  • Buffer binding targets (ARRAY_BUFFER and ELEMENT_ARRAY_BUFFER)
  • Texture binding targets (TEXTURE_2D and TEXTURE_CUBE_MAP)
  • Framebuffer binding target (for FBO)

(not binding targets but similar)

  • Shader program "in use"
  • Texture units
  • Current active texture unit
  • Image attachment points of an FBO

Shader Programs

VAO

The VAO is essential. At least one VAO must be created and bound to the vertex array binding target before rendering, before configuring a program's vertex attributes. Here is why: the VAO stores the association between vertex inputs in the program and a VBO from which to pipe input from. It also stores the format of the VBO data, which is otherwise just a big blob. Finally, the VAO stores the state of the element array binding target used for indexed rendering.

After installing a program with useProgram and binding a source VBO to the array buffer binding target (bindVBO) then the bound VAO can be updated (setVertexLayout) with new vertex attribute information. After this, the VBO can be rebound to configure a different set of inputs with a different source. Many VAOs can be created and swapped out to pipe vertex data in different ways to different programs (or the same program).

When a VAO is bound (bindVAO) it restores the state of the element array binding target. For this reason you can think of that binding target as simply being a function of the VAO itself rather than a separate global state.

Uniforms and Samplers (Textures)

Programs may also have uniform variables and "sampler uniforms" as input. Uniforms are accessible from the vertex or fragment shader part of the program but their values are fixed during the course of a rendering command. They can be set and reset with the setUniform family (ex. setUniform1f), which updates the current program object with new uniform values. Among other things, updating the uniforms each frame is the main way to animate a scene.

Samplers are textures that the shader can interpolate to get "in between" values. The texture a sampler uses is determined by the contents of the texture unit that that sampler points to. The sampler is a uniform with an integer type. This integer is the texture unit to use. The word texture should not be construed to mean a color image. Shaders can make use of many kinds of multi-dimensional data that happen to be available through the samplers.

Texture Objects and Texture Units

Before a shader can use a texture it must be assigned to a texture unit. First set the active texture unit to the desired unit number (setActiveTextureUnit) then bind the texture object to one of the two texture binding targets, depending on what kind of texture it is (2D or cubemap). Binding a texture has the side effect of assigning it to the active texture unit.

Custom Framebuffers

It is possible (and important in many techniques) to utilize an off-screen render target. To do this create an FBO (newFBO), bind it to the framebuffer binding target (bindFramebuffer) and attach a color image object (texture or renderbuffer object). If necessary a depth image or combination depth-stencil image can be attached as well. If no color image is attached then the FBO is incomplete and rendering will be an error. After rendering to an FBO any textures that were attached can be used in a second pass by assigning them to a texture unit. Watch out for feedback loops accidentally sampling a texture that is also being rendered to at the same time!

A renderbuffer object is a minor character to be used when you do not expect to use the results of rendering but need an image anyway. For example you may need a depth buffer to do depth testing, or you may want to ignore the (required for rendering to work at all) color buffer.

Images and Image Formats

FBOs have attachment points for images. A texture serves as an image and a renderbuffer object serves as an image. Images have an "internal format" which describes the size and interpretation of pixel components. There are seven internal formats, five of which are color image formats such as grayscale and RGB. The other two are the depth buffer format and the combination depth-stencil format. RBOs (newRBO) and empty textures (newEmptyTexture2D, newEmptyCubeMap) can be created with any of these formats.

(The above is a gross simplification of OpenGL's image formats. I should probably revise, because it may greatly improve performance to use some of the 16-bit color formats rather than 32. Also HDR color format.)

Depth Testing and Stencil Testing

The depth test and stencil test use extra buffers in parallel with the color buffer to cause regions of pixels to not show. It does this by making a comparison between the depth each pixel and the value present in those buffers, then updating the buffers as necessary. The stencil test in particular has many configurable options. See the respective modules for the Graphics.GL.Low.Depth and Graphics.GL.Low.Stencil tests.

Scissor Test

The scissor test, if enabled (enableScissorTest), disallows all rendering outside of a rectangle region of the window called the scissor box.

Coordinate Systems (Mappings)

There are three transformation mechanisms which work together to get raw vertex data from VBOs to rasterized primitives somewhere on the window. You can imagine four coordinate systems between these three transformations if you want to.

  • The vertex shader takes vertex positions as specified in vertex attributes to clip space. This is how the client code specifies a camera, movement of objects, and perspective.
  • The perspective division or "W-divide" takes vertices from clip space and maps them to normalized device coordinates (NDC) by dividing all the components of the vertex by that vertex's W component. This allows a perspective effect to be accomplished in the shader by modifying the W components. You can't configure this W-division; it just happens. Note that if W = 1 for all vertices then this step has no effect. This is useful for orthographic projections. The resulting geometry will be clipped to a 2x2x2 cube centered around the origin. You can think of an XY plane of this cube as the viewport of the final 2D image.
  • The configurable viewport transformation (setViewport) will then position the viewport somewhere in the window. This step is necessary because your window is probably not a 2x2 square. The viewport transformation is configured by specifying a rectangular region of your window where you want the image to map to. The default setting for this is to fill the entire window with the viewport. If you didn't previously account for your aspect ratio then this will have the effect of squishing the scene, so you need to compensate in the vertex shader.

Rendering Points, Lines, and Triangles

The draw family (ex. drawTriangles) of commands commissions the rendering of a certain number of vertices worth of primitives. The current program will get input from the current VAO, the current texture units, and execute on all the potentially affected pixels in the current framebuffer. Vertexes are consumed in the order they appear in their respective source VBOs. If the VAO is missing, the program is missing, or the current framebuffer has no color attachment, then rendering will not work.

The drawIndexed family (ex. drawIndexedTriangles) of commands carries out the same effects as the non-indexed rendering commands but traverses vertices in an order determined by the sequence of indexes packed in the ElementArray currently bound to the element array binding target. This mainly allows a huge reuse of vertex data in the case that the object being rendered forms a closed mesh.

VAO

newVAO :: IO VAO Source

Create a new VAO. The only thing you can do with a VAO is bind it to the vertex array binding target.

bindVAO :: VAO -> IO () Source

Assign the VAO to the vertex array binding target. The VAO already bound will be replaced, if any.

deleteVAO :: VAO -> IO () Source

Delete a VAO.

data VAO Source

Handle to a VAO.

Instances

Buffer Objects

newVBO :: Storable a => Vector a -> UsageHint -> IO VBO Source

Create a buffer object from a blob of bytes. The usage argument hints at how often you will modify the data.

newElementArray :: Storable a => Vector a -> UsageHint -> IO ElementArray Source

Create a new ElementArray buffer object from the blob of packed indices. The usage argument hints at how often you plan to modify the data.

bindVBO :: VBO -> IO () Source

Bind a VBO to the array buffer binding target. The buffer object bound there will be replaced, if any.

bindElementArray :: ElementArray -> IO () Source

Assign an ElementArray to the element array binding target. It will replace the ElementArray already bound there, if any. Note that the state of the element array binding target is a function of the current VAO.

updateVBO :: Storable a => Vector a -> Int -> IO () Source

Modify the data in the currently bound VBO starting from the specified index in bytes.

updateElementArray :: Storable a => Vector a -> Int -> IO () Source

Modify contents in the currently bound ElementArray starting at the specified index in bytes.

deleteBufferObject :: BufferObject a => a -> IO () Source

Delete a VBO or ElementArray.

data VBO Source

Handle to a VBO.

data ElementArray Source

Handle to an element array buffer object.

data UsageHint Source

Usage hint for allocation of buffer object storage.

Constructors

StaticDraw

Data will seldomly change.

DynamicDraw

Data will change.

StreamDraw

Data will change very often.

Shader Program

newProgram Source

Arguments

:: String

vertex shader source code

-> String

fragment shader source code

-> IO Program 

Compile the code for a vertex shader and a fragment shader, then link them into a new program. If the compiler or linker fails it will throw a ProgramError.

newProgramSafe :: String -> String -> IO (Either ProgramError Program) Source

Same as newProgram but does not throw exceptions.

useProgram :: Program -> IO () Source

Install a program into the rendering pipeline. Replaces the program already in use, if any.

deleteProgram :: Program -> IO () Source

Delete a program.

data Program Source

Handle to a shader program.

Instances

data ProgramError Source

The error message emitted by the driver when shader compilation or linkage fails.

Vertex Attributes

setVertexLayout :: [VertexLayout] -> IO () Source

This configures the currently bound VAO. It calls glVertexAttribPointer and glEnableVertexAttribArray.

data VertexLayout Source

The name of a vertex input to a program combined with the component format and number of components for that attribute in the vertex data. Alternatively the size of an unused section of the data in bytes.

Constructors

Attrib String Int DataType

Name, component count and component format of a vertex attribute.

Unused Int

Size in bytes of an unused section of the vertex data.

Instances

data DataType Source

The size and interpretation of a vertex attribute component.

Constructors

GLFloat

4-byte float

GLByte

signed byte

GLUnsignedByte

unsigned byte

GLShort

2-byte signed integer

GLUnsignedShort

2-byte unsigned integer

GLInt

4-byte signed integer

GLUnsignedInt

4-byte unsigned integer

Textures

newTexture2D :: (Storable a, InternalFormat b) => Vector a -> Dimensions -> IO (Tex2D b) Source

Create a new 2D texture from a blob and its dimensions. Dimensions should be powers of two. The internal format type determines how the data is interpreted.

newCubeMap :: (Storable a, InternalFormat b) => Cube (Vector a, Dimensions) -> IO (CubeMap b) Source

Create a new cube map texture from six blobs and their respective dimensions. Dimensions should be powers of two.

newEmptyTexture2D :: InternalFormat a => Int -> Int -> IO (Tex2D a) Source

Create an empty texture with the specified dimensions and format.

newEmptyCubeMap :: InternalFormat a => Int -> Int -> IO (CubeMap a) Source

Create a cubemap texture where each of the six sides has the specified dimensions and format.

deleteTexture :: Texture a => a -> IO () Source

Delete a texture.

setActiveTextureUnit :: Enum a => a -> IO () Source

Set the active texture unit. The default is zero.

bindTexture2D :: Tex2D a -> IO () Source

Bind a 2D texture to the 2D texture binding target and the currently active texture unit.

bindTextureCubeMap :: CubeMap a -> IO () Source

Bind a cubemap texture to the cubemap texture binding target and the currently active texture unit.

setTex2DFiltering :: Filtering -> IO () Source

Set the filtering for the 2D texture currently bound to the 2D texture binding target.

setCubeMapFiltering :: Filtering -> IO () Source

Set the filtering for the cubemap texture currently bound to the cubemap texture binding target.

setTex2DWrapping :: Wrapping -> IO () Source

Set the wrapping mode for the 2D texture currently bound to the 2D texture binding target.

setCubeMapWrapping :: Wrapping -> IO () Source

Set the wrapping mode for the cubemap texture currently bound to the cubemap texture binding target. Because no blending occurs between cube faces you probably want ClampToEdge.

data Tex2D a Source

A 2D texture. A program can sample a texture if it has been bound to the appropriate texture unit.

Instances

data CubeMap a Source

A cubemap texture is just six 2D textures. A program can sample a cubemap texture if it has been bound to the appropriate texture unit.

Instances

data Dimensions Source

The size of an image in pixels.

Constructors

Dimensions 

Fields

imageWidth :: Int
 
imageHeight :: Int
 

Instances

data Cube a Source

Six values, one on each side.

Constructors

Cube 

Fields

cubeRight :: a
 
cubeLeft :: a
 
cubeTop :: a
 
cubeBottom :: a
 
cubeFront :: a
 
cubeBack :: a
 

type Side = forall a. Cube a -> a Source

A type to pick one of the sides of a cube. See the accessors of the type Cube.

data Filtering Source

Texture filtering modes.

Constructors

Nearest

No interpolation.

Linear

Linear interpolation.

data Wrapping Source

Texture wrapping modes.

Constructors

Repeat

Tile the texture past the boundary.

MirroredRepeat

Tile the texture but mirror every other tile.

ClampToEdge

Use the edge color for anything past the boundary.

Rendering

Primitives

setViewport :: Viewport -> IO () Source

Set the viewport. The default viewport simply covers the entire window.

enableScissorTest :: Viewport -> IO () Source

Enable the scissor test. Graphics outside the scissor box will not be rendered.

disableScissorTest :: IO () Source

Disable the scissor test.

enableCulling :: Culling -> IO () Source

Enable facet culling. The argument specifies whether front faces, back faces, or both will be omitted from rendering. If both front and back faces are culled you can still render points and lines.

disableCulling :: IO () Source

Disable facet culling. Front and back faces will now be rendered.

data Viewport Source

A rectangular section of the window.

Constructors

Viewport 

Instances

data Culling Source

Facet culling modes.

Instances

data IndexFormat Source

How indices are packed in an ElementArray buffer object.

Constructors

UByteIndices

Each index is one unsigned byte.

UShortIndices

Each index is a two byte unsigned int.

UIntIndices

Each index is a four byte unsigned int.

Color Buffer

enableColorWriting :: IO () Source

Allow rendering commands to modify the color buffer of the current framebuffer.

disableColorWriting :: IO () Source

Disable rendering to color buffer.

clearColorBuffer :: (Float, Float, Float) -> IO () Source

Clear the color buffer of the current framebuffer with the specified color. Has no effect if writing to the color buffer is disabled.

Depth Test

enableDepthTest :: IO () Source

Enable the depth test. Attempting to render pixels with a depth value greater than the depth buffer at those pixels will have no effect. Otherwise the depth in the buffer will get updated to the new pixel's depth.

disableDepthTest :: IO () Source

Disable the depth test and depth buffer updates.

clearDepthBuffer :: IO () Source

Clear the depth buffer with the maximum depth value.

Stencil Test

enableStencil :: Stencil -> IO () Source

Enable the stencil test with a set of operating parameters.

disableStencil :: IO () Source

Disable the stencil test and updates to the stencil buffer, if one exists.

clearStencilBuffer :: IO () Source

Clear the stencil buffer with all zeros.

basicStencil :: Stencil Source

In this basic configuration of the stencil, anything rendered will create a silhouette of 1s in the stencil buffer. Attempting to render a second time into the silhouette will have no effect because the stencil test will fail (ref=1 isn't greater than buffer=1).

def { func = Greater
    , ref = 1
    , onBothPass = Replace }

data Stencil Source

Configuration of the stencil test and associated stencil buffer updating.

Instances

Default Stencil

The default state of the stencil, if it were simply enabled, would be to always pass and update nothing in the buffer. It would have no effect on rendering.

data StencilFunc Source

The stencil test passes under what condition.

data StencilOp Source

Modification action for the stencil buffer.

Constructors

Keep

Do nothing.

Zero

Set to zero.

Replace

Write the ref value passed to enableStencil.

Increment 
Decrement 
Invert

Bitwise complement.

IncrementWrap 
DecrementWrap 

Blending

enableBlending :: Blending -> IO () Source

Enable blending with the specified blending parameters.

disableBlending :: IO () Source

Disable alpha blending.

basicBlending :: Blending Source

This blending configuration is suitable for ordinary alpha blending transparency effects.

Blending
  { sFactor   = BlendSourceAlpha
  , dFactor   = BlendOneMinusSourceAlpha
  , blendFunc = FuncAdd }

data Blending Source

Blending parameters.

Instances

Default Blending

The default blending parameters have no effect if enabled. The result will be no blending effect.

Framebuffers

data FBO Source

A framebuffer object is an alternative rendering destination. Once an FBO is bound to framebuffer binding target, it is possible to attach images (textures or RBOs) for color, depth, or stencil rendering.

bindFramebuffer :: Framebuffer a => a -> IO () Source

Binds an FBO or the default framebuffer to the framebuffer binding target. Replaces the framebuffer already bound there.

newFBO :: IO FBO Source

Create a new framebuffer object. Before the framebuffer can be used for rendering it must have a color image attachment.

attachTex2D :: Attachable a => Tex2D a -> IO () Source

Attach a 2D texture to the FBO currently bound to the framebuffer binding target.

attachCubeMap :: Attachable a => CubeMap a -> Side -> IO () Source

Attach one of the sides of a cubemap texture to the FBO currently bound to the framebuffer binding target.

attachRBO :: Attachable a => RBO a -> IO () Source

Attach an RBO to the FBO currently bound to the framebuffer binding target.

deleteFBO :: FBO -> IO () Source

Delete an FBO.

Renderbuffers

data RBO a Source

An RBO is a kind of image object used for rendering. The only thing you can do with an RBO is attach it to an FBO.

Instances

Show (RBO a) 
GLObject (RBO a) 

newRBO :: InternalFormat a => Int -> Int -> IO (RBO a) Source

Create a new renderbuffer with the specified dimensions.

deleteRBO :: RBO a -> IO () Source

Delete an RBO.

Errors

data GLError Source

Detectable errors.

Constructors

InvalidEnum

Enum argument out of range.

InvalidValue

Integer argument out of range.

InvalidOperation

Operation illegal in current state.

InvalidFramebufferOperation

Framebuffer is not complete.

OutOfMemory 

getGLError :: IO (Maybe GLError) Source

Check for a GL Error. This call has the semantics of a dequeue. If an error is returned, then calling getGLError again may return more errors that have "stacked up." When it returns Nothing then there are no more errors to report. An error indicates that a bug in your code caused incorrect ussage of the API or that the implementation has run out of memory.

It has been suggested that using this after every single GL command may adversely affect performance (not to mention be very tedious). Since there is no reasonable way to recover from a GL error, a good idea might be to check this once per frame or even less often, and respond with a core dump.

assertNoGLError :: IO () Source

Throws an exception if getGLError returns non-Nothing.

Image Formats

data Alpha Source

1-byte alpha channel only.

data Luminance Source

1-byte grayscale pixel format.

data LuminanceAlpha Source

2-byte luminance and alpha channel format.

data RGB Source

3-byte true color pixel format.

data RGBA Source

4-byte true color plus alpha channel format.

data Depth24 Source

24-bit depth format.

Classes

class Framebuffer a where Source

Framebuffers can be bound to the framebuffer binding target. There is a default framebuffer and the client may create an arbitrary number of new framebuffer objects.

Methods

framebufferName :: Num b => a -> b Source

class GLObject a => Texture a Source

Textures are GL objects.

Instances

class InternalFormat a => Attachable a where Source

The allowed attachment point for images with an internal format.

Methods

attachPoint :: (Eq b, Num b) => proxy a -> b Source