diff --git a/Graphics/GL/Low.hs b/Graphics/GL/Low.hs --- a/Graphics/GL/Low.hs +++ b/Graphics/GL/Low.hs @@ -1,1409 +1,392 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE PatternSynonyms #-} -module Graphics.GL.Low ( - - -- * In a Nutshell - -- - -- ** 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. - -- - -- (include link to example programs) - - -- ** Objects - -- | Objects may be created and destroyed by client code. They include: - -- - -- - Vertex Array Object ('VAO') - -- - Buffer Objects ('VBO', 'ElementArray') - -- - Textures ('Tex2D', 'CubeMap') - -- - Shader 'Program's - -- - Framebuffer Objects ('FBO') - -- - Renderbuffer Objects ('RBO') - - -- ** 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 - -- | The role of the second half of a program, the fragment shader, is to - -- compute the color and depth of pixels covered by rasterized primitives - -- (points, lines, and triangles) in the process of rendering. The role of - -- the /first/ half of the program (vertex program) is to arrange the vertices - -- of those primitives somewhere in clip space. Where these vertices and - -- their attributes come from in the first place is determined by the VAO - -- bound to the vertex array binding target. The program may also make use - -- of uniform variables and texture units assigned by client code before - -- rendering (but in a process separate from configuring the VAO). At most - -- one Program can be "in use" at a time. - - -- ** 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 input variables 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 ('setVertexAttributeLayout') 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 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 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 a 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 to 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 for 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.) - - -- ** Depth Testing, Stencil Testing, Scissor Testing, Facet Culling - -- | The depth buffer and stencil buffers, if present in the current - -- framebuffer, can be used to avoid rendering to points of the screen by - -- testing against the value stored at those points. For example if commanded - -- to show a triangle in a region of the framebuffer with a depth greater - -- than current depth buffer values, then the triangle may not be rendered to - -- the color buffer or anywhere else (depending on settings). There are many - -- global settings to switch on and off these tests and the ability to - -- modify the buffers involved. The stencil test in particular is highly - -- configurable. The scissor test is the simplest: when activated nothing - -- outside the scissor box (in screen space) will be rendered. The only - -- other configuration is to set that scissor box ('setScissorBox'). - -- Polygons facing toward or away from the viewer can be dropped (or culled) - -- from rendering with 'enableCulling'. - - -- ** Coordinate Systems - -- | - Screen space is simply the 2D coordinate system of your window. - -- The viewport transformation (see 'setViewport') determines where in the - -- window the mapping of the NDS cube (see below) will appear. - -- - NDS, normalized device coordinates, or sometimes viewport space is a - -- cube 2x2x2 centered at the origin the inside of which is your final scene, - -- before it is mapped to the screen via the viewport setting (see - -- 'setViewport'). If an orthographic projection was used to put the scene in - -- clip space then clip space and NDS are the same. - -- - Clip space is the destination of vertices transformed by the - -- vertex program. Objects here are mapped to NDS using the perspective - -- division technique to account for the case that the vertex shader used - -- a perspective matrix. - -- - Model space is the name for positions of raw vertices as present in - -- the VBOs. The vertex program will want to somehow move these vertexes - -- into clip space, representing generally the position and direction the - -- user is viewing the scene from. - - -- ** 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 - VAO, - newVAO, - bindVAO, - deleteVAO, - - -- * Buffer Objects - -- ** VBO - VBO, - UsageHint(..), - newVBO, - bindVBO, - updateVBO, - deleteVBO, - - -- ** Element Array - ElementArray, - IndexFormat(..), - newElementArray, - bindElementArray, - updateElementArray, - deleteElementArray, - - -- * Shader Program - Program, - ProgramError(..), - newProgram, - newProgramSafe, - useProgram, - deleteProgram, - - -- ** Vertex Attributes - VertexAttributeLayout(..), - LayoutElement(..), - ComponentFormat(..), - setVertexAttributeLayout, - - -- ** Uniform Variables - -- - -- | Set uniform variables for the current program. To set an array of - -- uniforms pass a list of more than one value. - - -- *** Float Uniforms - -- | These call glUniformNfv. - setUniform1f, - setUniform2f, - setUniform3f, - setUniform4f, - - -- *** Int Uniforms - -- | These call glUniformNiv. - setUniform1i, - setUniform2i, - setUniform3i, - setUniform4i, - - -- *** Matrix Uniforms - -- | These call glUniformMatrixNfv. - setUniform22, - setUniform33, - setUniform44, - - -- * Textures - Tex2D, - CubeMap, - Dimensions(..), - Cube(..), - Side, - newTexture2D, - newCubeMap, - newEmptyTexture2D, - newEmptyCubeMap, - deleteTexture, - setActiveTextureUnit, - bindTexture2D, - bindTextureCubeMap, - Filtering(..), - setTex2DFiltering, - setCubeMapFiltering, - Wrapping(..), - setTex2DWrapping, - setCubeMapWrapping, - - -- * Rendering - - -- ** Primitives - -- | Draw primitives to the framebuffer currently bound to the framebuffer - -- binding target. Each primitive drawing command takes the number of vertices - -- in the VBOs to render. The vertices are traversed in order. - drawPoints, - drawLines, - drawLineStrip, - drawLineLoop, - drawTriangles, - drawTriangleStrip, - drawTriangleFan, - - -- ** Primitives by Index - -- | Draw primitives as above, but use the order of vertices defined in - -- the ElementArray currently bound to the element array buffer binding - -- target. - drawIndexedPoints, - drawIndexedLines, - drawIndexedLineStrip, - drawIndexedLineLoop, - drawIndexedTriangles, - drawIndexedTriangleStrip, - drawIndexedTriangleFan, - - -- ** Color Buffer - enableColorWriting, - disableColorWriting, - clearColorBuffer, - - -- ** Depth Test - enableDepthTest, - disableDepthTest, - clearDepthBuffer, - enableDepthWriting, - disableDepthWriting, - - -- ** Stencil Test - enableStencilTest, - disableStencilTest, - clearStencilBuffer, - enableStencilWriting, - disableStencilWriting, - - -- ** Scissor Test - setScissorBox, - enableScissorTest, - disableScissorTest, - - -- ** Facet Culling - Culling(..), - enableCulling, - disableCulling, - - -- ** Blending - -- | When blending is enabled, colors written to the color buffer will be - -- blended with the color already there using a formula. The three options - -- for the formula are ('setBlendEquation'): - -- - -- - Xs + Yd (FuncAdd, the default) - -- - Xs - Yd (FuncSub) - -- - Yd - Xs (FuncReverseSubtract) - -- - -- where X and Y are source and destination color components respetively. - -- The factors s and d are blending factors which can be configured - -- ('setBlendFactors') and should depend on the alpha channel to get a correct - -- transparency effect. The typical choice is - -- - -- @ - -- setBlendFactors BlendSourceAlpha BlendOneMinusSourceAlpha - -- @ - -- - -- When using blending the order of rendering matters. The farther away - -- primitives should be rendered first to get transparent materials to look - -- right. This means a depth test is unhelpful when using this technique. - -- Also blending many layers of transparent primitives can significantly - -- degrade performance. For these reasons transparency effects may be better - -- accomplished with an off-screen rendering pass followed by a suitable shader. - - BlendFactor(..), - BlendEquation(..), - enableBlending, - disableBlending, - setBlendFactors, - setBlendEquation, - - -- ** Viewport - Viewport(..), - setViewport, - - -- * Framebuffers - DefaultFramebuffer, - FBO, - bindFramebuffer, - newFBO, - attachTex2D, - attachCubeMap, - attachRBO, - deleteFBO, - - -- * Renderbuffers - RBO, - newRBO, - deleteRBO, - - -- * Errors - GLError(..), - getGLError, - - -- * Image Formats - Alpha, - Luminance, - LuminanceAlpha, - RGB, - RGBA, - Depth24, - Depth24Stencil8, - - -- * Classes - InternalFormat(..), - Framebuffer(..), - Texture(..), - Attachable(..) - -) where - -import Prelude hiding (sum) -import Control.Exception -import Data.Typeable -import Foreign.Ptr -import Foreign.Storable -import Foreign.Marshal -import Foreign.C.String -import Data.Vector.Storable (Vector, unsafeWith) -import qualified Data.Vector.Storable as V (length) -import Control.Monad hiding (forM_) -import Data.Word -import Data.Int -import Data.Functor -import Control.Applicative -import Data.Traversable -import Data.Foldable -import Data.Default - -import Linear -import Graphics.GL - --- | A VAO stores vertex attribute layouts and the VBO source of vertices --- for those attributes. It also stores the state of the element array binding --- target. The vertex array binding target admits one VAO at a time. -newtype VAO = VAO GLuint deriving Show - --- | A Program object is the combination of a compiled vertex shader and fragment --- shader. Programs have three kinds of inputs: vertex attributes, uniforms, --- and samplers. Programs have two outputs: fragment color and fragment depth. --- At most one program can be "in use" at a time. Same idea as binding targets --- it's just not called that. -newtype Program = Program GLuint deriving Show - --- | A VBO is a buffer object which has vertex data. Shader programs use VBOs --- as input to their vertex attributes according to the configuration of the --- bound VAO. -data VBO = VBO GLuint deriving Show - --- | A buffer object which has a packed sequence of vertex indices. Indexed --- rendering uses the ElementArray bound to the element array binding target. -data ElementArray = ElementArray GLuint deriving Show - --- | A 2D texture. A program can sample a texture if it has been bound to --- the appropriate texture unit. -newtype Tex2D a = Tex2D GLuint deriving Show - --- | 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. -newtype CubeMap a = CubeMap GLuint deriving Show - --- | 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. -newtype FBO = FBO GLuint deriving Show - - --- | Texture filtering modes. -data Filtering = - Nearest | -- ^ No interpolation. - Linear -- ^ Linear interpolation. - deriving Show - -instance ToGL Filtering where - toGL Nearest = GL_NEAREST - toGL Linear = GL_LINEAR - --- | Texture wrapping modes. -data Wrapping = - 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. - deriving Show - -instance ToGL Wrapping where - toGL Repeat = GL_REPEAT - toGL MirroredRepeat = GL_MIRRORED_REPEAT - toGL ClampToEdge = GL_CLAMP_TO_EDGE - --- | Facet culling modes. -data Culling = - CullFront | - CullBack | - CullFrontAndBack - deriving Show - -instance ToGL Culling where - toGL CullFront = GL_FRONT - toGL CullBack = GL_BACK - toGL CullFrontAndBack = GL_FRONT_AND_BACK - --- | 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. -data LayoutElement = - Attrib String Int ComponentFormat | -- ^ Name, component count and component format of a vertex attribute. - Unused Int -- ^ Size in bytes of an unused section of the vertex data. - deriving Show - --- | The layout of interleaved vertex attribute data. -type VertexAttributeLayout = [LayoutElement] - --- | The size and interpretation of a vertex attribute component. Normalized --- components will be mapped to floats in the range [0, 1]. -data ComponentFormat = - VFloat | -- ^ 4-byte float - VByte | - VUByte | - VByteNormalized | - VUByteNormalized | - VShort | -- ^ 2-byte signed integer - VUShort | -- ^ 2-byte unsigned integer - VShortNormalized | - VUShortNormalized | - VInt | -- ^ 4-byte signed integer - VUInt | -- ^ 4-byte unsigned integer - VIntNormalized | - VUIntNormalized - deriving (Eq, Show) - -instance ToGL ComponentFormat where - toGL VFloat = GL_FLOAT - toGL VByte = GL_BYTE - toGL VUByte = GL_UNSIGNED_BYTE - toGL VByteNormalized = GL_BYTE - toGL VUByteNormalized = GL_UNSIGNED_BYTE - toGL VShort = GL_SHORT - toGL VUShort = GL_UNSIGNED_SHORT - toGL VShortNormalized = GL_SHORT - toGL VUShortNormalized = GL_UNSIGNED_SHORT - toGL VInt = GL_INT - toGL VUInt = GL_UNSIGNED_INT - toGL VIntNormalized = GL_INT - toGL VUIntNormalized = GL_UNSIGNED_INT - - --- | Usage hint for allocation of buffer object storage. -data UsageHint = StaticDraw -- ^ Data will seldomly change. - | DynamicDraw -- ^ Data will change. - | StreamDraw -- ^ Data will change very often. - deriving Show - -instance ToGL UsageHint where - toGL StaticDraw = GL_STATIC_DRAW - toGL DynamicDraw = GL_DYNAMIC_DRAW - toGL StreamDraw = GL_STREAM_DRAW - - --- | 1-byte alpha channel only. -data Alpha = Alpha deriving Show - --- | 1-byte grayscale pixel format. -data Luminance = Luminance deriving Show - --- | 2-byte luminance and alpha channel format. -data LuminanceAlpha = Luminancealpha deriving Show - --- | 3-byte true color pixel format. -data RGB = RGB deriving Show - --- | 4-byte true color plus alpha channel format. -data RGBA = RGBA deriving Show - --- | 24-bit depth format. -data Depth24 = Depth24 deriving Show - --- | Combination depth and stencil format. -data Depth24Stencil8 = Depth24Stencil8 deriving Show - --- | OpenGL internal image formats. -class InternalFormat a where - internalFormat :: (Eq b, Num b) => proxy a -> b -instance InternalFormat RGB where - internalFormat _ = GL_RGB8 -instance InternalFormat RGBA where - internalFormat _ = GL_RGBA -instance InternalFormat Alpha where - internalFormat _ = GL_ALPHA -instance InternalFormat Luminance where - internalFormat _ = GL_LUMINANCE -instance InternalFormat LuminanceAlpha where - internalFormat _ = GL_LUMINANCE_ALPHA -instance InternalFormat Depth24 where - internalFormat _ = GL_DEPTH_COMPONENT24 -instance InternalFormat Depth24Stencil8 where - internalFormat _ = GL_DEPTH24_STENCIL8 - --- | The allowed attachment point for images with an internal format. -class InternalFormat a => Attachable a where - attachPoint :: (Eq b, Num b) => proxy a -> b -instance Attachable RGB where - attachPoint _ = GL_COLOR_ATTACHMENT0 -instance Attachable RGBA where - attachPoint _ = GL_COLOR_ATTACHMENT0 -instance Attachable Luminance where - attachPoint _ = GL_COLOR_ATTACHMENT0 -instance Attachable LuminanceAlpha where - attachPoint _ = GL_COLOR_ATTACHMENT0 -instance Attachable Alpha where - attachPoint _ = GL_COLOR_ATTACHMENT0 -instance Attachable Depth24 where - attachPoint _ = GL_DEPTH_ATTACHMENT -instance Attachable Depth24Stencil8 where - attachPoint _ = GL_DEPTH_STENCIL_ATTACHMENT - --- | How indices are packed in an ElementArray buffer object. -data IndexFormat = - 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. - deriving Show - -instance ToGL IndexFormat where - toGL UByteIndices = GL_UNSIGNED_BYTE - toGL UShortIndices = GL_UNSIGNED_SHORT - toGL UIntIndices = GL_UNSIGNED_INT - - --- | 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. -data RBO a = RBO { unRBO :: GLuint } deriving Show - --- | A rectangular section of the window. -data Viewport = Viewport - { viewportX :: Int - , viewportY :: Int - , viewportW :: Int - , viewportH :: Int } - deriving (Eq, Show) - --- | The size of an image in pixels, parameterized by an image format type. -data Dimensions = Dimensions - { imageWidth :: Int - , imageHeight :: Int } - deriving (Show) - --- | Six values, one on each side. -data Cube a = Cube - { cubeRight :: a - , cubeLeft :: a - , cubeTop :: a - , cubeBottom :: a - , cubeFront :: a - , cubeBack :: a } - deriving (Show, Functor, Foldable, Traversable) - --- | A type to pick one of the sides of a cube. See the accessors of the --- type 'Cube'. -type Side = forall a . Cube a -> a - -instance Applicative Cube where - pure x = Cube x x x x x x - (Cube f1 f2 f3 f4 f5 f6) <*> (Cube x1 x2 x3 x4 x5 x6) = - Cube (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) - --- | Either a vertex shader or a fragment shader. -data ShaderType = VertexShader | FragmentShader deriving Show - -instance ToGL ShaderType where - toGL VertexShader = GL_VERTEX_SHADER - toGL FragmentShader = GL_FRAGMENT_SHADER - --- | The error message emitted by the driver when shader compilation or --- linkage fails. -data ProgramError = - VertexShaderError String | - FragmentShaderError String | - LinkError String - deriving (Show, Typeable) - -instance Exception ProgramError - --- | Detectable errors. -data GLError = - InvalidEnum | -- ^ Enum argument out of range. - InvalidValue | -- ^ Integer argument out of range. - InvalidOperation | -- ^ Operation illegal in current state. - InvalidFramebufferOperation | -- ^ Framebuffer is not complete. - OutOfMemory - deriving Typeable - -instance Exception GLError - -instance Show GLError where - show InvalidEnum = "INVALID_ENUM enum argument out of range" - show InvalidValue = "INVALID_VALUE Numeric argument out of range" - show InvalidOperation = "INVALID_OPERATION Illegal in current state" - show InvalidFramebufferOperation = "INVALID_FRAMEBUFFER_OPERATION Framebuffer object is not complete" - show OutOfMemory = "Not enough memory left to execute command" - -class ToGL a where - toGL :: (Num b, Eq b) => a -> b - --- | Textures have an internal numeric name. -class Texture a where - textureName :: Num b => a -> b - -instance Texture (Tex2D a) where - textureName (Tex2D n) = fromIntegral n - -instance Texture (CubeMap a) where - textureName (CubeMap n) = fromIntegral n - - --- | Blending functions for alpha blending. -data BlendEquation = - FuncAdd | -- ^ the default - FuncSubtract | - FuncReverseSubtract - deriving Show - -instance Default BlendEquation where - def = FuncAdd - -instance ToGL BlendEquation where - toGL FuncAdd = GL_FUNC_ADD - toGL FuncSubtract = GL_FUNC_SUBTRACT - toGL FuncReverseSubtract = GL_FUNC_REVERSE_SUBTRACT - - --- | Blending factors. -data BlendFactor = - BlendOne | - BlendZero | - BlendSourceAlpha | - BlendOneMinusSourceAlpha - deriving Show - -instance ToGL BlendFactor where - toGL BlendOne = GL_ONE - toGL BlendZero = GL_ZERO - toGL BlendSourceAlpha = GL_SRC_ALPHA - toGL BlendOneMinusSourceAlpha = GL_ONE_MINUS_SRC_ALPHA - --- | The default framebuffer. Bind this to render to the screen as usual. --- Use the Default instance method 'def' to construct it. -data DefaultFramebuffer = DefaultFramebuffer deriving Show - -instance Default DefaultFramebuffer where - def = DefaultFramebuffer - --- | 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. -class Framebuffer a where - framebufferName :: Num b => a -> b - -instance Framebuffer DefaultFramebuffer where - framebufferName _ = 0 - -instance Framebuffer FBO where - framebufferName (FBO n) = fromIntegral n - - - --- | Create a new VAO. The only thing you can do with a VAO is bind it to --- the vertex array binding target. -newVAO :: IO VAO -newVAO = do - n <- alloca (\ptr -> glGenVertexArrays 1 ptr >> peek ptr) - return (VAO n) - --- | Delete a VAO. -deleteVAO :: VAO -> IO () -deleteVAO (VAO n) = withArray [n] (\ptr -> glDeleteVertexArrays 1 ptr) - --- | Assign the VAO to the vertex array binding target. The VAO already bound --- will be replaced, if any. -bindVAO :: VAO -> IO () -bindVAO (VAO n) = glBindVertexArray n - - --- | Create a buffer object from a blob of bytes. The usage argument hints --- at how often you will modify the data. -newVBO :: Vector Word8 -> UsageHint -> IO VBO -newVBO src usage = do - n <- alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr) - let len = V.length src - glBindBuffer GL_ARRAY_BUFFER n - unsafeWith src $ \ptr -> glBufferData - GL_ARRAY_BUFFER - (fromIntegral len) - (castPtr ptr) - (toGL usage) - return (VBO n) - --- | Delete a VBO. -deleteVBO :: VBO -> IO () -deleteVBO (VBO n) = withArray [n] (\ptr -> glDeleteBuffers 1 ptr) - --- | Modify the data in the currently bound VBO starting from the specified --- index in bytes. -updateVBO :: Vector Word8 -> Int -> IO () -updateVBO src offset = do - let len = V.length src - unsafeWith src $ \ptr -> glBufferSubData - GL_ARRAY_BUFFER - (fromIntegral offset) - (fromIntegral len) - (castPtr ptr) - --- | Bind a VBO to the array buffer binding target. The buffer object bound --- there will be replaced, if any. -bindVBO :: VBO -> IO () -bindVBO (VBO n) = glBindBuffer GL_ARRAY_BUFFER n - - --- | 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. -newElementArray :: Vector Word8 -> UsageHint -> IO ElementArray -newElementArray bytes usage = do - n <- alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr) - glBindBuffer GL_ELEMENT_ARRAY_BUFFER n - let len = V.length bytes - unsafeWith bytes $ \ptr -> do - glBufferData - GL_ELEMENT_ARRAY_BUFFER - (fromIntegral len) - (castPtr ptr) - (toGL usage) - return (ElementArray n) - --- | Delete an ElementArray -deleteElementArray :: ElementArray -> IO () -deleteElementArray (ElementArray n) = withArray [n] (\ptr -> glDeleteBuffers 1 ptr) - --- | Modify contents in the currently bound ElementArray starting at the --- specified index in bytes. -updateElementArray :: Vector Word8 -> Int -> IO () -updateElementArray bytes offset = unsafeWith bytes $ \ptr -> do - glBufferSubData - GL_ELEMENT_ARRAY_BUFFER - (fromIntegral offset) - (fromIntegral (V.length bytes)) - (castPtr ptr) - - --- | 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. -bindElementArray :: ElementArray -> IO () -bindElementArray (ElementArray n) = glBindBuffer GL_ELEMENT_ARRAY_BUFFER n - - --- | Same as 'newProgram' but does not throw exceptions. -newProgramSafe :: String -> String -> IO (Either ProgramError Program) -newProgramSafe vcode fcode = try $ newProgram vcode fcode - --- | Delete a program. -deleteProgram :: Program -> IO () -deleteProgram (Program n) = glDeleteProgram n - --- | 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. -newProgram :: String -- ^ vertex shader source code - -> String -- ^ fragment shader source code - -> IO Program -newProgram vcode fcode = do - vertexShaderId <- compileShader vcode VertexShader - fragmentShaderId <- compileShader fcode FragmentShader - programId <- glCreateProgram - glAttachShader programId vertexShaderId - glAttachShader programId fragmentShaderId - glLinkProgram programId - result <- alloca $ \ptr -> - glGetProgramiv programId GL_LINK_STATUS ptr >> peek ptr - when (result == GL_FALSE) $ do - len <- fmap fromIntegral $ alloca $ \ptr -> - glGetProgramiv programId GL_INFO_LOG_LENGTH ptr >> peek ptr - errors <- allocaArray len $ \ptr -> do - glGetProgramInfoLog programId (fromIntegral len) nullPtr ptr - peekCString ptr - throwIO (LinkError errors) - glDeleteShader vertexShaderId - glDeleteShader fragmentShaderId - return (Program programId) - --- | Install a program into the rendering pipeline. Replaces the program --- already in use, if any. -useProgram :: Program -> IO () -useProgram (Program n) = glUseProgram n - -compileShader :: String -> ShaderType -> IO GLuint -compileShader code vertOrFrag = do - shaderId <- glCreateShader (toGL vertOrFrag) - withCString code $ \ptr -> with ptr $ \pptr -> do - glShaderSource shaderId 1 pptr nullPtr - glCompileShader shaderId - result <- with GL_FALSE $ \ptr -> - glGetShaderiv shaderId GL_COMPILE_STATUS ptr >> peek ptr - when (result == GL_FALSE) $ do - len <- fmap fromIntegral $ alloca $ \ptr -> - glGetShaderiv shaderId GL_INFO_LOG_LENGTH ptr >> peek ptr - errors <- allocaArray len $ \ptr -> do - glGetShaderInfoLog shaderId (fromIntegral len) nullPtr ptr - peekCString ptr - case vertOrFrag of - VertexShader -> throwIO (VertexShaderError errors) - FragmentShader -> throwIO (FragmentShaderError errors) - return shaderId - - --- | This configures the currently bound VAO. It calls glVertexAttribPointer --- and glEnableVertexAttribArray. -setVertexAttributeLayout :: Program -> VertexAttributeLayout -> IO () -setVertexAttributeLayout (Program p) layout = do - let layout' = elaborateLayout 0 layout - let total = totalLayout layout - forM_ layout' $ \(name, size, offset, fmt) -> do - attrib <- withCString name $ \ptr -> glGetAttribLocation p (castPtr ptr) - let norm = isNormalized fmt - glVertexAttribPointer - (fromIntegral attrib) - (fromIntegral size) - (toGL fmt) - (fromIntegral . fromEnum $ norm) - (fromIntegral offset) - (castPtr (nullPtr `plusPtr` offset)) - glEnableVertexAttribArray (fromIntegral attrib) - -elaborateLayout :: Int -> VertexAttributeLayout -> [(String, Int, Int, ComponentFormat)] -elaborateLayout here layout = case layout of - [] -> [] - (Unused n):xs -> elaborateLayout (here+n) xs - (Attrib name n fmt):xs -> - let size = n * sizeOfVertexComponent fmt in - (name, n, here, fmt) : elaborateLayout (here+size) xs - -totalLayout :: VertexAttributeLayout -> Int -totalLayout layout = sum (map arraySize layout) where - arraySize (Unused n) = n - arraySize (Attrib _ n fmt) = n * sizeOfVertexComponent fmt - -sizeOfVertexComponent :: ComponentFormat -> Int -sizeOfVertexComponent c = case c of - VByte -> 1 - VUByte -> 1 - VByteNormalized -> 1 - VUByteNormalized -> 1 - VShort -> 2 - VUShort -> 2 - VShortNormalized -> 2 - VUShortNormalized -> 2 - VInt -> 4 - VUInt -> 4 - VIntNormalized -> 4 - VUIntNormalized -> 4 - VFloat -> 4 - -isNormalized :: ComponentFormat -> Bool -isNormalized c = case c of - VByte -> False - VUByte -> False - VByteNormalized -> True - VUByteNormalized -> True - VShort -> False - VUShort -> False - VShortNormalized -> True - VUShortNormalized -> True - VInt -> False - VUInt -> False - VIntNormalized -> True - VUIntNormalized -> True - VFloat -> False - - -setUniform1f :: Program -> String -> [Float] -> IO () -setUniform1f = setUniform glUniform1fv - -setUniform2f :: Program -> String -> [V2 Float] -> IO () -setUniform2f = setUniform - (\loc cnt val -> glUniform2fv loc cnt (castPtr val)) - -setUniform3f :: Program -> String -> [V3 Float] -> IO () -setUniform3f = setUniform - (\loc cnt val -> glUniform3fv loc cnt (castPtr val)) - -setUniform4f :: Program -> String -> [V4 Float] -> IO () -setUniform4f = setUniform - (\loc cnt val -> glUniform4fv loc cnt (castPtr val)) - -setUniform1i :: Program -> String -> [Int] -> IO () -setUniform1i = setUniform - (\loc cnt val -> glUniform1iv loc cnt (castPtr val)) - -setUniform2i :: Program -> String -> [V2 Int] -> IO () -setUniform2i = setUniform - (\loc cnt val -> glUniform2iv loc cnt (castPtr val)) - -setUniform3i :: Program -> String -> [V3 Int] -> IO () -setUniform3i = setUniform - (\loc cnt val -> glUniform3iv loc cnt (castPtr val)) - -setUniform4i :: Program -> String -> [V4 Int] -> IO () -setUniform4i = setUniform - (\loc cnt val -> glUniform4iv loc cnt (castPtr val)) - -setUniform44 :: Program -> String -> [M44 Float] -> IO () -setUniform44 = setUniform - (\loc cnt val -> glUniformMatrix4fv loc cnt GL_FALSE (castPtr val)) - -setUniform33 :: Program -> String -> [M33 Float] -> IO () -setUniform33 = setUniform - (\loc cnt val -> glUniformMatrix3fv loc cnt GL_FALSE (castPtr val)) - -setUniform22 :: Program -> String -> [M22 Float] -> IO () -setUniform22 = setUniform - (\loc cnt val -> glUniformMatrix2fv loc cnt GL_FALSE (castPtr val)) - -setUniform :: Storable a => (GLint -> GLsizei -> Ptr a -> IO ()) - -> Program -> String -> [a] - -> IO () -setUniform glAction (Program p) name xs = withArrayLen xs $ \n bytes -> do - loc <- withCString name (\ptr -> glGetUniformLocation p ptr) - glAction loc (fromIntegral n) bytes - - - - -drawPoints :: Int -> IO () -drawPoints = drawArrays GL_POINTS - -drawLines :: Int -> IO () -drawLines = drawArrays GL_LINES - -drawLineStrip :: Int -> IO () -drawLineStrip = drawArrays GL_LINE_STRIP - -drawLineLoop :: Int -> IO () -drawLineLoop = drawArrays GL_LINE_LOOP - -drawTriangles :: Int -> IO () -drawTriangles = drawArrays GL_TRIANGLES - -drawTriangleStrip :: Int -> IO () -drawTriangleStrip = drawArrays GL_TRIANGLE_STRIP - -drawTriangleFan :: Int -> IO () -drawTriangleFan = drawArrays GL_TRIANGLE_FAN - -drawArrays :: GLenum -> Int -> IO () -drawArrays mode n = glDrawArrays mode (fromIntegral n) 0 - -drawIndexedPoints :: Int -> IndexFormat -> IO () -drawIndexedPoints = drawIndexed GL_POINTS - -drawIndexedLines :: Int -> IndexFormat -> IO () -drawIndexedLines = drawIndexed GL_LINES - -drawIndexedLineStrip :: Int -> IndexFormat -> IO () -drawIndexedLineStrip = drawIndexed GL_LINE_STRIP - -drawIndexedLineLoop :: Int -> IndexFormat -> IO () -drawIndexedLineLoop = drawIndexed GL_LINE_LOOP - -drawIndexedTriangles :: Int -> IndexFormat -> IO () -drawIndexedTriangles = drawIndexed GL_TRIANGLES - -drawIndexedTriangleStrip :: Int -> IndexFormat -> IO () -drawIndexedTriangleStrip = drawIndexed GL_TRIANGLE_STRIP - -drawIndexedTriangleFan :: Int -> IndexFormat -> IO () -drawIndexedTriangleFan = drawIndexed GL_TRIANGLE_FAN - -drawIndexed :: GLenum -> Int -> IndexFormat -> IO () -drawIndexed mode n fmt = glDrawElements mode (fromIntegral n) (toGL fmt) nullPtr - --- | Create a new 2D texture from a blob and its image format. --- Dimensions should be powers of two. -newTexture2D :: InternalFormat a => Vector Word8 -> Dimensions -> IO (Tex2D a) -newTexture2D bytes (Dimensions w h) = do - n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr) - glBindTexture GL_TEXTURE_2D n - tex <- return (Tex2D n) - unsafeWith bytes $ \ptr -> glTexImage2D - GL_TEXTURE_2D - 0 - (internalFormat tex) - (fromIntegral w) - (fromIntegral h) - 0 - (internalFormat tex) - GL_UNSIGNED_BYTE - (castPtr ptr) - return tex - --- | Delete a texture. -deleteTexture :: Texture a => a -> IO () -deleteTexture x = withArray [textureName x] (\ptr -> glDeleteTextures 1 ptr) - --- | Create a new cube map texture from six blobs and their respective formats. --- Dimensions should be powers of two. -newCubeMap :: InternalFormat a - => Cube (Vector Word8, Dimensions) - -> IO (CubeMap a) -newCubeMap images = do - n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr) - glBindTexture GL_TEXTURE_CUBE_MAP n - cm <- return (CubeMap n) - let fmt = internalFormat cm - sequenceA (liftA2 (loadCubeMapSide fmt) images cubeSideCodes) - return cm - -loadCubeMapSide :: GLenum -> (Vector Word8, Dimensions) -> GLenum -> IO () -loadCubeMapSide fmt (bytes, (Dimensions w h)) side = do - unsafeWith bytes $ \ptr -> glTexImage2D - side - 0 - (fromIntegral fmt) - (fromIntegral w) - (fromIntegral h) - 0 - fmt - GL_UNSIGNED_BYTE - (castPtr ptr) - --- | Create an empty texture with the specified dimensions and format. -newEmptyTexture2D :: InternalFormat a => Int -> Int -> IO (Tex2D a) -newEmptyTexture2D w h = do - let w' = fromIntegral w - let h' = fromIntegral h - n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr) - tex <- return (Tex2D n) - let fmt = internalFormat tex - let fmt' = internalFormat tex - glBindTexture GL_TEXTURE_2D n - glTexImage2D GL_TEXTURE_2D 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr - return tex - --- | Create a cubemap texture where each of the six sides has the specified --- dimensions and format. -newEmptyCubeMap :: InternalFormat a => Int -> Int -> IO (CubeMap a) -newEmptyCubeMap w h = do - let w' = fromIntegral w - let h' = fromIntegral h - n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr) - tex <- return (CubeMap n) - let fmt = internalFormat tex - let fmt' = internalFormat tex - glBindTexture GL_TEXTURE_CUBE_MAP n - glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_X 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr - glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_X 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr - glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Y 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr - glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Y 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr - glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Z 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr - glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Z 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr - return tex - - --- | Bind a 2D texture to the 2D texture binding target and the currently --- active texture unit. -bindTexture2D :: Tex2D a -> IO () -bindTexture2D (Tex2D n) = glBindTexture GL_TEXTURE_2D n - --- | Bind a cubemap texture to the cubemap texture binding target and --- the currently active texture unit. -bindTextureCubeMap :: CubeMap a -> IO () -bindTextureCubeMap (CubeMap n) = glBindTexture GL_TEXTURE_CUBE_MAP n - --- | Set the active texture unit. The default is zero. -setActiveTextureUnit :: Enum a => a -> IO () -setActiveTextureUnit n = - (glActiveTexture . fromIntegral) (GL_TEXTURE0 + fromEnum n) - --- | Set the filtering for the 2D texture currently bound to the 2D texture --- binding target. -setTex2DFiltering :: Filtering -> IO () -setTex2DFiltering filt = do - glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER (toGL filt) - glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER (toGL filt) - --- | Set the filtering for the cubemap texture currently bound to the cubemap --- texture binding target. -setCubeMapFiltering :: Filtering -> IO () -setCubeMapFiltering filt = do - glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MIN_FILTER (toGL filt) - glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MAG_FILTER (toGL filt) - --- | Set the wrapping mode for the 2D texture currently bound to the 2D --- texture binding target. -setTex2DWrapping :: Wrapping -> IO () -setTex2DWrapping wrap = do - glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S (toGL wrap) - glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T (toGL wrap) - --- | 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. -setCubeMapWrapping :: Wrapping -> IO () -setCubeMapWrapping wrap = do - glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_S (toGL wrap) - glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_T (toGL wrap) - glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_R (toGL wrap) - - - --- | Allow rendering commands to modify the color buffer of the current --- framebuffer. -enableColorWriting :: IO () -enableColorWriting = glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE - --- | Disable rendering to color buffer. -disableColorWriting :: IO () -disableColorWriting = glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE - --- | Clear the color buffer of the current framebuffer with the specified --- color. Has no effect if writing to the color buffer is disabled. -clearColorBuffer :: (Float, Float, Float) -> IO () -clearColorBuffer (r, g, b) = do - glClearColor (realToFrac r) (realToFrac g) (realToFrac b) 1.0 - glClear GL_COLOR_BUFFER_BIT - --- | Enable the depth test. Attempting to render pixels with a depth value --- greater than the depth buffer at those pixels will have no effect. -enableDepthTest :: IO () -enableDepthTest = glEnable GL_DEPTH_TEST - --- | Disable the depth test. Rendering will not be affected by the depth. --- Use this to render graphics even if they are behind something. -disableDepthTest :: IO () -disableDepthTest = glDisable GL_DEPTH_TEST - --- | Enable writing depth values to the depth buffer of the current framebuffer. --- It is enabled by default. -enableDepthWriting :: IO () -enableDepthWriting = glDepthMask GL_TRUE - --- | Disable writing to the depth buffer. -disableDepthWriting :: IO () -disableDepthWriting = glDepthMask GL_FALSE - --- | Clear the depth buffer with the maximum depth value. -clearDepthBuffer :: IO () -clearDepthBuffer = glClear GL_DEPTH_BUFFER_BIT - --- | Enable the stencil test. Any pixels rendered to the screen where the --- stencil buffer is 1 will not be rendered. This disables writing to the --- stencil buffer. -enableStencilTest :: IO () -enableStencilTest = do - glStencilFunc GL_LESS 1 maxBound - glStencilOp GL_KEEP GL_KEEP GL_KEEP - glEnable GL_STENCIL_TEST - --- | Disable the stencil test. -disableStencilTest :: IO () -disableStencilTest = glDisable GL_STENCIL_TEST - --- | Clear the stencil buffer with all zeros. -clearStencilBuffer :: IO () -clearStencilBuffer = glClear GL_STENCIL_BUFFER_BIT - --- | Allow rendering to modify the stencil buffer. Any pixels rendered to --- the screen will set the stencil buffer to 1 at that location. -enableStencilWriting :: IO () -enableStencilWriting = do - glStencilFunc GL_ALWAYS 1 maxBound - glStencilOp GL_KEEP GL_KEEP GL_REPLACE - glStencilMask 1 - --- | Disable rendering to the stencil buffer. -disableStencilWriting :: IO () -disableStencilWriting = glStencilMask 0 - - - --- | Set the scissor box. Graphics outside this box will not be rendered as --- long as the scissor test is enabled. -setScissorBox :: Viewport -> IO () -setScissorBox (Viewport x y w h) = - glScissor (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) - --- | Enable the scissor test. Graphics outside the scissor box will not be --- rendered. -enableScissorTest :: IO () -enableScissorTest = glEnable GL_SCISSOR_TEST - --- | Disable the scissor test. -disableScissorTest :: IO () -disableScissorTest = glDisable GL_SCISSOR_TEST - - --- | 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. -enableCulling :: Culling -> IO () -enableCulling c = do - case c of - CullFront -> glCullFace GL_FRONT - CullBack -> glCullFace GL_BACK - CullFrontAndBack -> glCullFace GL_FRONT_AND_BACK - glEnable GL_CULL_FACE - --- | Disable facet culling. Front and back faces will now be rendered. -disableCulling :: IO () -disableCulling = glDisable GL_CULL_FACE - --- | Set the viewport. The default viewport simply covers the entire window. -setViewport :: Viewport -> IO () -setViewport (Viewport x y w h) = - glViewport (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) - --- | Binds an FBO or the default framebuffer to the framebuffer binding target. --- Replaces the framebuffer already bound there. -bindFramebuffer :: Framebuffer a => a -> IO () -bindFramebuffer x = glBindFramebuffer GL_FRAMEBUFFER (framebufferName x) - --- | Create a new framebuffer object. Before the framebuffer can be used for --- rendering it must have a color image attachment. -newFBO :: IO FBO -newFBO = do - n <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr) - return (FBO n) - --- | Delete an FBO. -deleteFBO :: FBO -> IO () -deleteFBO (FBO n) = withArray [n] (\ptr -> glDeleteFramebuffers 1 ptr) - --- | Attach a 2D texture to the FBO currently bound to the --- framebuffer binding target. -attachTex2D :: Attachable a => Tex2D a -> IO () -attachTex2D t@(Tex2D n) = - glFramebufferTexture2D GL_FRAMEBUFFER (attachPoint t) GL_TEXTURE_2D n 0 - --- | Attach one of the sides of a cubemap texture to the FBO currently bound --- to the framebuffer binding target. -attachCubeMap :: Attachable a => CubeMap a -> Side -> IO () -attachCubeMap cm@(CubeMap n) side = - glFramebufferTexture2D - GL_FRAMEBUFFER - (attachPoint cm) - (side cubeSideCodes) - n - 0 - -cubeSideCodes :: Cube GLenum -cubeSideCodes = Cube - { cubeLeft = GL_TEXTURE_CUBE_MAP_NEGATIVE_X - , cubeRight = GL_TEXTURE_CUBE_MAP_POSITIVE_X - , cubeTop = GL_TEXTURE_CUBE_MAP_POSITIVE_Y - , cubeBottom = GL_TEXTURE_CUBE_MAP_NEGATIVE_Y - , cubeFront = GL_TEXTURE_CUBE_MAP_POSITIVE_Z - , cubeBack = GL_TEXTURE_CUBE_MAP_NEGATIVE_Z } - --- | Attach an RBO to the FBO currently bound to the framebuffer binding --- target. -attachRBO :: Attachable a => RBO a -> IO () -attachRBO rbo = glFramebufferRenderbuffer - GL_FRAMEBUFFER (attachPoint rbo) GL_RENDERBUFFER (unRBO rbo) - --- | Create a new renderbuffer with the specified dimensions. -newRBO :: InternalFormat a => Int -> Int -> IO (RBO a) -newRBO w h = do - n <- alloca (\ptr -> glGenRenderbuffers 1 ptr >> peek ptr) - rbo <- return (RBO n) - glBindRenderbuffer GL_RENDERBUFFER n - glRenderbufferStorage - GL_RENDERBUFFER - (internalFormat rbo) - (fromIntegral w) - (fromIntegral h) - return rbo - --- | Delete an RBO. -deleteRBO :: RBO a -> IO () -deleteRBO (RBO n) = withArray [n] (\ptr -> glDeleteRenderbuffers 1 ptr) - - --- | Enable alpha blending. -enableBlending :: IO () -enableBlending = glEnable GL_BLEND - --- | Disable alpha blending. -disableBlending :: IO () -disableBlending = glDisable GL_BLEND - --- | Set the computation for source and destination blending factors. -setBlendFactors :: BlendFactor -> BlendFactor -> IO () -setBlendFactors s d = glBlendFunc (toGL s) (toGL d) - --- | Set the overall blending function. -setBlendEquation :: BlendEquation -> IO () -setBlendEquation e = glBlendEquation (toGL e) - - - --- | Check for a GL Error. -getGLError :: IO (Maybe GLError) -getGLError = do - n <- glGetError - return $ case n of - GL_NO_ERROR -> Nothing - GL_INVALID_ENUM -> Just InvalidEnum - GL_INVALID_VALUE -> Just InvalidValue - GL_INVALID_OPERATION -> Just InvalidOperation - GL_INVALID_FRAMEBUFFER_OPERATION -> Just InvalidFramebufferOperation - GL_OUT_OF_MEMORY -> Just OutOfMemory - _ -> error ("unknown GL error " ++ show n) +module Graphics.GL.Low ( + + -- * In a Nutshell + -- + -- ** 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. + + -- ** Objects + -- | Objects may be created and destroyed by client code. They include: + -- + -- - Vertex Array Object ('VAO') + -- - Buffer Objects ('VBO', 'ElementArray') + -- - Textures ('Tex2D', 'CubeMap') + -- - Shader 'Program's + -- - Framebuffer Objects ('FBO') + -- - Renderbuffer Objects ('RBO') + + -- ** 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 + -- | The role of the second half of a shader program, the fragment shader, is + -- to compute the color and depth of pixels covered by rasterized primitives + -- (points, lines, and triangles) in the process of rendering. The role of + -- the /first/ half of the program (vertex program) is to arrange the + -- vertices of those primitives somewhere in clip space. Where these vertices + -- and their attributes come from in the first place is determined by the VAO + -- bound to the vertex array binding target. The program may also make use of + -- uniform variables and texture units assigned by client code before + -- rendering (but in a process completely separate from configuring the VAO). + -- At most one Program can be "in use" at a time. + + -- ** 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 ('setVertexAttributeLayout') 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 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 + -- | See also "Graphics.GL.Low.VAO" + newVAO, + bindVAO, + deleteVAO, + VAO, + + -- * Buffer Objects + -- | See also "Graphics.GL.Low.BufferObject" + newVBO, + newElementArray, + bindVBO, + bindElementArray, + updateVBO, + updateElementArray, + deleteBufferObject, + VBO, + ElementArray, + UsageHint(..), + IndexFormat(..), + + -- * Shader Program + -- | See also "Graphics.GL.Low.Shader" + newProgram, + newProgramSafe, + useProgram, + deleteProgram, + setUniform1f, + setUniform2f, + setUniform3f, + setUniform4f, + setUniform1i, + setUniform2i, + setUniform3i, + setUniform4i, + setUniform22, + setUniform33, + setUniform44, + Program, + ProgramError(..), + + -- ** Vertex Attributes + -- | See also "Graphics.GL.Low.VertexAttrib" + setVertexAttributeLayout, + VertexAttributeLayout(..), + LayoutElement(..), + ComponentFormat(..), + + + -- * Textures + -- | See also "Graphics.GL.Low.Texture" + newTexture2D, + newCubeMap, + newEmptyTexture2D, + newEmptyCubeMap, + deleteTexture, + setActiveTextureUnit, + bindTexture2D, + bindTextureCubeMap, + setTex2DFiltering, + setCubeMapFiltering, + setTex2DWrapping, + setCubeMapWrapping, + Tex2D, + CubeMap, + Dimensions(..), + Cube(..), + Side, + Filtering(..), + Wrapping(..), + + -- * Rendering + -- | See also "Graphics.GL.Low.Render" + + -- ** Primitives + -- | Draw primitives to the framebuffer currently bound to the framebuffer + -- binding target. Each primitive drawing command takes the number of vertices + -- in the VBOs to render. The vertices are traversed in order. + drawPoints, + drawLines, + drawLineStrip, + drawLineLoop, + drawTriangles, + drawTriangleStrip, + drawTriangleFan, + + -- ** Primitives by Index + -- | Draw primitives as above, but use the order of vertices defined in + -- the ElementArray currently bound to the element array buffer binding + -- target. + drawIndexedPoints, + drawIndexedLines, + drawIndexedLineStrip, + drawIndexedLineLoop, + drawIndexedTriangles, + drawIndexedTriangleStrip, + drawIndexedTriangleFan, + + -- ** Color Buffer + -- | See also "Graphics.GL.Low.Color" + enableColorWriting, + disableColorWriting, + clearColorBuffer, + + -- ** Depth Test + -- | See also "Graphics.GL.Low.Depth" + enableDepthTest, + disableDepthTest, + clearDepthBuffer, + + -- ** Stencil Test + -- | See also "Graphics.GL.Low.Stencil". + enableStencil, + disableStencil, + clearStencilBuffer, + basicStencil, + Stencil(..), + StencilFunc(..), + StencilOp(..), + + -- ** Scissor Test + enableScissorTest, + disableScissorTest, + + -- ** Facet Culling + Culling(..), + enableCulling, + disableCulling, + + -- ** Blending + -- | See also "Graphics.GL.Low.Blending". + + enableBlending, + disableBlending, + basicBlending, + Blending(..), + BlendFactor(..), + BlendEquation(..), + + -- ** Viewport + Viewport(..), + setViewport, + + -- * Framebuffers + -- | See also "Graphics.GL.Low.Framebuffer" + DefaultFramebuffer, + FBO, + bindFramebuffer, + newFBO, + attachTex2D, + attachCubeMap, + attachRBO, + deleteFBO, + + -- * Renderbuffers + RBO, + newRBO, + deleteRBO, + + -- * Errors + GLError(..), + getGLError, + + -- * Image Formats + Alpha, + Luminance, + LuminanceAlpha, + RGB, + RGBA, + Depth24, + Depth24Stencil8, + + -- * Classes + InternalFormat(..), + Framebuffer(..), + Texture(..), + Attachable(..) + +) where + +import Graphics.GL.Low.Classes +import Graphics.GL.Low.VAO +import Graphics.GL.Low.BufferObject +import Graphics.GL.Low.Shader +import Graphics.GL.Low.VertexAttrib +import Graphics.GL.Low.Texture +import Graphics.GL.Low.Framebuffer +import Graphics.GL.Low.Blending +import Graphics.GL.Low.Color +import Graphics.GL.Low.Depth +import Graphics.GL.Low.Stencil +import Graphics.GL.Low.Render +import Graphics.GL.Low.ImageFormat +import Graphics.GL.Low.Cube +import Graphics.GL.Low.Error diff --git a/Graphics/GL/Low/Common.hs b/Graphics/GL/Low/Common.hs new file mode 100644 --- /dev/null +++ b/Graphics/GL/Low/Common.hs @@ -0,0 +1,15 @@ +module Graphics.GL.Low.Common where + +import Graphics.GL + +import Graphics.GL.Low.Cube + +cubeSideCodes :: Cube GLenum +cubeSideCodes = Cube + { cubeLeft = GL_TEXTURE_CUBE_MAP_NEGATIVE_X + , cubeRight = GL_TEXTURE_CUBE_MAP_POSITIVE_X + , cubeTop = GL_TEXTURE_CUBE_MAP_POSITIVE_Y + , cubeBottom = GL_TEXTURE_CUBE_MAP_NEGATIVE_Y + , cubeFront = GL_TEXTURE_CUBE_MAP_POSITIVE_Z + , cubeBack = GL_TEXTURE_CUBE_MAP_NEGATIVE_Z } + diff --git a/lowgl.cabal b/lowgl.cabal --- a/lowgl.cabal +++ b/lowgl.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.1 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Basic gl wrapper and reference @@ -49,6 +49,7 @@ library -- Modules exported by the library. exposed-modules: Graphics.GL.Low + other-modules: Graphics.GL.Low.Common -- Modules included in this library but not exported. -- other-modules: @@ -57,7 +58,7 @@ -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.7 && <4.8, vector >=0.10 && <0.11, linear >= 1.16 && <1.17, gl >=0.5 && <0.7, data-default + build-depends: base >=4.7 && <4.8, vector >=0.10 && <0.11, linear >= 1.16 && <1.17, gl >=0.5 && <0.8, data-default -- Directories containing source files. -- hs-source-dirs: @@ -73,4 +74,4 @@ source-repository this type: git location: https://github.com/evanrinehart/lowgl - tag: 0.1.0.1 + tag: 0.2.0.0