packages feed

OpenGL 2.5.0.0 → 3.0.3.0

raw patch · 203 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,62 @@+3.0.3.0+-------+* Handle MonadFail proposal.++3.0.2.2+-------+* Relaxed upper version bound for `containers`.++3.0.2.1+-------+* Relaxed upper version bound for `OpenGLRaw`.++3.0.2.0+-------+* Added support for S3_s3tc, EXT_texture_compression_s3tc, ARB_texture_float, and EXT_packed_depth_stencil extensions.++3.0.1.0+-------+* Added `Uniform` instances for `GLmatrix`, `Vertex1`, `Vector1`, `Vector2`, `Vector3`, and `Vector4`.+* Unbreak `Uniform` instances for `GLint`, `GLuint` and `Gldouble`.+* Relaxed upper version bound for `OpenGLRaw`.++3.0.0.2+-------+* Removed redundant constraints.++3.0.0.1+-------+* Relaxed upper version bound for `OpenGLRaw`.++3.0.0.0+-------+* Depend on new `OpenGLRaw` and `GLURaw` packages.++2.13.2.1+--------+* Relaxed upper version bound for `transformers`.++2.13.2.0+--------+* Implement Uniform instances for `GLint`, `GLuint`, `GLfloat`, and `GLdouble`.++2.13.1.1+--------+* Aftermath for the `glClearNamedFramebufferfi` chaos in the OpenGL registry,+  see the corresponding+  [issue](https://www.khronos.org/bugzilla/show_bug.cgi?id=1394) on Khronos.++2.13.1.0+--------+* Added `extensionSupported`.+* Relaxed upper version bound for OpenGLRaw.+* Added CHANGELOG.md to distribution.++2.13.0.0+--------+* Added missing drawing commands using vertex arrays and some related types.+* Added missing whole framebuffer operations.+* Added getters for `stencilMaskSeparate`, `stencilFuncSeparate`, and `stencilOpSeparate`, making them full-blown `StateVar`s.+* Added `patchDefaultInnerLevel` and `patchDefaultOuterLevel` to control the default tessellation levels.+* Added `ContextLost` constructor to `ErrorCategory` type.+* Added `SeparateAttribs` and deprecated `SeperateAttribs`, fixing a spelling mistake.
− Graphics/Rendering/OpenGL.hs 
@@ -1,138 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ A convenience module, combining the Haskell bindings for GL and GLU.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL (-   -- * Supported Extensions--   -- $SupportedExtensions--   -- * Legal stuff--   -- $LegalStuff--     module Graphics.Rendering.OpenGL.GL-   , module Graphics.Rendering.OpenGL.GLU-) where--import Graphics.Rendering.OpenGL.GL-import Graphics.Rendering.OpenGL.GLU------------------------------------------------------------------------------------- $SupportedExtensions--- There is support for full OpenGL 2.1, including the imaging subset, plus some--- extensions:------ @--- extension                      | core since--- -------------------------------+--------------- GL_APPLE_packed_pixels         | 1.2--- GL_APPLE_ycbcr_422             |--- GL_ARB_copy_buffer             | 3.1--- GL_ARB_depth_buffer_float      | 3.0--- GL_ARB_depth_texture           | 1.4--- GL_ARB_half_float_pixel        | 3.0--- GL_ARB_imaging                 |--- GL_ARB_multisample             | 1.3--- GL_ARB_multitexture            | 1.3--- GL_ARB_occlusion_query         | 1.5--- GL_ARB_point_parameters        | 1.4--- GL_ARB_point_sprite            |--- GL_ARB_shadow                  | 1.4--- GL_ARB_texture_border_clamp    | 1.3--- GL_ARB_texture_compression     | 1.3--- GL_ARB_texture_cube_map        | 1.3--- GL_ARB_texture_env_add         | 1.3--- GL_ARB_texture_env_combine     | 1.3--- GL_ARB_texture_env_crossbar    | 1.4--- GL_ARB_texture_env_dot3        | 1.3--- GL_ARB_texture_mirrored_repeat | 1.4--- GL_ARB_texture_rectangle       | 3.1--- GL_ARB_transpose_matrix        | 1.3--- GL_ARB_vertex_buffer_object    | 1.5--- GL_ARB_vertex_shader           | 2.0--- GL_ARB_window_pos              | 1.4--- GL_EXT_abgr                    |--- GL_EXT_bgra                    | 1.2--- GL_EXT_blend_color             | 1.4--- GL_EXT_blend_func_separate     | 1.4--- GL_EXT_blend_logic_op          | 1.1--- GL_EXT_blend_minmax            | 1.4--- GL_EXT_blend_subtract          | 1.4--- GL_EXT_color_subtable          |--- GL_EXT_compiled_vertex_array   |--- GL_EXT_convolution             |--- GL_EXT_copy_texture            | 1.1--- GL_EXT_depth_bounds_test       |--- GL_EXT_draw_range_elements     | 1.2--- GL_EXT_fog_coord               | 1.4--- GL_EXT_histogram               |--- GL_EXT_multi_draw_arrays       | 1.4--- GL_EXT_packed_float            | 3.0--- GL_EXT_packed_pixels           | 1.2--- GL_EXT_polygon_offset          | 1.1--- GL_EXT_rescale_normal          | 1.2--- GL_EXT_secondary_color         | 1.4--- GL_EXT_separate_specular_color | 1.2--- GL_EXT_shadow_funcs            | 1.5--- GL_EXT_stencil_two_side        |--- GL_EXT_stencil_wrap            | 1.4--- GL_EXT_subtexture              | 1.1--- GL_EXT_texture                 | 1.1--- GL_EXT_texture3D               | 1.2--- GL_EXT_texture_lod_bias        | 1.4--- GL_EXT_texture_shared_exponent | 3.0--- GL_EXT_texture_object          | 1.1--- GL_EXT_vertex_array            | 1.1--- GL_HP_convolution_border_modes |--- GL_IBM_rasterpos_clip          |--- GL_MESA_ycbcr_texture          |--- GL_NV_blend_square             | 1.4--- GL_NV_depth_clamp              |--- GL_NV_fog_distance             |--- GL_NV_light_max_exponent       |--- GL_NV_packed_depth_stencil     |--- GL_NV_primitive_restart        |--- GL_SGIS_generate_mipmap        | 1.4--- GL_SGIS_texture_edge_clamp     |--- GL_SGIS_texture_lod            |--- GL_SGI_color_matrix            |--- GL_SGI_color_table             |--- @------------------------------------------------------------------------------------- $LegalStuff--- The documentation is loosely based on the man pages of the OpenGL Sample--- Implemenation from SGI, see: <http://oss.sgi.com/projects/ogl-sample/>. It is--- used under the SGI Free Software License B. This license requires the--- following notice:------ /License Applicability/. Except to the extent portions of this file are made--- subject to an alternative license as permitted in the SGI Free Software--- License B, Version 1.1 (the \"License\"), the contents of this file are--- subject only to the provisions of the License. You may not use this file--- except in compliance with the License. You may obtain a copy of the License--- at Silicon Graphics, Inc., attn: Legal Services, 1600 Amphitheatre Parkway,--- Mountain View, CA 94043-1351, or at: <http://oss.sgi.com/projects/FreeB/>.--- --- Note that, as provided in the License, the Software is distributed on an \"AS--- IS\" basis, with ALL EXPRESS AND IMPLIED WARRANTIES AND CONDITIONS--- DISCLAIMED, INCLUDING, WITHOUT LIMITATION, ANY IMPLIED WARRANTIES AND--- CONDITIONS OF MERCHANTABILITY, SATISFACTORY QUALITY, FITNESS FOR A PARTICULAR--- PURPOSE, AND NON-INFRINGEMENT.------ /Original Code/. The Original Code is: OpenGL Sample Implementation, Version--- 1.2.1, released January 26, 2000, developed by Silicon Graphics, Inc. The--- Original Code is Copyright (c) 1991-2002 Silicon Graphics, Inc.  Copyright in--- any portions created by third parties is as indicated elsewhere herein. All--- Rights Reserved.
− Graphics/Rendering/OpenGL/GL.hs 
@@ -1,100 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.OpenGL.GL--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ A Haskell binding for OpenGL, the industry\'s most widely used and--- supported 2D and 3D graphics API.-----------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL (-   -- * OpenGL Operation-   module Graphics.Rendering.OpenGL.Raw.Core31,-   module Graphics.Rendering.OpenGL.GL.BeginEnd,-   module Graphics.Rendering.OpenGL.GL.VertexSpec,-   module Graphics.Rendering.OpenGL.GL.VertexArrays,-   module Graphics.Rendering.OpenGL.GL.BufferObjects,-   module Graphics.Rendering.OpenGL.GL.Rectangles,-   module Graphics.Rendering.OpenGL.GL.CoordTrans,-   module Graphics.Rendering.OpenGL.GL.Clipping,-   module Graphics.Rendering.OpenGL.GL.RasterPos,-   module Graphics.Rendering.OpenGL.GL.Colors,-   module Graphics.Rendering.OpenGL.GL.Shaders,--   -- * Rasterization-   module Graphics.Rendering.OpenGL.GL.Antialiasing,-   module Graphics.Rendering.OpenGL.GL.Points,-   module Graphics.Rendering.OpenGL.GL.LineSegments,-   module Graphics.Rendering.OpenGL.GL.Polygons,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles,-   module Graphics.Rendering.OpenGL.GL.Bitmaps,-   module Graphics.Rendering.OpenGL.GL.Texturing,-   module Graphics.Rendering.OpenGL.GL.ColorSum,-   module Graphics.Rendering.OpenGL.GL.Fog,--   -- * Per-Fragment Operations and the Framebuffer-   module Graphics.Rendering.OpenGL.GL.PerFragment,-   module Graphics.Rendering.OpenGL.GL.Framebuffer,-   module Graphics.Rendering.OpenGL.GL.ReadCopyPixels,--   -- * Special Functions-   module Graphics.Rendering.OpenGL.GL.Evaluators,-   module Graphics.Rendering.OpenGL.GL.Selection,-   module Graphics.Rendering.OpenGL.GL.Feedback,-   module Graphics.Rendering.OpenGL.GL.DisplayLists,-   module Graphics.Rendering.OpenGL.GL.FlushFinish,-   module Graphics.Rendering.OpenGL.GL.Hints,--   -- * State and State Requests-   module Data.StateVar,-   module Data.Tensor,-   module Graphics.Rendering.OpenGL.GL.StringQueries,-   module Graphics.Rendering.OpenGL.GL.SavingState-) where--import Graphics.Rendering.OpenGL.Raw.Core31 (-   GLbitfield,  GLboolean,  GLbyte,  GLchar,  GLclampd,  GLclampf,  GLdouble,-   GLenum,  GLfloat,  GLhalf,  GLint,  GLintptr,  GLshort,  GLsizei,-   GLsizeiptr,  GLubyte,  GLuint,  GLushort )-import Graphics.Rendering.OpenGL.GL.BeginEnd-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GL.VertexArrays-import Graphics.Rendering.OpenGL.GL.BufferObjects-import Graphics.Rendering.OpenGL.GL.Rectangles-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.Clipping-import Graphics.Rendering.OpenGL.GL.RasterPos-import Graphics.Rendering.OpenGL.GL.Colors-import Graphics.Rendering.OpenGL.GL.Shaders--import Graphics.Rendering.OpenGL.GL.Antialiasing-import Graphics.Rendering.OpenGL.GL.Points-import Graphics.Rendering.OpenGL.GL.LineSegments-import Graphics.Rendering.OpenGL.GL.Polygons-import Graphics.Rendering.OpenGL.GL.PixelRectangles-import Graphics.Rendering.OpenGL.GL.Bitmaps-import Graphics.Rendering.OpenGL.GL.Texturing-import Graphics.Rendering.OpenGL.GL.ColorSum-import Graphics.Rendering.OpenGL.GL.Fog--import Graphics.Rendering.OpenGL.GL.PerFragment-import Graphics.Rendering.OpenGL.GL.Framebuffer-import Graphics.Rendering.OpenGL.GL.ReadCopyPixels--import Graphics.Rendering.OpenGL.GL.Evaluators-import Graphics.Rendering.OpenGL.GL.Selection-import Graphics.Rendering.OpenGL.GL.Feedback-import Graphics.Rendering.OpenGL.GL.DisplayLists-import Graphics.Rendering.OpenGL.GL.FlushFinish-import Graphics.Rendering.OpenGL.GL.Hints--import Data.StateVar-import Data.Tensor-import Graphics.Rendering.OpenGL.GL.StringQueries-import Graphics.Rendering.OpenGL.GL.SavingState
− Graphics/Rendering/OpenGL/GL/Antialiasing.hs 
@@ -1,40 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Antialiasing--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.2 (Antialiasing) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Antialiasing (-   sampleBuffers, samples, multisample, subpixelBits-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------sampleBuffers :: GettableStateVar GLsizei-sampleBuffers = antialiasingInfo GetSampleBuffers--samples :: GettableStateVar GLsizei-samples = antialiasingInfo GetSamples--multisample :: StateVar Capability-multisample = makeCapability CapMultisample--subpixelBits :: GettableStateVar GLsizei-subpixelBits = antialiasingInfo GetSubpixelBits--antialiasingInfo :: GetPName -> GettableStateVar GLsizei-antialiasingInfo = makeGettableStateVar . getSizei1 id
− Graphics/Rendering/OpenGL/GL/BeginEnd.hs 
@@ -1,130 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.BeginEnd--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.6 (Begin\/End Paradigm) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.BeginEnd (-   -- * Begin and End Objects-   PrimitiveMode(..),-   renderPrimitive, unsafeRenderPrimitive, primitiveRestart,--   -- * Polygon Edges-   EdgeFlag(..),-   edgeFlag-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.EdgeFlag-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.PrimitiveMode-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glBegin, glEnd, glEdgeFlag )-import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart-------------------------------------------------------------------------------------- | Delimit the vertices that define a primitive or a group of like primitives.------ Only a subset of GL commands can be used in the delimited action:--- Those for specifying vertex coordinates--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.vertex',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.vertexv'),--- vertex colors--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.color',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.colorv',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColor',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColorv',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.index',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.indexv'),--- normal--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.normal',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.normalv'),--- texture coordinates--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.texCoord',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.texCoordv',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoord',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoordv'),--- and fog coordinates--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoord',---  'Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoordv').--- Additionally,--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint1',--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint2',--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1',--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1v',--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2',--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2v',--- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbient',--- 'Graphics.Rendering.OpenGL.GL.Colors.materialDiffuse',--- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbientAndDiffuse',--- 'Graphics.Rendering.OpenGL.GL.Colors.materialSpecular',--- 'Graphics.Rendering.OpenGL.GL.Colors.materialEmission',--- 'Graphics.Rendering.OpenGL.GL.Colors.materialShininess',--- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callList',--- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callLists',--- and setting 'edgeFlag' are allowed. Writing the respective state variables--- is allowed in the delimited action, too.------ Regardless of the chosen 'PrimitiveMode', there is no limit to the number of--- vertices that can be defined during a single 'renderPrimitive'. Lines,--- triangles, quadrilaterals, and polygons that are incompletely specified are--- not drawn. Incomplete specification results when either too few vertices are--- provided to specify even a single primitive or when an incorrect multiple of--- vertices is specified. The incomplete primitive is ignored; the rest are--- drawn.------ The minimum specification of vertices for each primitive is as follows: 1--- for a point, 2 for a line, 3 for a triangle, 4 for a quadrilateral, and 3 for--- a polygon. Modes that require a certain multiple of vertices are 'Lines' (2),--- 'Triangles' (3), 'Quads' (4), and 'QuadStrip' (2).--renderPrimitive :: PrimitiveMode -> IO a -> IO a-renderPrimitive = renderPrim bracket_---- | A more efficient, but potentially dangerous version of 'renderPrimitive':--- The given action is not allowed to throw an exception.--unsafeRenderPrimitive :: PrimitiveMode -> IO a -> IO a-unsafeRenderPrimitive = renderPrim unsafeBracket_--{-# INLINE renderPrim #-}-renderPrim :: (IO () -> IO () -> IO a -> IO a) -> PrimitiveMode -> IO a -> IO a-renderPrim brack_ beginMode =-   brack_ (glBegin (marshalPrimitiveMode beginMode)) glEnd------------------------------------------------------------------------------------primitiveRestart :: IO ()-primitiveRestart = glPrimitiveRestart-------------------------------------------------------------------------------------- | Each vertex of a polygon, separate triangle, or separate quadrilateral--- specified during 'renderPrimitive' is marked as the start of either a boundary--- or nonboundary (interior) edge.------ The vertices of connected triangles and connected quadrilaterals are always--- marked as boundary, regardless of the value of the edge flag.------ Boundary and nonboundary edge flags on vertices are significant only if--- 'Graphics.Rendering.OpenGL.GL.Polygons.polygonMode' is set to--- 'Graphics.Rendering.OpenGL.GL.Polygons.Point' or--- 'Graphics.Rendering.OpenGL.GL.Polygons.Line'.------ Note that the current edge flag can be updated at any time, in particular--- during 'renderPrimitive'.--edgeFlag :: StateVar EdgeFlag-edgeFlag =-   makeStateVar (getBoolean1 unmarshalEdgeFlag GetEdgeFlag)-                (glEdgeFlag . marshalEdgeFlag)
− Graphics/Rendering/OpenGL/GL/Bitmaps.hs 
@@ -1,29 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Bitmaps--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.7 (Bitmaps) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Bitmaps (-   bitmap-) where--import Data.Tensor-import Foreign.Ptr-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glBitmap )-import Graphics.Rendering.OpenGL.GL.CoordTrans------------------------------------------------------------------------------------bitmap :: Size -> (Vertex2 GLfloat) -> (Vector2 GLfloat) -> Ptr GLubyte -> IO ()-bitmap (Size w h) (Vertex2 xbo ybo) (Vector2 xbi ybi) =-   glBitmap w h xbo ybo xbi ybi
− Graphics/Rendering/OpenGL/GL/BlendingFactor.hs 
@@ -1,77 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.BlendingFactor--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling BlendingFactor.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.BlendingFactor (-   BlendingFactor(..), marshalBlendingFactor, unmarshalBlendingFactor-) where--import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data BlendingFactor =-     Zero-   | One-   | SrcColor-   | OneMinusSrcColor-   | DstColor-   | OneMinusDstColor-   | SrcAlpha-   | OneMinusSrcAlpha-   | DstAlpha-   | OneMinusDstAlpha-   | ConstantColor-   | OneMinusConstantColor-   | ConstantAlpha-   | OneMinusConstantAlpha-   | SrcAlphaSaturate-   deriving ( Eq, Ord, Show )--marshalBlendingFactor :: BlendingFactor -> GLenum-marshalBlendingFactor x = case x of-   Zero -> gl_ZERO-   One -> gl_ONE-   SrcColor -> gl_SRC_COLOR-   OneMinusSrcColor -> gl_ONE_MINUS_SRC_COLOR-   DstColor -> gl_DST_COLOR-   OneMinusDstColor -> gl_ONE_MINUS_DST_COLOR-   SrcAlpha -> gl_SRC_ALPHA-   OneMinusSrcAlpha -> gl_ONE_MINUS_SRC_ALPHA-   DstAlpha -> gl_DST_ALPHA-   OneMinusDstAlpha -> gl_ONE_MINUS_DST_ALPHA-   ConstantColor -> gl_CONSTANT_COLOR-   OneMinusConstantColor -> gl_ONE_MINUS_CONSTANT_COLOR-   ConstantAlpha -> gl_CONSTANT_ALPHA-   OneMinusConstantAlpha -> gl_ONE_MINUS_CONSTANT_ALPHA-   SrcAlphaSaturate -> gl_SRC_ALPHA_SATURATE--unmarshalBlendingFactor :: GLenum -> BlendingFactor-unmarshalBlendingFactor x-   | x == gl_ZERO = Zero-   | x == gl_ONE = One-   | x == gl_SRC_COLOR = SrcColor-   | x == gl_ONE_MINUS_SRC_COLOR = OneMinusSrcColor-   | x == gl_DST_COLOR = DstColor-   | x == gl_ONE_MINUS_DST_COLOR = OneMinusDstColor-   | x == gl_SRC_ALPHA = SrcAlpha-   | x == gl_ONE_MINUS_SRC_ALPHA = OneMinusSrcAlpha-   | x == gl_DST_ALPHA = DstAlpha-   | x == gl_ONE_MINUS_DST_ALPHA = OneMinusDstAlpha-   | x == gl_CONSTANT_COLOR = ConstantColor-   | x == gl_ONE_MINUS_CONSTANT_COLOR = OneMinusConstantColor-   | x == gl_CONSTANT_ALPHA = ConstantAlpha-   | x == gl_ONE_MINUS_CONSTANT_ALPHA = OneMinusConstantAlpha-   | x == gl_SRC_ALPHA_SATURATE = SrcAlphaSaturate-   | otherwise = error ("unmarshalBlendingFactor: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/BufferMode.hs 
@@ -1,97 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.BufferMode--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling BufferMode.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.BufferMode (-   BufferMode(..), marshalBufferMode, unmarshalBufferMode-) where--import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( gl_AUX0 )-------------------------------------------------------------------------------------- | The set of color buffers which are selected for reading and writing.--data BufferMode =-     NoBuffers-     -- ^ No color buffers are selected.-   | FrontLeftBuffer-     -- ^ Only the front left color buffer is selected.-   | FrontRightBuffer-     -- ^ Only the front right color buffer is selected.-   | BackLeftBuffer-     -- ^ Only the  back left color buffer is selected.-   | BackRightBuffer-     -- ^ Only the back right color buffer is selected.-   | FrontBuffers-     -- ^ Only the front left and front right color buffers are selected. If-     -- there is no front right color buffer, only the front left color buffer-     -- is selected.-   | BackBuffers-     -- ^ Only the back left and back right color buffers are selected. If there-     -- is no back right color buffer, only the back left color buffer is-     -- selected.-   | LeftBuffers-     -- ^ Only the front left and back left color buffers are selected. If there-     -- is no back left color buffer, only the front left color buffer is-     -- selected.-   | RightBuffers-     -- ^ Only the front right and back right color buffers are selected. If-     -- there is no back right color buffer, only the front right color buffer-     -- is selected.-   | FrontAndBackBuffers-     -- ^ All the front and back color buffers (front left, front right, back-     -- left, back right) are selected. If there are no back color buffers, only-     -- the front left and front right color buffers are selected. If there are-     -- no right color buffers, only the front left and back left color buffers-     -- are selected. If there are no right or back color buffers, only the-     -- front left color buffer is selected.-   | AuxBuffer GLsizei-     -- ^ Only the given auxiliary color buffer no. /i/ is selected.-   deriving ( Eq, Ord, Show )--marshalBufferMode :: BufferMode -> Maybe GLenum-marshalBufferMode x = case x of-   NoBuffers -> Just gl_NONE-   FrontLeftBuffer -> Just gl_FRONT_LEFT-   FrontRightBuffer -> Just gl_FRONT_RIGHT-   BackLeftBuffer -> Just gl_BACK_LEFT-   BackRightBuffer -> Just gl_BACK_RIGHT-   FrontBuffers -> Just gl_FRONT-   BackBuffers -> Just gl_BACK-   LeftBuffers -> Just gl_LEFT-   RightBuffers -> Just gl_RIGHT-   FrontAndBackBuffers -> Just gl_FRONT_AND_BACK-   AuxBuffer i-      | fromIntegral i <= maxAuxBuffer -> Just (gl_AUX0 + fromIntegral i)-      | otherwise -> Nothing--unmarshalBufferMode :: GLenum -> BufferMode-unmarshalBufferMode x-   | x == gl_NONE = NoBuffers-   | x == gl_FRONT_LEFT = FrontLeftBuffer-   | x == gl_FRONT_RIGHT = FrontRightBuffer-   | x == gl_BACK_LEFT = BackLeftBuffer-   | x == gl_BACK_RIGHT = BackRightBuffer-   | x == gl_FRONT = FrontBuffers-   | x == gl_BACK = BackBuffers-   | x == gl_LEFT = LeftBuffers-   | x == gl_RIGHT = RightBuffers-   | x == gl_FRONT_AND_BACK = FrontAndBackBuffers-   | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = AuxBuffer (fromIntegral (x - gl_AUX0))-   | otherwise = error ("unmarshalBufferMode: illegal value " ++ show x)--maxAuxBuffer :: GLenum-maxAuxBuffer = 246
− Graphics/Rendering/OpenGL/GL/BufferObjects.hs 
@@ -1,293 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.BufferObjects--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.9 (Buffer Objects) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.BufferObjects (-   -- * Object Names-   module Data.ObjectName,--   -- * Buffer Objects-   BufferObject(BufferObject),--   -- * Binding Buffer Objects-   BufferTarget(..), bindBuffer, arrayBufferBinding,-   vertexAttribArrayBufferBinding,--   -- * Handling Buffer Data-   BufferUsage(..), bufferData, TransferDirection(..), bufferSubData,--   -- * Mapping Buffer Objects-   BufferAccess(..), MappingFailure(..), withMappedBuffer,-   mapBuffer, unmapBuffer,-   bufferAccess, bufferMapped-) where--import Data.ObjectName-import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexArrays-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------newtype BufferObject = BufferObject { bufferID :: GLuint }-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------instance ObjectName BufferObject where-   genObjectNames n =-      allocaArray n $ \buf -> do-        glGenBuffers (fromIntegral n) buf-        fmap (map BufferObject) $ peekArray n buf--   deleteObjectNames bufferObjects =-      withArrayLen (map bufferID bufferObjects) $-         glDeleteBuffers . fromIntegral--   isObjectName = fmap unmarshalGLboolean . glIsBuffer . bufferID------------------------------------------------------------------------------------data BufferTarget =-     ArrayBuffer-   | CopyReadBuffer-   | CopyWriteBuffer-   | ElementArrayBuffer-   | PixelPackBuffer-   | PixelUnpackBuffer-   deriving ( Eq, Ord, Show )--marshalBufferTarget :: BufferTarget -> GLenum-marshalBufferTarget x = case x of-   ArrayBuffer -> gl_ARRAY_BUFFER-   CopyReadBuffer -> gl_COPY_READ_BUFFER-   CopyWriteBuffer -> gl_COPY_WRITE_BUFFER-   ElementArrayBuffer -> gl_ELEMENT_ARRAY_BUFFER-   PixelPackBuffer -> gl_PIXEL_PACK_BUFFER-   PixelUnpackBuffer -> gl_PIXEL_UNPACK_BUFFER--bufferTargetToGetPName :: BufferTarget -> GetPName-bufferTargetToGetPName x = case x of-   ArrayBuffer -> GetArrayBufferBinding-   ElementArrayBuffer -> GetElementArrayBufferBinding-   CopyReadBuffer -> GetCopyReadBuffer-   CopyWriteBuffer -> GetCopyWriteBuffer-   PixelPackBuffer -> GetPixelPackBufferBinding-   PixelUnpackBuffer -> GetPixelUnpackBufferBinding------------------------------------------------------------------------------------data BufferUsage =-     StreamDraw-   | StreamRead-   | StreamCopy-   | StaticDraw-   | StaticRead-   | StaticCopy-   | DynamicDraw-   | DynamicRead-   | DynamicCopy-   deriving ( Eq, Ord, Show )--marshalBufferUsage :: BufferUsage -> GLenum-marshalBufferUsage x = case x of-   StreamDraw -> gl_STREAM_DRAW-   StreamRead -> gl_STREAM_READ-   StreamCopy -> gl_STREAM_COPY-   StaticDraw -> gl_STATIC_DRAW-   StaticRead -> gl_STATIC_READ-   StaticCopy -> gl_STATIC_COPY-   DynamicDraw -> gl_DYNAMIC_DRAW-   DynamicRead -> gl_DYNAMIC_READ-   DynamicCopy -> gl_DYNAMIC_COPY--unmarshalBufferUsage :: GLenum -> BufferUsage-unmarshalBufferUsage x-   | x == gl_STREAM_DRAW = StreamDraw-   | x == gl_STREAM_READ = StreamRead-   | x == gl_STREAM_COPY = StreamCopy-   | x == gl_STATIC_DRAW = StaticDraw-   | x == gl_STATIC_READ = StaticRead-   | x == gl_STATIC_COPY = StaticCopy-   | x == gl_DYNAMIC_DRAW = DynamicDraw-   | x == gl_DYNAMIC_READ = DynamicRead-   | x == gl_DYNAMIC_COPY = DynamicCopy-   | otherwise = error ("unmarshalBufferUsage: illegal value " ++ show x)------------------------------------------------------------------------------------data BufferAccess =-     ReadOnly-   | WriteOnly-   | ReadWrite-   deriving ( Eq, Ord, Show )--marshalBufferAccess :: BufferAccess -> GLenum-marshalBufferAccess x = case x of-   ReadOnly -> gl_READ_ONLY-   WriteOnly -> gl_WRITE_ONLY-   ReadWrite -> gl_READ_WRITE--unmarshalBufferAccess :: GLenum -> BufferAccess-unmarshalBufferAccess x-   | x == gl_READ_ONLY = ReadOnly-   | x == gl_WRITE_ONLY = WriteOnly-   | x == gl_READ_WRITE = ReadWrite-   | otherwise = error ("unmarshalBufferAccess: illegal value " ++ show x)------------------------------------------------------------------------------------bindBuffer :: BufferTarget -> StateVar (Maybe BufferObject)-bindBuffer t = makeStateVar (getBindBuffer t) (setBindBuffer t)--getBindBuffer :: BufferTarget -> IO (Maybe BufferObject)-getBindBuffer = bufferQuery bufferTargetToGetPName--bufferQuery :: (a -> GetPName) -> a -> IO (Maybe BufferObject)-bufferQuery func t = do-   buf <- getInteger1 (BufferObject . fromIntegral) (func t)-   return $ if buf == noBufferObject then Nothing else Just buf--noBufferObject :: BufferObject-noBufferObject = BufferObject 0--setBindBuffer :: BufferTarget -> Maybe BufferObject -> IO ()-setBindBuffer t =-   glBindBuffer (marshalBufferTarget t) . bufferID . maybe noBufferObject id--clientArrayTypeToGetPName :: ClientArrayType -> GetPName-clientArrayTypeToGetPName x = case x of-   VertexArray -> GetVertexArrayBufferBinding-   NormalArray -> GetNormalArrayBufferBinding-   ColorArray -> GetColorArrayBufferBinding-   IndexArray -> GetIndexArrayBufferBinding-   TextureCoordArray -> GetTextureCoordArrayBufferBinding-   EdgeFlagArray -> GetEdgeFlagArrayBufferBinding-   FogCoordArray -> GetFogCoordArrayBufferBinding-   SecondaryColorArray -> GetSecondaryColorArrayBufferBinding-   MatrixIndexArray -> error "clientArrayTypeToGetPName: impossible"--arrayBufferBinding :: ClientArrayType -> GettableStateVar (Maybe BufferObject)-arrayBufferBinding t =-   makeGettableStateVar $ case t of-      MatrixIndexArray -> do recordInvalidEnum ; return Nothing-      _ -> bufferQuery clientArrayTypeToGetPName t---vertexAttribArrayBufferBinding :: AttribLocation -> GettableStateVar (Maybe BufferObject)-vertexAttribArrayBufferBinding location =-   makeGettableStateVar $ do-      buf <- getVertexAttribInteger1 (BufferObject . fromIntegral) location GetVertexAttribArrayBufferBinding-      return $ if buf == noBufferObject then Nothing else Just buf------------------------------------------------------------------------------------bufferData :: BufferTarget -> StateVar (GLsizeiptr, Ptr a, BufferUsage)-bufferData t = makeStateVar (getBufferData t) (setBufferData t)--getBufferData :: BufferTarget -> IO (GLsizeiptr, Ptr a, BufferUsage)-getBufferData t = do-   s <- getBufferParameter t fromIntegral GetBufferSize-   p <- getBufferPointer t-   u <- getBufferParameter t unmarshalBufferUsage GetBufferUsage-   return (s, p, u)--setBufferData :: BufferTarget -> (GLsizeiptr, Ptr a, BufferUsage) -> IO ()-setBufferData t (s, p, u) =-   glBufferData (marshalBufferTarget t) s p (marshalBufferUsage u)------------------------------------------------------------------------------------data TransferDirection =-     ReadFromBuffer-   | WriteToBuffer-   deriving ( Eq, Ord, Show )--bufferSubData ::-   BufferTarget -> TransferDirection -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()-bufferSubData t WriteToBuffer = glBufferSubData (marshalBufferTarget t)-bufferSubData t ReadFromBuffer = glGetBufferSubData (marshalBufferTarget t)------------------------------------------------------------------------------------data GetBufferPName =-     GetBufferSize-   | GetBufferUsage-   | GetBufferAccess-   | GetBufferMapped--marshalGetBufferPName :: GetBufferPName -> GLenum-marshalGetBufferPName x = case x of-   GetBufferSize -> gl_BUFFER_SIZE-   GetBufferUsage -> gl_BUFFER_USAGE-   GetBufferAccess -> gl_BUFFER_ACCESS-   GetBufferMapped -> gl_BUFFER_MAPPED--getBufferParameter :: BufferTarget -> (GLenum -> a) -> GetBufferPName -> IO a-getBufferParameter t f p = alloca $ \buf -> do-   glGetBufferParameteriv (marshalBufferTarget t)-                          (marshalGetBufferPName p) buf-   peek1 (f . fromIntegral) buf------------------------------------------------------------------------------------getBufferPointer :: BufferTarget -> IO (Ptr a)-getBufferPointer t = alloca $ \buf -> do-   glGetBufferPointerv (marshalBufferTarget t) gl_BUFFER_MAP_POINTER buf-   peek buf------------------------------------------------------------------------------------data MappingFailure =-     MappingFailed-   | UnmappingFailed-   deriving ( Eq, Ord, Show )---- | Convenience function for an exception-safe combination of 'mapBuffer' and--- 'unmapBuffer'.-withMappedBuffer :: BufferTarget -> BufferAccess -> (Ptr a -> IO b) -> (MappingFailure -> IO b) -> IO b-withMappedBuffer t a action err = do-   maybeBuf <- mapBuffer t a-   case maybeBuf  of-      Nothing -> err MappingFailed-      Just buf -> do (ret, ok) <- action buf `finallyRet` unmapBuffer t-                     if ok-                        then return ret-                        else err UnmappingFailed--mapBuffer :: BufferTarget -> BufferAccess -> IO (Maybe (Ptr a))-mapBuffer t = fmap (maybeNullPtr Nothing Just) . mapBuffer_ t--mapBuffer_ :: BufferTarget -> BufferAccess -> IO (Ptr a)-mapBuffer_ t = glMapBuffer (marshalBufferTarget t) . marshalBufferAccess--unmapBuffer :: BufferTarget -> IO Bool-unmapBuffer = fmap unmarshalGLboolean . glUnmapBuffer . marshalBufferTarget--bufferAccess :: BufferTarget -> GettableStateVar BufferAccess-bufferAccess t = makeGettableStateVar $-   getBufferParameter t unmarshalBufferAccess GetBufferAccess--bufferMapped :: BufferTarget -> GettableStateVar Bool-bufferMapped t = makeGettableStateVar $-   getBufferParameter t unmarshalGLboolean GetBufferMapped
− Graphics/Rendering/OpenGL/GL/Capability.hs 
@@ -1,289 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Capability--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for handling OpenGL capabilities, i.e.--- boolean state variables.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Capability (-   Capability(..), marshalCapability, unmarshalCapability,-   EnableCap(..), makeCapability, makeStateVarMaybe-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_ALPHA_TEST, gl_AUTO_NORMAL, gl_COLOR_ARRAY, gl_COLOR_MATERIAL,-   gl_COLOR_SUM, gl_COLOR_TABLE, gl_CONVOLUTION_1D, gl_CONVOLUTION_2D,-   gl_EDGE_FLAG_ARRAY, gl_FOG, gl_FOG_COORD_ARRAY, gl_HISTOGRAM, gl_INDEX_ARRAY,-   gl_INDEX_LOGIC_OP, gl_LIGHTING, gl_LINE_STIPPLE, gl_MAP1_COLOR_4,-   gl_MAP1_INDEX, gl_MAP1_NORMAL, gl_MAP1_TEXTURE_COORD_1,-   gl_MAP1_TEXTURE_COORD_2, gl_MAP1_TEXTURE_COORD_3, gl_MAP1_TEXTURE_COORD_4,-   gl_MAP1_VERTEX_3, gl_MAP1_VERTEX_4, gl_MAP2_COLOR_4, gl_MAP2_INDEX,-   gl_MAP2_NORMAL, gl_MAP2_TEXTURE_COORD_1, gl_MAP2_TEXTURE_COORD_2,-   gl_MAP2_TEXTURE_COORD_3, gl_MAP2_TEXTURE_COORD_4, gl_MAP2_VERTEX_3,-   gl_MAP2_VERTEX_4, gl_MINMAX, gl_NORMALIZE, gl_NORMAL_ARRAY, gl_POINT_SMOOTH,-   gl_POINT_SPRITE, gl_POLYGON_STIPPLE, gl_POST_COLOR_MATRIX_COLOR_TABLE,-   gl_POST_CONVOLUTION_COLOR_TABLE, gl_RESCALE_NORMAL, gl_SECONDARY_COLOR_ARRAY,-   gl_SEPARABLE_2D, gl_TEXTURE_COORD_ARRAY, gl_TEXTURE_GEN_Q, gl_TEXTURE_GEN_R,-   gl_TEXTURE_GEN_S, gl_TEXTURE_GEN_T, gl_VERTEX_ARRAY,-   gl_VERTEX_PROGRAM_TWO_SIDE )-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette ( gl_MATRIX_INDEX_ARRAY, gl_MATRIX_PALETTE )-import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend ( gl_WEIGHT_SUM_UNITY, gl_VERTEX_BLEND, gl_WEIGHT_ARRAY )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( gl_DEPTH_BOUNDS_TEST )-import Graphics.Rendering.OpenGL.Raw.EXT.SharedTexturePalette ( gl_SHARED_TEXTURE_PALETTE )-import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( gl_STENCIL_TEST_TWO_SIDE )-import Graphics.Rendering.OpenGL.Raw.NV.DepthClamp ( gl_DEPTH_CLAMP )------------------------------------------------------------------------------------data Capability =-     Disabled-   | Enabled-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------marshalCapability :: Capability -> GLboolean-marshalCapability = marshalGLboolean . (Enabled ==)--unmarshalCapability :: GLboolean -> Capability-unmarshalCapability x = if unmarshalGLboolean x then Enabled else Disabled------------------------------------------------------------------------------------data EnableCap =-     CapFog-   | CapLighting-   | CapTexture1D-   | CapTexture2D-   | CapTextureRectangle-   | CapLineStipple-   | CapPolygonStipple-   | CapCullFace-   | CapAlphaTest-   | CapBlend-   | CapIndexLogicOp-   | CapColorLogicOp-   | CapDither-   | CapStencilTest-   | CapDepthTest-   | CapClipPlane GLsizei-   | CapLight GLsizei-   | CapTextureGenS-   | CapTextureGenT-   | CapTextureGenR-   | CapTextureGenQ-   | CapMap1Vertex3-   | CapMap1Vertex4-   | CapMap1Color4-   | CapMap1Index-   | CapMap1Normal-   | CapMap1TextureCoord1-   | CapMap1TextureCoord2-   | CapMap1TextureCoord3-   | CapMap1TextureCoord4-   | CapMap2Vertex3-   | CapMap2Vertex4-   | CapMap2Color4-   | CapMap2Index-   | CapMap2Normal-   | CapMap2TextureCoord1-   | CapMap2TextureCoord2-   | CapMap2TextureCoord3-   | CapMap2TextureCoord4-   | CapPointSmooth-   | CapLineSmooth-   | CapPolygonSmooth-   | CapScissorTest-   | CapColorMaterial-   | CapNormalize-   | CapAutoNormal-   | CapPolygonOffsetPoint-   | CapPolygonOffsetLine-   | CapPolygonOffsetFill-   | CapVertexArray-   | CapNormalArray-   | CapColorArray-   | CapIndexArray-   | CapTextureCoordArray-   | CapEdgeFlagArray-   | CapFogCoordArray-   | CapSecondaryColorArray-   | CapMatrixIndexArray-   | CapConvolution1D-   | CapConvolution2D-   | CapSeparable2D-   | CapHistogram-   | CapMinmax-   | CapRescaleNormal-   | CapSharedTexturePalette-   | CapTexture3D-   | CapMultisample-   | CapSampleAlphaToCoverage-   | CapSampleAlphaToOne-   | CapSampleCoverage-   | CapColorTable-   | CapPostConvolutionColorTable-   | CapPostColorMatrixColorTable-   | CapColorSum-   | CapTextureCubeMap-   | CapWeightSumUnity-   | CapVertexBlend-   | CapWeightArray-   | CapMatrixPalette-   | CapDepthClamp-   | CapDepthBoundsTest-   | CapPrimitiveRestart-   | CapPointSprite-   | CapStencilTestTwoSide-   | CapRasterPositionUnclipped-   | CapTextureColorTable-   | CapVertexProgramPointSize-   | CapVertexProgramTwoSide--marshalEnableCap :: EnableCap -> Maybe GLenum-marshalEnableCap x = case x of-   CapFog -> Just gl_FOG-   CapLighting -> Just gl_LIGHTING-   CapTexture1D -> Just gl_TEXTURE_1D-   CapTexture2D -> Just gl_TEXTURE_2D-   CapTextureRectangle -> Just gl_TEXTURE_RECTANGLE-   CapLineStipple -> Just gl_LINE_STIPPLE-   CapPolygonStipple -> Just gl_POLYGON_STIPPLE-   CapCullFace -> Just gl_CULL_FACE-   CapAlphaTest -> Just gl_ALPHA_TEST-   CapBlend -> Just gl_BLEND-   CapIndexLogicOp -> Just gl_INDEX_LOGIC_OP-   CapColorLogicOp -> Just gl_COLOR_LOGIC_OP-   CapDither -> Just gl_DITHER-   CapStencilTest -> Just gl_STENCIL_TEST-   CapDepthTest -> Just gl_DEPTH_TEST-   CapClipPlane i -> clipPlaneIndexToEnum i-   CapLight i -> lightIndexToEnum i-   CapTextureGenS -> Just gl_TEXTURE_GEN_S-   CapTextureGenT -> Just gl_TEXTURE_GEN_T-   CapTextureGenR -> Just gl_TEXTURE_GEN_R-   CapTextureGenQ -> Just gl_TEXTURE_GEN_Q-   CapMap1Vertex3 -> Just gl_MAP1_VERTEX_3-   CapMap1Vertex4 -> Just gl_MAP1_VERTEX_4-   CapMap1Color4 -> Just gl_MAP1_COLOR_4-   CapMap1Index -> Just gl_MAP1_INDEX-   CapMap1Normal -> Just gl_MAP1_NORMAL-   CapMap1TextureCoord1 -> Just gl_MAP1_TEXTURE_COORD_1-   CapMap1TextureCoord2 -> Just gl_MAP1_TEXTURE_COORD_2-   CapMap1TextureCoord3 -> Just gl_MAP1_TEXTURE_COORD_3-   CapMap1TextureCoord4 -> Just gl_MAP1_TEXTURE_COORD_4-   CapMap2Vertex3 -> Just gl_MAP2_VERTEX_3-   CapMap2Vertex4 -> Just gl_MAP2_VERTEX_4-   CapMap2Color4 -> Just gl_MAP2_COLOR_4-   CapMap2Index -> Just gl_MAP2_INDEX-   CapMap2Normal -> Just gl_MAP2_NORMAL-   CapMap2TextureCoord1 -> Just gl_MAP2_TEXTURE_COORD_1-   CapMap2TextureCoord2 -> Just gl_MAP2_TEXTURE_COORD_2-   CapMap2TextureCoord3 -> Just gl_MAP2_TEXTURE_COORD_3-   CapMap2TextureCoord4 -> Just gl_MAP2_TEXTURE_COORD_4-   CapPointSmooth -> Just gl_POINT_SMOOTH-   CapLineSmooth -> Just gl_LINE_SMOOTH-   CapPolygonSmooth -> Just gl_POLYGON_SMOOTH-   CapScissorTest -> Just gl_SCISSOR_TEST-   CapColorMaterial -> Just gl_COLOR_MATERIAL-   CapNormalize -> Just gl_NORMALIZE-   CapAutoNormal -> Just gl_AUTO_NORMAL-   CapPolygonOffsetPoint -> Just gl_POLYGON_OFFSET_POINT-   CapPolygonOffsetLine -> Just gl_POLYGON_OFFSET_LINE-   CapPolygonOffsetFill -> Just gl_POLYGON_OFFSET_FILL-   CapVertexArray -> Just gl_VERTEX_ARRAY-   CapNormalArray -> Just gl_NORMAL_ARRAY-   CapColorArray -> Just gl_COLOR_ARRAY-   CapIndexArray -> Just gl_INDEX_ARRAY-   CapTextureCoordArray -> Just gl_TEXTURE_COORD_ARRAY-   CapEdgeFlagArray -> Just gl_EDGE_FLAG_ARRAY-   CapFogCoordArray -> Just gl_FOG_COORD_ARRAY-   CapSecondaryColorArray -> Just gl_SECONDARY_COLOR_ARRAY-   CapMatrixIndexArray -> Just gl_MATRIX_INDEX_ARRAY-   CapConvolution1D -> Just gl_CONVOLUTION_1D-   CapConvolution2D -> Just gl_CONVOLUTION_2D-   CapSeparable2D -> Just gl_SEPARABLE_2D-   CapHistogram -> Just gl_HISTOGRAM-   CapMinmax -> Just gl_MINMAX-   CapRescaleNormal -> Just gl_RESCALE_NORMAL-   CapSharedTexturePalette -> Just gl_SHARED_TEXTURE_PALETTE-   CapTexture3D -> Just gl_TEXTURE_3D-   CapMultisample -> Just gl_MULTISAMPLE-   CapSampleAlphaToCoverage -> Just gl_SAMPLE_ALPHA_TO_COVERAGE-   CapSampleAlphaToOne -> Just gl_SAMPLE_ALPHA_TO_ONE-   CapSampleCoverage -> Just gl_SAMPLE_COVERAGE-   CapColorTable -> Just gl_COLOR_TABLE-   CapPostConvolutionColorTable -> Just gl_POST_CONVOLUTION_COLOR_TABLE-   CapPostColorMatrixColorTable -> Just gl_POST_COLOR_MATRIX_COLOR_TABLE-   CapColorSum -> Just gl_COLOR_SUM-   CapTextureCubeMap -> Just gl_TEXTURE_CUBE_MAP-   CapWeightSumUnity -> Just gl_WEIGHT_SUM_UNITY-   CapVertexBlend -> Just gl_VERTEX_BLEND-   CapWeightArray -> Just gl_WEIGHT_ARRAY-   CapMatrixPalette -> Just gl_MATRIX_PALETTE-   CapDepthClamp -> Just gl_DEPTH_CLAMP-   CapDepthBoundsTest -> Just gl_DEPTH_BOUNDS_TEST-   CapPrimitiveRestart -> Just gl_PRIMITIVE_RESTART-   CapPointSprite -> Just gl_POINT_SPRITE-   CapStencilTestTwoSide -> Just gl_STENCIL_TEST_TWO_SIDE-   -- TODO: use RASTER_POSITION_UNCLIPPED_IBM from IBM_rasterpos_clip extension-   CapRasterPositionUnclipped -> Just 0x19262-   -- TODO: use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension-   CapTextureColorTable -> Just 0x80bc-   CapVertexProgramPointSize -> Just gl_VERTEX_PROGRAM_POINT_SIZE-   CapVertexProgramTwoSide -> Just gl_VERTEX_PROGRAM_TWO_SIDE------------------------------------------------------------------------------------makeCapability :: EnableCap -> StateVar Capability-makeCapability cap = makeStateVar (isEnabled cap) (enable cap)------------------------------------------------------------------------------------isEnabled :: EnableCap -> IO Capability-isEnabled =-   maybe (do recordInvalidEnum; return Disabled)-         (fmap unmarshalCapability . glIsEnabled) .-   marshalEnableCap------------------------------------------------------------------------------------enable :: EnableCap -> Capability -> IO ()-enable cap state = maybe recordInvalidEnum (f state) (marshalEnableCap cap)-   where f Disabled = glDisable-         f Enabled  = glEnable------------------------------------------------------------------------------------makeStateVarMaybe :: IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)-makeStateVarMaybe getCap getAct setAct =-   makeStateVar-      (getStateVarMaybe getCap getAct)-      (setStateVarMaybe getCap setAct)--getStateVarMaybe :: IO EnableCap -> IO a -> IO (Maybe a)-getStateVarMaybe getCap act = do-   capability <- fmap makeCapability getCap-   state <- get capability-   if state == Enabled-      then fmap Just act-      else return Nothing--setStateVarMaybe :: IO EnableCap -> (a -> IO ()) -> Maybe a -> IO ()-setStateVarMaybe getCap act val = do-   capability <- fmap makeCapability getCap-   maybe (capability $= Disabled) (\x -> act x >> capability $= Enabled) val
− Graphics/Rendering/OpenGL/GL/Clipping.hs 
@@ -1,54 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Clipping--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.12 (Clipping) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Clipping (-   ClipPlaneName(..), clipPlane, maxClipPlanes-) where--import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Marshal.Utils-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glClipPlane )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------newtype ClipPlaneName = ClipPlaneName GLsizei-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------clipPlane :: ClipPlaneName -> StateVar (Maybe (Plane GLdouble))-clipPlane (ClipPlaneName i) =-   makeStateVarMaybe-      (return (CapClipPlane i))-      (alloca $ \buf -> do-          getDoublev (GetClipPlane i) (castPtr buf)-          peek1 id (buf :: Ptr (Plane GLdouble)))-      (\plane -> maybe recordInvalidEnum (with plane . glClipPlane_)-                       (clipPlaneIndexToEnum i))--glClipPlane_ :: GLenum -> Ptr (Plane GLdouble) -> IO ()-glClipPlane_ plane ptr = glClipPlane plane (castPtr ptr)------------------------------------------------------------------------------------maxClipPlanes :: GettableStateVar GLsizei-maxClipPlanes = makeGettableStateVar (getSizei1 id GetMaxClipPlanes)
− Graphics/Rendering/OpenGL/GL/ColorSum.hs 
@@ -1,25 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.ColorSum--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.9 (Color Sum) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.ColorSum (-   colorSum-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.Capability------------------------------------------------------------------------------------colorSum :: StateVar Capability-colorSum = makeCapability CapColorSum
− Graphics/Rendering/OpenGL/GL/Colors.hs 
@@ -1,468 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Colors--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.14 (Colors and Coloring) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Colors (-   -- * Lighting-   lighting, Light(..), light, maxLights,-   FrontFaceDirection(..), frontFace,--   -- * Lighting Parameter Specification-   Face(..),-   materialAmbient, materialDiffuse, materialAmbientAndDiffuse,-   materialSpecular, materialEmission, materialShininess, maxShininess,-   materialColorIndexes,--   ambient, diffuse, specular,-   position, spotDirection, spotExponent, maxSpotExponent, spotCutoff,-   attenuation,--   lightModelAmbient, lightModelLocalViewer, lightModelTwoSide,-   vertexProgramTwoSide,-   LightModelColorControl(..), lightModelColorControl,--   -- * ColorMaterial-   ColorMaterialParameter(..), colorMaterial,--   -- * Flatshading-   ShadingModel(..), shadeModel-) where--import Control.Monad-import Data.StateVar-import Data.Tensor-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.Face-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glColorMaterial, glGetLightfv, glGetMaterialfv, glGetMaterialiv,-   glLightModelfv, glLightModeli, glLightfv, glMaterialfv, glMaterialiv,-   glShadeModel, gl_AMBIENT, gl_AMBIENT_AND_DIFFUSE, gl_COLOR_INDEXES,-   gl_CONSTANT_ATTENUATION, gl_DIFFUSE, gl_EMISSION, gl_FLAT,-   gl_LIGHT_MODEL_AMBIENT, gl_LIGHT_MODEL_COLOR_CONTROL,-   gl_LIGHT_MODEL_LOCAL_VIEWER, gl_LIGHT_MODEL_TWO_SIDE, gl_LINEAR_ATTENUATION,-   gl_POSITION, gl_QUADRATIC_ATTENUATION, gl_SEPARATE_SPECULAR_COLOR,-   gl_SHININESS, gl_SINGLE_COLOR, gl_SMOOTH, gl_SPECULAR, gl_SPOT_CUTOFF,-   gl_SPOT_DIRECTION, gl_SPOT_EXPONENT )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------lighting :: StateVar Capability-lighting = makeCapability CapLighting------------------------------------------------------------------------------------newtype Light = Light GLsizei-   deriving ( Eq, Ord, Show )--marshalLight :: Light -> Maybe GLenum-marshalLight (Light l) = lightIndexToEnum l------------------------------------------------------------------------------------light :: Light -> StateVar Capability-light (Light l) = makeCapability (CapLight l)--maxLights :: GettableStateVar GLsizei-maxLights = makeGettableStateVar (getSizei1 id GetMaxLights)------------------------------------------------------------------------------------data FrontFaceDirection =-     CW-   | CCW-   deriving ( Eq, Ord, Show )--marshalFrontFaceDirection :: FrontFaceDirection -> GLenum-marshalFrontFaceDirection x = case x of-   CW -> gl_CW-   CCW -> gl_CCW--unmarshalFrontFaceDirection :: GLenum -> FrontFaceDirection-unmarshalFrontFaceDirection x-   | x == gl_CW = CW-   | x == gl_CCW = CCW-   | otherwise = error ("unmarshalFrontFaceDirection: illegal value " ++ show x)------------------------------------------------------------------------------------frontFace :: StateVar FrontFaceDirection-frontFace =-   makeStateVar-      (getEnum1 unmarshalFrontFaceDirection GetFrontFace)-      (glFrontFace . marshalFrontFaceDirection)------------------------------------------------------------------------------------data MaterialParameter =-     MaterialEmission-   | MaterialShininess-   | MaterialAmbientAndDiffuse-   | MaterialColorIndexes-   | MaterialAmbient-   | MaterialDiffuse-   | MaterialSpecular--marshalMaterialParameter :: MaterialParameter -> GLenum-marshalMaterialParameter x = case x of-   MaterialEmission -> gl_EMISSION-   MaterialShininess -> gl_SHININESS-   MaterialAmbientAndDiffuse -> gl_AMBIENT_AND_DIFFUSE-   MaterialColorIndexes -> gl_COLOR_INDEXES-   MaterialAmbient -> gl_AMBIENT-   MaterialDiffuse -> gl_DIFFUSE-   MaterialSpecular -> gl_SPECULAR------------------------------------------------------------------------------------materialAmbient :: Face -> StateVar (Color4 GLfloat)-materialAmbient =-   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialAmbient--materialDiffuse :: Face -> StateVar (Color4 GLfloat)-materialDiffuse =-   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialDiffuse--materialAmbientAndDiffuse :: Face -> StateVar (Color4 GLfloat)-materialAmbientAndDiffuse =-   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialAmbientAndDiffuse--materialSpecular :: Face -> StateVar (Color4 GLfloat)-materialSpecular =-   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialSpecular--materialEmission :: Face -> StateVar (Color4 GLfloat)-materialEmission =-   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialEmission--makeMaterialVar :: Storable a-                => (GLenum -> GLenum -> Ptr a -> IO ())-                -> (GLenum -> GLenum -> Ptr a -> IO ())-                -> MaterialParameter -> Face -> StateVar a-makeMaterialVar getter setter materialParameter face =-   makeStateVar (alloca $ \buf -> do getter f mp buf ; peek buf)-                (\val -> with val $ setter f mp)-   where mp = marshalMaterialParameter materialParameter-         f  = marshalFace face--glGetMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glGetMaterialfvc face pname ptr = glGetMaterialfv face pname (castPtr ptr)--glMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glMaterialfvc face pname ptr = glMaterialfv face pname (castPtr ptr)------------------------------------------------------------------------------------materialShininess :: Face -> StateVar GLfloat-materialShininess =-   makeMaterialVar glGetMaterialfvf glMaterialff MaterialShininess--glGetMaterialfvf :: GLenum -> GLenum -> Ptr GLfloat -> IO ()-glGetMaterialfvf face pname ptr = glGetMaterialfv face pname (castPtr ptr)--glMaterialff :: GLenum -> GLenum -> Ptr GLfloat -> IO ()-glMaterialff face pname ptr = glMaterialfv face pname (castPtr ptr)--maxShininess :: GettableStateVar GLfloat-maxShininess = makeGettableStateVar $ getFloat1 id GetMaxShininess-------------------------------------------------------------------------------------- Alas, (Index1 GLint, Index1 GLint, Index1 GLint) is not an instance of--- Storable...--materialColorIndexes ::-   Face -> StateVar (Index1 GLint, Index1 GLint, Index1 GLint)-materialColorIndexes face =-   makeStateVar (getMaterialColorIndexes face) (setMaterialColorIndexes face)--getMaterialColorIndexes :: Face -> IO (Index1 GLint, Index1 GLint, Index1 GLint)-getMaterialColorIndexes face =-   allocaArray 3 $ \buf -> do-      glGetMaterialiv (marshalFace face)-                      (marshalMaterialParameter MaterialColorIndexes)-                      buf-      peek3 (\a d s -> (Index1 a, Index1 d, Index1 s)) buf--setMaterialColorIndexes ::-   Face -> (Index1 GLint, Index1 GLint, Index1 GLint) -> IO ()-setMaterialColorIndexes face (Index1 a, Index1 d, Index1 s) =-   withArray [a, d, s] $-      glMaterialiv (marshalFace face)-                   (marshalMaterialParameter MaterialColorIndexes)------------------------------------------------------------------------------------data LightParameter =-     Ambient'-   | Diffuse'-   | Specular'-   | Position-   | SpotDirection-   | SpotExponent-   | SpotCutoff-   | ConstantAttenuation-   | LinearAttenuation-   | QuadraticAttenuation--marshalLightParameter :: LightParameter -> GLenum-marshalLightParameter x = case x of-   Ambient' -> gl_AMBIENT-   Diffuse' -> gl_DIFFUSE-   Specular' -> gl_SPECULAR-   Position -> gl_POSITION-   SpotDirection -> gl_SPOT_DIRECTION-   SpotExponent -> gl_SPOT_EXPONENT-   SpotCutoff -> gl_SPOT_CUTOFF-   ConstantAttenuation -> gl_CONSTANT_ATTENUATION-   LinearAttenuation -> gl_LINEAR_ATTENUATION-   QuadraticAttenuation -> gl_QUADRATIC_ATTENUATION------------------------------------------------------------------------------------ambient :: Light -> StateVar (Color4 GLfloat)-ambient = makeLightVar glGetLightfvc glLightfvc Ambient' black--black :: Color4 GLfloat-black = Color4 0 0 0 0--diffuse :: Light -> StateVar (Color4 GLfloat)-diffuse = makeLightVar glGetLightfvc glLightfvc Diffuse' black--specular :: Light -> StateVar (Color4 GLfloat)-specular = makeLightVar glGetLightfvc glLightfvc Specular' black--makeLightVar :: Storable a-             => (GLenum -> GLenum -> Ptr a -> IO ())-             -> (GLenum -> GLenum -> Ptr a -> IO ())-             -> LightParameter -> a -> Light -> StateVar a-makeLightVar getter setter lightParameter defaultValue theLight =-   makeStateVar (maybe (return defaultValue) getLightVar ml)-                (\val -> maybe recordInvalidEnum (setLightVar val) ml)-   where lp          = marshalLightParameter lightParameter-         ml          = marshalLight theLight-         getLightVar = \l -> alloca $ \buf -> do getter l lp buf ; peek buf-         setLightVar = \val l -> with val $ setter l lp--glGetLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glGetLightfvc l pname ptr = glGetLightfv l pname (castPtr ptr)--glLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glLightfvc l pname ptr = glLightfv l pname (castPtr ptr)------------------------------------------------------------------------------------position :: Light -> StateVar (Vertex4 GLfloat)-position = makeLightVar glGetLightfvv glLightfvv Position (Vertex4 0 0 0 0)--glLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()-glLightfvv l pname ptr = glLightfv l pname (castPtr ptr)--glGetLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()-glGetLightfvv l pname ptr = glGetLightfv l pname (castPtr ptr)------------------------------------------------------------------------------------spotDirection :: Light -> StateVar (Normal3 GLfloat)-spotDirection =-   makeLightVar glGetLightfvn glLightfvn SpotDirection (Normal3 0 0 0)--glLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()-glLightfvn l pname ptr = glLightfv l pname (castPtr ptr)--glGetLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()-glGetLightfvn l pname ptr = glGetLightfv l pname (castPtr ptr)------------------------------------------------------------------------------------spotExponent :: Light -> StateVar GLfloat-spotExponent = makeLightVar glGetLightfv glLightfv SpotExponent 0--maxSpotExponent :: GettableStateVar GLfloat-maxSpotExponent = makeGettableStateVar $ getFloat1 id GetMaxSpotExponent------------------------------------------------------------------------------------spotCutoff :: Light -> StateVar GLfloat-spotCutoff = makeLightVar glGetLightfv glLightfv SpotCutoff 0------------------------------------------------------------------------------------attenuation :: Light -> StateVar (GLfloat, GLfloat, GLfloat)-attenuation theLight =-   makeStateVar-      (liftM3 (,,) (get (constantAttenuation  theLight))-                   (get (linearAttenuation    theLight))-                   (get (quadraticAttenuation theLight)))-      (\(constant, linear, quadratic) -> do-         constantAttenuation  theLight $= constant-         linearAttenuation    theLight $= linear-         quadraticAttenuation theLight $= quadratic)--constantAttenuation :: Light -> StateVar GLfloat-constantAttenuation = makeLightVar glGetLightfv glLightfv ConstantAttenuation 0--linearAttenuation :: Light -> StateVar GLfloat-linearAttenuation = makeLightVar glGetLightfv glLightfv LinearAttenuation 0--quadraticAttenuation :: Light -> StateVar GLfloat-quadraticAttenuation =-   makeLightVar glGetLightfv glLightfv QuadraticAttenuation 0------------------------------------------------------------------------------------data LightModelParameter =-     LightModelAmbient-   | LightModelLocalViewer-   | LightModelTwoSide-   | LightModelColorControl--marshalLightModelParameter :: LightModelParameter -> GLenum-marshalLightModelParameter x = case x of-   LightModelAmbient -> gl_LIGHT_MODEL_AMBIENT-   LightModelLocalViewer -> gl_LIGHT_MODEL_LOCAL_VIEWER-   LightModelTwoSide -> gl_LIGHT_MODEL_TWO_SIDE-   LightModelColorControl -> gl_LIGHT_MODEL_COLOR_CONTROL------------------------------------------------------------------------------------lightModelAmbient :: StateVar (Color4 GLfloat)-lightModelAmbient =-   makeStateVar-      (getFloat4 Color4 GetLightModelAmbient)-      (\c -> with c $-                glLightModelfv (marshalLightModelParameter LightModelAmbient) . castPtr)------------------------------------------------------------------------------------lightModelLocalViewer :: StateVar Capability-lightModelLocalViewer =-   makeLightModelCapVar GetLightModelLocalViewer LightModelLocalViewer--makeLightModelCapVar :: GetPName -> LightModelParameter -> StateVar Capability-makeLightModelCapVar pname lightModelParameter =-   makeStateVar-      (getBoolean1 unmarshalCapability pname)-      (glLightModeli (marshalLightModelParameter lightModelParameter) .-                     fromIntegral . marshalCapability)------------------------------------------------------------------------------------lightModelTwoSide :: StateVar Capability-lightModelTwoSide = makeLightModelCapVar GetLightModelTwoSide LightModelTwoSide--vertexProgramTwoSide :: StateVar Capability-vertexProgramTwoSide = makeCapability CapVertexProgramTwoSide------------------------------------------------------------------------------------data LightModelColorControl =-     SingleColor-   | SeparateSpecularColor-   deriving ( Eq, Ord, Show )--marshalLightModelColorControl :: LightModelColorControl -> GLenum-marshalLightModelColorControl x = case x of-   SingleColor -> gl_SINGLE_COLOR-   SeparateSpecularColor -> gl_SEPARATE_SPECULAR_COLOR--unmarshalLightModelColorControl :: GLenum -> LightModelColorControl-unmarshalLightModelColorControl x-   | x == gl_SINGLE_COLOR = SingleColor-   | x == gl_SEPARATE_SPECULAR_COLOR = SeparateSpecularColor-   | otherwise = error ("unmarshalLightModelColorControl: illegal value " ++ show x)------------------------------------------------------------------------------------lightModelColorControl :: StateVar LightModelColorControl-lightModelColorControl =-   makeStateVar-      (getEnum1 unmarshalLightModelColorControl GetLightModelColorControl)-      (glLightModeli (marshalLightModelParameter LightModelColorControl) .-                     fromIntegral . marshalLightModelColorControl)------------------------------------------------------------------------------------data ColorMaterialParameter =-     Ambient-   | Diffuse-   | Specular-   | Emission-   | AmbientAndDiffuse-   deriving ( Eq, Ord, Show )--marshalColorMaterialParameter :: ColorMaterialParameter -> GLenum-marshalColorMaterialParameter x = case x of-   Ambient -> gl_AMBIENT-   Diffuse -> gl_DIFFUSE-   Specular -> gl_SPECULAR-   Emission -> gl_EMISSION-   AmbientAndDiffuse -> gl_AMBIENT_AND_DIFFUSE--unmarshalColorMaterialParameter :: GLenum -> ColorMaterialParameter-unmarshalColorMaterialParameter x-   | x == gl_AMBIENT = Ambient-   | x == gl_DIFFUSE = Diffuse-   | x == gl_SPECULAR = Specular-   | x == gl_EMISSION = Emission-   | x == gl_AMBIENT_AND_DIFFUSE = AmbientAndDiffuse-   | otherwise = error ("unmarshalColorMaterialParameter: illegal value " ++ show x)------------------------------------------------------------------------------------colorMaterial :: StateVar (Maybe (Face, ColorMaterialParameter))-colorMaterial =-   makeStateVarMaybe-      (return CapColorMaterial)-      (liftM2-         (,)-         (getEnum1 unmarshalFace GetColorMaterialFace)-         (getEnum1 unmarshalColorMaterialParameter GetColorMaterialParameter))-      (\(face, param) -> glColorMaterial (marshalFace face)-                                         (marshalColorMaterialParameter param))------------------------------------------------------------------------------------data ShadingModel =-     Flat-   | Smooth-   deriving ( Eq, Ord, Show )--marshalShadingModel :: ShadingModel -> GLenum-marshalShadingModel x = case x of-   Flat -> gl_FLAT-   Smooth -> gl_SMOOTH--unmarshalShadingModel :: GLenum -> ShadingModel-unmarshalShadingModel x-   | x == gl_FLAT = Flat-   | x == gl_SMOOTH = Smooth-   | otherwise = error ("unmarshalShadingModel: illegal value " ++ show x)------------------------------------------------------------------------------------shadeModel :: StateVar ShadingModel-shadeModel =-   makeStateVar-      (getEnum1 unmarshalShadingModel GetShadeModel)-      (glShadeModel . marshalShadingModel)
− Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs 
@@ -1,57 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.ComparisonFunction--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling ComparisonFunction.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.ComparisonFunction (-   ComparisonFunction(..), marshalComparisonFunction,-   unmarshalComparisonFunction-) where--import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data ComparisonFunction =-     Never-   | Less-   | Equal-   | Lequal-   | Greater-   | Notequal-   | Gequal-   | Always-   deriving ( Eq, Ord, Show )--marshalComparisonFunction :: ComparisonFunction -> GLenum-marshalComparisonFunction x = case x of-   Never -> gl_NEVER-   Less -> gl_LESS-   Equal -> gl_EQUAL-   Lequal -> gl_LEQUAL-   Greater -> gl_GREATER-   Notequal -> gl_NOTEQUAL-   Gequal -> gl_GEQUAL-   Always -> gl_ALWAYS--unmarshalComparisonFunction :: GLenum -> ComparisonFunction-unmarshalComparisonFunction x-   | x == gl_NEVER = Never-   | x == gl_LESS = Less-   | x == gl_EQUAL = Equal-   | x == gl_LEQUAL = Lequal-   | x == gl_GREATER = Greater-   | x == gl_NOTEQUAL = Notequal-   | x == gl_GEQUAL = Gequal-   | x == gl_ALWAYS = Always-   | otherwise = error ("unmarshalComparisonFunction: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/ControlPoint.hs 
@@ -1,169 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.ControlPoint--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for handling control points.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.ControlPoint (-   ControlPoint(..)-) where--import Data.Tensor-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.Domain-import Graphics.Rendering.OpenGL.GL.VertexArrays-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_MAP1_COLOR_4, gl_MAP1_INDEX, gl_MAP1_NORMAL, gl_MAP1_TEXTURE_COORD_1,-   gl_MAP1_TEXTURE_COORD_2, gl_MAP1_TEXTURE_COORD_3, gl_MAP1_TEXTURE_COORD_4,-   gl_MAP1_VERTEX_3, gl_MAP2_COLOR_4, gl_MAP2_INDEX, gl_MAP2_NORMAL,-   gl_MAP2_TEXTURE_COORD_1, gl_MAP2_TEXTURE_COORD_2, gl_MAP2_TEXTURE_COORD_3,-   gl_MAP2_TEXTURE_COORD_4, gl_MAP2_VERTEX_3, gl_MAP2_VERTEX_4,-   gl_MAP1_VERTEX_4 )------------------------------------------------------------------------------------class ControlPoint c where-   map1Target       :: Domain d => c d -> GLenum-   map2Target       :: Domain d => c d -> GLenum-   enableCap1       :: Domain d => c d -> EnableCap-   enableCap2       :: Domain d => c d -> EnableCap-   numComponents    :: Domain d => c d -> Stride-   peekControlPoint :: Domain d => Ptr (c d) -> IO (c d)-   pokeControlPoint :: Domain d => Ptr (c d) -> (c d) -> IO ()--instance ControlPoint Vertex3 where-   map1Target       = marshalMapTarget . const Map1Vertex3-   map2Target       = marshalMapTarget . const Map2Vertex3-   enableCap1       = const CapMap1Vertex3-   enableCap2       = const CapMap2Vertex3-   numComponents    = const 3-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint Vertex4 where-   map1Target       = marshalMapTarget . const Map1Vertex4-   map2Target       = marshalMapTarget . const Map2Vertex4-   enableCap1       = const CapMap1Vertex4-   enableCap2       = const CapMap2Vertex4-   numComponents    = const 4-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint Index1 where-   map1Target       = marshalMapTarget . const Map1Index-   map2Target       = marshalMapTarget . const Map2Index-   enableCap1       = const CapMap1Index-   enableCap2       = const CapMap2Index-   numComponents    = const 1-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint Color4 where-   map1Target       = marshalMapTarget . const Map1Color4-   map2Target       = marshalMapTarget . const Map2Color4-   enableCap1       = const CapMap1Color4-   enableCap2       = const CapMap2Color4-   numComponents    = const 4-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint Normal3 where-   map1Target       = marshalMapTarget . const Map1Normal-   map2Target       = marshalMapTarget . const Map2Normal-   enableCap1       = const CapMap1Normal-   enableCap2       = const CapMap2Normal-   numComponents    = const 3-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint TexCoord1 where-   map1Target       = marshalMapTarget . const Map1TextureCoord1-   map2Target       = marshalMapTarget . const Map2TextureCoord1-   enableCap1       = const CapMap1TextureCoord1-   enableCap2       = const CapMap2TextureCoord1-   numComponents    = const 1-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint TexCoord2 where-   map1Target       = marshalMapTarget . const Map1TextureCoord2-   map2Target       = marshalMapTarget . const Map2TextureCoord2-   enableCap1       = const CapMap1TextureCoord2-   enableCap2       = const CapMap2TextureCoord2-   numComponents    = const 2-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint TexCoord3 where-   map1Target       = marshalMapTarget . const Map1TextureCoord3-   map2Target       = marshalMapTarget . const Map2TextureCoord3-   enableCap1       = const CapMap1TextureCoord3-   enableCap2       = const CapMap2TextureCoord3-   numComponents    = const 3-   peekControlPoint = peek-   pokeControlPoint = poke--instance ControlPoint TexCoord4 where-   map1Target       = marshalMapTarget . const Map1TextureCoord4-   map2Target       = marshalMapTarget . const Map2TextureCoord4-   enableCap1       = const CapMap1TextureCoord4-   enableCap2       = const CapMap2TextureCoord4-   numComponents    = const 4-   peekControlPoint = peek-   pokeControlPoint = poke------------------------------------------------------------------------------------data MapTarget =-     Map1Color4-   | Map1Index-   | Map1Normal-   | Map1TextureCoord1-   | Map1TextureCoord2-   | Map1TextureCoord3-   | Map1TextureCoord4-   | Map1Vertex3-   | Map1Vertex4-   | Map2Color4-   | Map2Index-   | Map2Normal-   | Map2TextureCoord1-   | Map2TextureCoord2-   | Map2TextureCoord3-   | Map2TextureCoord4-   | Map2Vertex3-   | Map2Vertex4--marshalMapTarget :: MapTarget -> GLenum-marshalMapTarget x = case x of-   Map1Color4 -> gl_MAP1_COLOR_4-   Map1Index -> gl_MAP1_INDEX-   Map1Normal -> gl_MAP1_NORMAL-   Map1TextureCoord1 -> gl_MAP1_TEXTURE_COORD_1-   Map1TextureCoord2 -> gl_MAP1_TEXTURE_COORD_2-   Map1TextureCoord3 -> gl_MAP1_TEXTURE_COORD_3-   Map1TextureCoord4 -> gl_MAP1_TEXTURE_COORD_4-   Map1Vertex3 -> gl_MAP1_VERTEX_3-   Map1Vertex4 -> gl_MAP1_VERTEX_4-   Map2Color4 -> gl_MAP2_COLOR_4-   Map2Index -> gl_MAP2_INDEX-   Map2Normal -> gl_MAP2_NORMAL-   Map2TextureCoord1 -> gl_MAP2_TEXTURE_COORD_1-   Map2TextureCoord2 -> gl_MAP2_TEXTURE_COORD_2-   Map2TextureCoord3 -> gl_MAP2_TEXTURE_COORD_3-   Map2TextureCoord4 -> gl_MAP2_TEXTURE_COORD_4-   Map2Vertex3 -> gl_MAP2_VERTEX_3-   Map2Vertex4 -> gl_MAP2_VERTEX_4
− Graphics/Rendering/OpenGL/GL/CoordTrans.hs 
@@ -1,530 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.CoordTrans--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.11 (Coordinate Transformations) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.CoordTrans (-   -- * Controlling the Viewport-   depthRange,-   Position(..), Size(..), viewport, maxViewportDims,--   -- * Matrices-   MatrixMode(..), matrixMode,-   MatrixOrder(..), MatrixComponent(rotate,translate,scale), Matrix(..),-   currentMatrix, matrix, multMatrix, GLmatrix, loadIdentity,-   ortho, frustum, depthClamp,-   activeTexture,-   preservingMatrix, unsafePreservingMatrix,-   stackDepth, maxStackDepth,--   -- * Normal Transformation-   rescaleNormal, normalize,--   -- * Generating Texture Coordinates-   Plane(..), TextureCoordName(..), TextureGenMode(..), textureGenMode-) where--import Data.StateVar-import Data.Tensor-import Foreign.ForeignPtr-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glFrustum, glGetTexGendv, glGetTexGeniv, glLoadIdentity, glLoadMatrixd,-   glLoadMatrixf, glLoadTransposeMatrixd, glLoadTransposeMatrixf, glMatrixMode,-   glMultMatrixd, glMultMatrixf, glMultTransposeMatrixd, glMultTransposeMatrixf,-   glOrtho, glPopMatrix, glPushMatrix, glRotated, glRotatef, glScaled, glScalef,-   glTexGendv, glTexGeni, glTranslated, glTranslatef, gl_EYE_LINEAR,-   gl_EYE_PLANE, gl_NORMAL_MAP, gl_OBJECT_LINEAR, gl_OBJECT_PLANE,-   gl_PROJECTION, gl_Q, gl_R, gl_REFLECTION_MAP, gl_S, gl_SPHERE_MAP, gl_T,-   gl_TEXTURE_GEN_MODE )-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette ( gl_MATRIX_PALETTE )-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | After clipping and division by /w/, depth coordinates range from -1 to 1,--- corresponding to the near and far clipping planes. 'depthRange' specifies a--- linear mapping of the normalized depth coordinates in this range to window--- depth coordinates. Regardless of the actual depth buffer implementation,--- window coordinate depth values are treated as though they range from 0--- through 1 (like color components). Thus, the values accepted by 'depthRange'--- are both clamped to this range before they are accepted.------ The initial setting of (0, 1) maps the near plane to 0 and the far plane to--- 1. With this mapping, the depth buffer range is fully utilized.------ It is not necessary that the near value be less than the far value. Reverse--- mappings such as (1, 0) are acceptable.--depthRange :: StateVar (GLclampd, GLclampd)-depthRange = makeStateVar (getClampd2 (,) GetDepthRange) (uncurry glDepthRange)-------------------------------------------------------------------------------------- | A 2-dimensional position, measured in pixels.-data Position = Position !GLint !GLint-   deriving ( Eq, Ord, Show )---- | A 2-dimensional size, measured in pixels.-data Size = Size !GLsizei !GLsizei-   deriving ( Eq, Ord, Show )---- | Controls the affine transformation from normalized device coordinates to--- window coordinates. The viewport state variable consists of the coordinates--- (/x/, /y/) of the lower left corner of the viewport rectangle, (in pixels,--- initial value (0,0)), and the size (/width/, /height/) of the viewport. When--- a GL context is first attached to a window, /width/ and /height/ are set to--- the dimensions of that window.------ Let (/xnd/, /ynd/) be normalized device coordinates. Then the window--- coordinates (/xw/, /yw/) are computed as follows:------ /xw/ = (/xnd/ + 1) (/width/  \/ 2) + /x/------ /yw/ = (/ynd/ + 1) (/heigth/ \/ 2) + /y/------ Viewport width and height are silently clamped to a range that depends on the--- implementation, see 'maxViewportDims'.--viewport :: StateVar (Position, Size)-viewport = makeStateVar (getInteger4 makeVp GetViewport)-                        (\(Position x y, Size w h) -> glViewport x y w h)-   where makeVp x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))---- | The implementation-dependent maximum viewport width and height.--maxViewportDims :: GettableStateVar Size-maxViewportDims = makeGettableStateVar (getSizei2 Size GetMaxViewportDims)-------------------------------------------------------------------------------------- | A matrix stack.--data MatrixMode =-     Modelview GLsizei  -- ^ The modelview matrix stack of the specified vertex unit.-   | Projection         -- ^ The projection matrix stack.-   | Texture            -- ^ The texture matrix stack.-   | Color              -- ^ The color matrix stack.-   | MatrixPalette      -- ^ The matrix palette stack.-   deriving ( Eq, Ord, Show )--marshalMatrixMode :: MatrixMode -> Maybe GLenum-marshalMatrixMode x = case x of-   Modelview i -> modelviewIndexToEnum i-   Projection -> Just gl_PROJECTION-   Texture -> Just gl_TEXTURE-   Color -> Just gl_COLOR-   MatrixPalette -> Just gl_MATRIX_PALETTE--unmarshalMatrixMode :: GLenum -> MatrixMode-unmarshalMatrixMode x-   | x == gl_PROJECTION = Projection-   | x == gl_TEXTURE = Texture-   | x == gl_COLOR = Color-   | x == gl_MATRIX_PALETTE = MatrixPalette-   | otherwise =-        case modelviewEnumToIndex x of-           Just i -> Modelview i-           Nothing -> error ("unmarshalMatrixMode: illegal value " ++ show x)--matrixModeToGetMatrix :: MatrixMode -> GetPName-matrixModeToGetMatrix x = case x of-   Modelview _   -> GetModelviewMatrix -- ???-   Projection    -> GetProjectionMatrix-   Texture       -> GetTextureMatrix-   Color         -> GetColorMatrix-   MatrixPalette -> GetMatrixPalette--matrixModeToGetStackDepth :: MatrixMode -> GetPName-matrixModeToGetStackDepth x =  case x of-   Modelview _   -> GetModelviewStackDepth-   Projection    -> GetProjectionStackDepth-   Texture       -> GetTextureStackDepth-   Color         -> GetColorMatrixStackDepth-   MatrixPalette -> error "matrixModeToGetStackDepth: impossible"--matrixModeToGetMaxStackDepth :: MatrixMode -> GetPName-matrixModeToGetMaxStackDepth x = case x of-   Modelview _    -> GetMaxModelviewStackDepth-   Projection     -> GetMaxProjectionStackDepth-   Texture        -> GetMaxTextureStackDepth-   Color          -> GetMaxColorMatrixStackDepth-   MatrixPalette  -> GetMaxMatrixPaletteStackDepth-------------------------------------------------------------------------------------- | Controls which matrix stack is the target for subsequent matrix operations.--- The initial value is ('Modelview' 0).--matrixMode :: StateVar MatrixMode-matrixMode =-   makeStateVar (getEnum1 unmarshalMatrixMode GetMatrixMode)-                (maybe recordInvalidValue glMatrixMode . marshalMatrixMode)------------------------------------------------------------------------------------data MatrixOrder = ColumnMajor | RowMajor-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------class Storable c => MatrixComponent c where-   getMatrix :: GetPName -> Ptr c -> IO ()-   loadMatrix :: Ptr c -> IO ()-   loadTransposeMatrix :: Ptr c -> IO ()-   multMatrix_ :: Ptr c -> IO ()-   multTransposeMatrix :: Ptr c -> IO ()-   rotate :: c -> Vector3 c -> IO ()-   translate :: Vector3 c -> IO ()-   scale :: c -> c -> c -> IO ()--instance MatrixComponent GLfloat where-   getMatrix = getFloatv-   loadMatrix = glLoadMatrixf-   loadTransposeMatrix = glLoadTransposeMatrixf-   multMatrix_ = glMultMatrixf-   multTransposeMatrix = glMultTransposeMatrixf-   rotate a (Vector3 x y z) = glRotatef a x y z-   translate (Vector3 x y z) = glTranslatef x y z-   scale = glScalef--instance MatrixComponent GLdouble where-   getMatrix = getDoublev-   loadMatrix = glLoadMatrixd-   loadTransposeMatrix = glLoadTransposeMatrixd-   multMatrix_ = glMultMatrixd-   multTransposeMatrix = glMultTransposeMatrixd-   rotate a (Vector3 x y z) = glRotated a x y z-   translate (Vector3 x y z) = glTranslated x y z-   scale = glScaled------------------------------------------------------------------------------------class Matrix m where-   -- | Create a new matrix of the given order (containing undefined elements)-   -- and call the action to fill it with 4x4 elements.-   withNewMatrix ::-      MatrixComponent c => MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)--   -- | Call the action with the given matrix. /Note:/ The action is /not/-   -- allowed to modify the matrix elements!-   withMatrix ::-      MatrixComponent c => m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a--   newMatrix :: MatrixComponent c => MatrixOrder -> [c] -> IO (m c)-   getMatrixComponents :: MatrixComponent c => MatrixOrder -> m c -> IO [c]--   withNewMatrix order act =-      allocaArray 16 $ \p -> do-         act p-         components <- peekArray 16 p-         newMatrix order components--   withMatrix mat act = do-      components <- getMatrixComponents ColumnMajor mat-      withArray components $ act ColumnMajor--   newMatrix order components =-      withNewMatrix order $ flip pokeArray (take 16 components)--   getMatrixComponents desiredOrder mat =-      withMatrix mat $ \order p ->-        if desiredOrder == order-           then peekArray 16 p-           else mapM (peekElemOff p) [ 0, 4,  8, 12,-                                       1, 5,  9, 13,-                                       2, 6, 10, 14,-                                       3, 7, 11, 15 ]------------------------------------------------------------------------------------{-# DEPRECATED currentMatrix "use `matrix' instead" #-}-currentMatrix :: (Matrix m, MatrixComponent c) => StateVar (m c)-currentMatrix = matrix Nothing--matrix :: (Matrix m, MatrixComponent c) => Maybe MatrixMode -> StateVar (m c)-matrix maybeMode =-   makeStateVar-      (maybe (get matrixMode) return maybeMode >>= (getMatrix' . matrixModeToGetMatrix))-      (maybe id withMatrixMode maybeMode . setMatrix)--withMatrixMode :: MatrixMode -> IO a -> IO a-withMatrixMode mode act =-   preservingMatrixMode $ do-      matrixMode $= mode-      act--getMatrix' :: (Matrix m, MatrixComponent c) => GetPName -> IO (m c)-getMatrix' = withNewMatrix ColumnMajor . getMatrix--setMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()-setMatrix mat =-   withMatrix mat $ \order ->-      case order of-         ColumnMajor -> loadMatrix-         RowMajor    -> loadTransposeMatrix--multMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()-multMatrix mat =-   withMatrix mat $ \order ->-      case order of-         ColumnMajor -> multMatrix_-         RowMajor    -> multTransposeMatrix------------------------------------------------------------------------------------data GLmatrix a = GLmatrix MatrixOrder (ForeignPtr a)-   deriving ( Eq, Ord, Show )--instance Matrix GLmatrix where-   withNewMatrix order f = do-      fp <- mallocForeignPtrArray 16-      withForeignPtr fp f-      return $ GLmatrix order fp--   withMatrix (GLmatrix order fp) f = withForeignPtr fp (f order)------------------------------------------------------------------------------------loadIdentity :: IO ()-loadIdentity = glLoadIdentity------------------------------------------------------------------------------------ortho :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()-ortho = glOrtho--frustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()-frustum = glFrustum------------------------------------------------------------------------------------depthClamp :: StateVar Capability-depthClamp = makeCapability CapDepthClamp------------------------------------------------------------------------------------activeTexture :: StateVar TextureUnit-activeTexture = makeStateVar (getEnum1 unmarshalTextureUnit GetActiveTexture)-                             (glActiveTexture . marshalTextureUnit)-------------------------------------------------------------------------------------- | Push the current matrix stack down by one, duplicating the current matrix,--- excute the given action, and pop the current matrix stack, replacing the--- current matrix with the one below it on the stack (i.e. restoring it to its--- previous state). The returned value is that of the given action. Note that--- a round-trip to the server is probably required. For a more efficient--- version, see 'unsafePreservingMatrix'.--preservingMatrix :: IO a -> IO a-preservingMatrix = unsafePreservingMatrix . preservingMatrixMode---- performance paranoia: No (un-)marshaling by avoiding matrixMode-preservingMatrixMode :: IO a -> IO a-preservingMatrixMode = bracket (getEnum1 id GetMatrixMode) glMatrixMode . const---- | A more efficient, but potentially dangerous version of 'preservingMatrix':--- The given action is not allowed to throw an exception or change the--- current matrix mode permanently.--unsafePreservingMatrix :: IO a -> IO a-unsafePreservingMatrix = unsafeBracket_ glPushMatrix glPopMatrix------------------------------------------------------------------------------------stackDepth :: Maybe MatrixMode -> GettableStateVar GLsizei-stackDepth maybeMode =-   makeGettableStateVar $-      case maybeMode of-         Nothing -> getSizei1 id GetCurrentMatrixStackDepth -- only with ARB_fragment_program-         Just MatrixPalette -> do recordInvalidEnum ; return 0-         Just mode -> getSizei1 id (matrixModeToGetStackDepth mode)--maxStackDepth :: MatrixMode -> GettableStateVar GLsizei-maxStackDepth =-   makeGettableStateVar . getSizei1 id . matrixModeToGetMaxStackDepth-------------------------------------------------------------------------------------- | If 'rescaleNormal' contains 'Enabled', normal vectors specified with--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.normal' are scaled by a scaling--- factor derived from the modelview matrix. 'rescaleNormal' requires that the--- originally specified normals were of unit length, and that the modelview--- matrix contains only uniform scales for proper results. The initial value of--- 'rescaleNormal' is 'Disabled'.--rescaleNormal :: StateVar Capability-rescaleNormal = makeCapability CapRescaleNormal---- | If 'normalize' contains 'Enabled', normal vectors specified with--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.normal' are scaled to unit length--- after transformation. The initial value of 'normalize' is 'Disabled'.--normalize :: StateVar Capability-normalize = makeCapability CapNormalize------------------------------------------------------------------------------------data Plane a = Plane !a !a !a !a-   deriving ( Eq, Ord, Show )--instance Storable a => Storable (Plane a) where-   sizeOf    ~(Plane a _ _ _) = 4 * sizeOf a-   alignment ~(Plane a _ _ _) = alignment a-   peek                       = peek4 Plane . castPtr-   poke ptr   (Plane a b c d) = poke4 (castPtr ptr) a b c d------------------------------------------------------------------------------------data TextureCoordName =-     S-   | T-   | R-   | Q-   deriving ( Eq, Ord, Show )--marshalTextureCoordName :: TextureCoordName -> GLenum-marshalTextureCoordName x = case x of-   S -> gl_S-   T -> gl_T-   R -> gl_R-   Q -> gl_Q------------------------------------------------------------------------------------data TextureGenParameter =-     TextureGenMode-   | ObjectPlane-   | EyePlane--marshalTextureGenParameter :: TextureGenParameter -> GLenum-marshalTextureGenParameter x = case x of-   TextureGenMode -> gl_TEXTURE_GEN_MODE-   ObjectPlane -> gl_OBJECT_PLANE-   EyePlane -> gl_EYE_PLANE------------------------------------------------------------------------------------data TextureGenMode' =-     EyeLinear'-   | ObjectLinear'-   | SphereMap'-   | NormalMap'-   | ReflectionMap'--marshalTextureGenMode' :: TextureGenMode' -> GLint-marshalTextureGenMode' x = fromIntegral $ case x of-   EyeLinear' -> gl_EYE_LINEAR-   ObjectLinear' -> gl_OBJECT_LINEAR-   SphereMap' -> gl_SPHERE_MAP-   NormalMap' -> gl_NORMAL_MAP-   ReflectionMap' -> gl_REFLECTION_MAP--unmarshalTextureGenMode' :: GLint -> TextureGenMode'-unmarshalTextureGenMode' x-   | y == gl_EYE_LINEAR = EyeLinear'-   | y == gl_OBJECT_LINEAR = ObjectLinear'-   | y == gl_SPHERE_MAP = SphereMap'-   | y == gl_NORMAL_MAP = NormalMap'-   | y == gl_REFLECTION_MAP = ReflectionMap'-   | otherwise = error ("unmarshalTextureGenMode': illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------data TextureGenMode =-     EyeLinear    (Plane GLdouble)-   | ObjectLinear (Plane GLdouble)-   | SphereMap-   | NormalMap-   | ReflectionMap-   deriving ( Eq, Ord, Show )--marshalTextureGenMode :: TextureGenMode -> GLint-marshalTextureGenMode = marshalTextureGenMode' . convertMode-   where convertMode (EyeLinear    _) = EyeLinear'-         convertMode (ObjectLinear _) = ObjectLinear'-         convertMode SphereMap        = SphereMap'-         convertMode NormalMap        = NormalMap'-         convertMode ReflectionMap    = ReflectionMap'------------------------------------------------------------------------------------textureGenMode :: TextureCoordName -> StateVar (Maybe TextureGenMode)-textureGenMode coord =-   makeStateVarMaybe-      (return $ textureCoordNameToEnableCap coord)-      (do mode <- getMode coord-          case mode of-             EyeLinear'     -> fmap EyeLinear $ getPlane coord EyePlane-             ObjectLinear'  -> fmap ObjectLinear $ getPlane coord ObjectPlane-             SphereMap'     -> return SphereMap-             NormalMap'     -> return NormalMap-             ReflectionMap' -> return ReflectionMap)-      (\mode -> do-         setMode coord mode-         case mode of-            EyeLinear    plane -> setPlane coord EyePlane    plane-            ObjectLinear plane -> setPlane coord ObjectPlane plane-            _ -> return ())------------------------------------------------------------------------------------textureCoordNameToEnableCap :: TextureCoordName -> EnableCap-textureCoordNameToEnableCap coord = case coord of-   S -> CapTextureGenS-   T -> CapTextureGenT-   R -> CapTextureGenR-   Q -> CapTextureGenQ------------------------------------------------------------------------------------getMode :: TextureCoordName -> IO TextureGenMode'-getMode coord = alloca $ \buf -> do-   glGetTexGeniv (marshalTextureCoordName coord)-                 (marshalTextureGenParameter TextureGenMode)-                 buf-   peek1 unmarshalTextureGenMode' buf--setMode :: TextureCoordName -> TextureGenMode -> IO ()-setMode coord mode =-   glTexGeni (marshalTextureCoordName coord)-             (marshalTextureGenParameter TextureGenMode)-             (marshalTextureGenMode mode)------------------------------------------------------------------------------------getPlane :: TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)-getPlane coord param = alloca $ \planeBuffer -> do-   glGetTexGendv (marshalTextureCoordName coord)-                 (marshalTextureGenParameter param)-                 (castPtr planeBuffer)-   peek planeBuffer--setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()-setPlane coord param plane =-   with plane $ \planeBuffer ->-      glTexGendv (marshalTextureCoordName coord)-                 (marshalTextureGenParameter param)-                 (castPtr planeBuffer)
− Graphics/Rendering/OpenGL/GL/DataType.hs 
@@ -1,132 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.DataType--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling DataType.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.DataType (-   DataType(..), marshalDataType, unmarshalDataType-) where--import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_2_BYTES, gl_3_BYTES, gl_4_BYTES, gl_BITMAP )-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- basically table 3.2 (pixel data type parameter) plus a few additions-data DataType =-     UnsignedByte-   | Byte-   | UnsignedShort-   | Short-   | UnsignedInt-   | Int-   | HalfFloat-   | Float-   | UnsignedByte332-   | UnsignedByte233Rev-   | UnsignedShort565-   | UnsignedShort565Rev-   | UnsignedShort4444-   | UnsignedShort4444Rev-   | UnsignedShort5551-   | UnsignedShort1555Rev-   | UnsignedInt8888-   | UnsignedInt8888Rev-   | UnsignedInt1010102-   | UnsignedInt2101010Rev-   | UnsignedInt248-   | UnsignedInt10f11f11fRev-   | UnsignedInt5999Rev-   | Float32UnsignedInt248Rev-   | Bitmap                    -- pixel data, deprecated in 3.1-   | UnsignedShort88           -- MESA_ycbcr_texture/APPLE_ycbcr_422-   | UnsignedShort88Rev        -- MESA_ycbcr_texture/APPLE_ycbcr_422-   | Double                    -- vertex arrays (EXT_vertex_array, now core)-   | TwoBytes                  -- CallLists-   | ThreeBytes                -- CallLists-   | FourBytes                 -- CallLists-   deriving ( Eq, Ord, Show )--marshalDataType :: DataType -> GLenum-marshalDataType x = case x of-   UnsignedByte -> gl_UNSIGNED_BYTE-   Byte -> gl_BYTE-   UnsignedShort -> gl_UNSIGNED_SHORT-   Short -> gl_SHORT-   UnsignedInt -> gl_UNSIGNED_INT-   Int -> gl_INT-   HalfFloat -> gl_HALF_FLOAT-   Float -> gl_FLOAT-   UnsignedByte332 -> gl_UNSIGNED_BYTE_3_3_2-   UnsignedByte233Rev -> gl_UNSIGNED_BYTE_2_3_3_REV-   UnsignedShort565 -> gl_UNSIGNED_SHORT_5_6_5-   UnsignedShort565Rev -> gl_UNSIGNED_SHORT_5_6_5_REV-   UnsignedShort4444 -> gl_UNSIGNED_SHORT_4_4_4_4-   UnsignedShort4444Rev -> gl_UNSIGNED_SHORT_4_4_4_4_REV-   UnsignedShort5551 -> gl_UNSIGNED_SHORT_5_5_5_1-   UnsignedShort1555Rev -> gl_UNSIGNED_SHORT_1_5_5_5_REV-   UnsignedInt8888 -> gl_UNSIGNED_INT_8_8_8_8-   UnsignedInt8888Rev -> gl_UNSIGNED_INT_8_8_8_8_REV-   UnsignedInt1010102 -> gl_UNSIGNED_INT_10_10_10_2-   UnsignedInt2101010Rev -> gl_UNSIGNED_INT_2_10_10_10_REV-   UnsignedInt248 -> gl_UNSIGNED_INT_24_8-   UnsignedInt10f11f11fRev -> gl_UNSIGNED_INT_10F_11F_11F_REV-   UnsignedInt5999Rev -> gl_UNSIGNED_INT_5_9_9_9_REV-   Float32UnsignedInt248Rev -> gl_FLOAT_32_UNSIGNED_INT_24_8_REV-   Bitmap -> gl_BITMAP-   -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension-   UnsignedShort88 -> 0x85ba-   -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension-   UnsignedShort88Rev -> 0x85bb-   Double -> gl_DOUBLE-   TwoBytes -> gl_2_BYTES-   ThreeBytes -> gl_3_BYTES-   FourBytes -> gl_4_BYTES--unmarshalDataType :: GLenum -> DataType-unmarshalDataType x-   | x == gl_UNSIGNED_BYTE = UnsignedByte-   | x == gl_BYTE = Byte-   | x == gl_UNSIGNED_SHORT = UnsignedShort-   | x == gl_SHORT = Short-   | x == gl_UNSIGNED_INT = UnsignedInt-   | x == gl_INT = Int-   | x == gl_HALF_FLOAT = HalfFloat-   | x == gl_FLOAT = Float-   | x == gl_UNSIGNED_BYTE_3_3_2 = UnsignedByte332-   | x == gl_UNSIGNED_BYTE_2_3_3_REV = UnsignedByte233Rev-   | x == gl_UNSIGNED_SHORT_5_6_5 = UnsignedShort565-   | x == gl_UNSIGNED_SHORT_5_6_5_REV = UnsignedShort565Rev-   | x == gl_UNSIGNED_SHORT_4_4_4_4 = UnsignedShort4444-   | x == gl_UNSIGNED_SHORT_4_4_4_4_REV = UnsignedShort4444Rev-   | x == gl_UNSIGNED_SHORT_5_5_5_1 = UnsignedShort5551-   | x == gl_UNSIGNED_SHORT_1_5_5_5_REV = UnsignedShort1555Rev-   | x == gl_UNSIGNED_INT_8_8_8_8 = UnsignedInt8888-   | x == gl_UNSIGNED_INT_8_8_8_8_REV = UnsignedInt8888Rev-   | x == gl_UNSIGNED_INT_10_10_10_2 = UnsignedInt1010102-   | x == gl_UNSIGNED_INT_2_10_10_10_REV = UnsignedInt2101010Rev-   | x == gl_UNSIGNED_INT_24_8 = UnsignedInt248-   | x == gl_UNSIGNED_INT_10F_11F_11F_REV = UnsignedInt10f11f11fRev-   | x == gl_UNSIGNED_INT_5_9_9_9_REV = UnsignedInt5999Rev-   | x == gl_FLOAT_32_UNSIGNED_INT_24_8_REV = Float32UnsignedInt248Rev-   | x == gl_BITMAP = Bitmap-   -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension-   | x == 0x85ba = UnsignedShort88-   -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension-   | x == 0x85bb = UnsignedShort88Rev-   | x == gl_DOUBLE = Double-   | x == gl_2_BYTES = TwoBytes-   | x == gl_3_BYTES = ThreeBytes-   | x == gl_4_BYTES = FourBytes-   | otherwise = error ("unmarshalDataType: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/DisplayLists.hs 
@@ -1,158 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.DisplayLists--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 5.4 (Display Lists) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.DisplayLists (-   -- * Defining Display Lists-   DisplayList(..), ListMode(..), defineList, defineNewList, listIndex,-   listMode, maxListNesting,--   -- * Calling Display Lists-   callList, callLists, listBase,--   -- * Deprecated Functions-   genLists, deleteLists, isList,-) where--import Data.ObjectName-import Data.StateVar-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.DataType-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (- glCallList, glCallLists, glDeleteLists, glEndList, glGenLists, glIsList,- glListBase, glNewList, gl_COMPILE, gl_COMPILE_AND_EXECUTE )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------newtype DisplayList = DisplayList GLuint-   deriving ( Eq, Ord, Show )--instance ObjectName DisplayList where-   genObjectNames = genLists_-   deleteObjectNames = deleteLists_-   isObjectName = isList_------------------------------------------------------------------------------------{-# DEPRECATED genLists "use `genObjectNames' instead" #-}-genLists :: GLsizei -> IO [DisplayList]-genLists = genLists_ . fromIntegral--genLists_ :: Int -> IO [DisplayList]-genLists_ n = do-   first <- glGenLists (fromIntegral n)-   if DisplayList first == noDisplayList-      then do recordOutOfMemory-              return []-      else return [ DisplayList l | l <- [ first .. first + fromIntegral n - 1 ] ]------------------------------------------------------------------------------------{-# DEPRECATED deleteLists "use `deleteObjectNames' instead" #-}-deleteLists :: [DisplayList] -> IO ()-deleteLists = deleteLists_--deleteLists_ :: [DisplayList] -> IO ()-deleteLists_ = mapM_ (uncurry glDeleteLists) . combineConsecutive--combineConsecutive :: [DisplayList] -> [(GLuint, GLsizei)]-combineConsecutive []     = []-combineConsecutive (z@(DisplayList dl) :zs) = (dl, len) : combineConsecutive rest-   where (len, rest) = run (0 :: GLsizei) z zs-         run n x xs = case n + 1 of-                         m -> case xs of-                                 []                          -> (m, [])-                                 (y:ys) | x `isFollowedBy` y -> run m y ys-                                        | otherwise          -> (m, xs)-         DisplayList x `isFollowedBy` DisplayList y = x + 1 == y------------------------------------------------------------------------------------{-# DEPRECATED isList "use `isObjectName' instead" #-}-isList :: DisplayList -> IO Bool-isList = isList_--isList_ :: DisplayList -> IO Bool-isList_ (DisplayList dl) = fmap unmarshalGLboolean (glIsList dl)------------------------------------------------------------------------------------data ListMode =-     Compile-   | CompileAndExecute-   deriving ( Eq, Ord, Show )--marshalListMode :: ListMode -> GLenum-marshalListMode x = case x of-   Compile -> gl_COMPILE-   CompileAndExecute -> gl_COMPILE_AND_EXECUTE--unmarshalListMode :: GLenum -> ListMode-unmarshalListMode x-   | x == gl_COMPILE = Compile-   | x == gl_COMPILE_AND_EXECUTE = CompileAndExecute-   | otherwise = error ("unmarshalListMode: illegal value " ++ show x)------------------------------------------------------------------------------------defineList :: DisplayList -> ListMode -> IO a -> IO a-defineList (DisplayList dl) mode = bracket_ (glNewList dl (marshalListMode mode)) glEndList--defineNewList :: ListMode -> IO a -> IO DisplayList-defineNewList mode action = do-   lists <- genLists 1-   if null lists-      then do recordOutOfMemory-              return noDisplayList-      else do let lst = head lists-              _ <- defineList lst mode action-              return lst------------------------------------------------------------------------------------listIndex :: GettableStateVar (Maybe DisplayList)-listIndex =-   makeGettableStateVar-      (do l <- getEnum1 (DisplayList . fromIntegral) GetListIndex-          return $ if l == noDisplayList then Nothing else Just l)--noDisplayList :: DisplayList-noDisplayList = DisplayList 0--listMode :: GettableStateVar ListMode-listMode = makeGettableStateVar (getEnum1 unmarshalListMode GetListMode)--maxListNesting :: GettableStateVar GLsizei-maxListNesting = makeGettableStateVar (getSizei1 id GetMaxListNesting)------------------------------------------------------------------------------------callList :: DisplayList -> IO ()-callList (DisplayList dl) = glCallList dl--callLists :: GLsizei -> DataType -> Ptr a -> IO ()-callLists n = glCallLists n . marshalDataType------------------------------------------------------------------------------------listBase :: StateVar DisplayList-listBase =-   makeStateVar-      (getEnum1 (DisplayList . fromIntegral) GetListBase)-       (\(DisplayList dl) -> glListBase dl)
− Graphics/Rendering/OpenGL/GL/Domain.hs 
@@ -1,71 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Domain--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for handling evaluator domains.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Domain (-   Domain(..)-) where--import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glEvalCoord1d, glEvalCoord1dv, glEvalCoord1f, glEvalCoord1fv, glEvalCoord2d,-   glEvalCoord2dv, glEvalCoord2f, glEvalCoord2fv, glGetMapdv, glGetMapfv,-   glMap1d, glMap1f, glMap2d, glMap2f, glMapGrid1d, glMapGrid1f, glMapGrid2d,-   glMapGrid2f )------------------------------------------------------------------------------------class Storable d => Domain d where-   glMap1      :: GLenum -> d -> d -> GLint -> GLint -> Ptr d -> IO ()-   glMap2      :: GLenum -> d -> d -> GLint -> GLint -> d -> d -> GLint -> GLint -> Ptr d -> IO ()-   glGetMapv   :: GLenum -> GLenum -> Ptr d -> IO ()-   evalCoord1  :: d -> IO ()-   evalCoord1v :: Ptr d -> IO ()-   evalCoord2  :: (d, d) -> IO ()-   evalCoord2v :: Ptr d -> IO ()-   glMapGrid1  :: GLint -> d -> d -> IO ()-   glMapGrid2  :: GLint -> d -> d -> GLint -> d -> d -> IO ()-   get2        :: (d -> d -> a) -> GetPName -> IO a-   get4        :: (d -> d -> d -> d -> a) -> GetPName -> IO a------------------------------------------------------------------------------------instance Domain GLfloat where-   glMap1      = glMap1f-   glMap2      = glMap2f-   glGetMapv   = glGetMapfv-   evalCoord1  = glEvalCoord1f-   evalCoord1v = glEvalCoord1fv-   evalCoord2  = uncurry glEvalCoord2f-   evalCoord2v = glEvalCoord2fv-   glMapGrid1  = glMapGrid1f-   glMapGrid2  = glMapGrid2f-   get2        = getFloat2-   get4        = getFloat4--instance Domain GLdouble where-   glMap1      = glMap1d-   glMap2      = glMap2d-   glGetMapv   = glGetMapdv-   evalCoord1  = glEvalCoord1d-   evalCoord1v = glEvalCoord1dv-   evalCoord2  = uncurry glEvalCoord2d-   evalCoord2v = glEvalCoord2dv-   glMapGrid1  = glMapGrid1d-   glMapGrid2  = glMapGrid2d-   get2        = getDouble2-   get4        = getDouble4
− Graphics/Rendering/OpenGL/GL/EdgeFlag.hs 
@@ -1,36 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.EdgeFlag--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling EdgeFlag.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.EdgeFlag (-   EdgeFlag(..), marshalEdgeFlag, unmarshalEdgeFlag-) where--import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.GL.GLboolean-------------------------------------------------------------------------------------- | A vertex can begin an edge which lies in the interior of its polygon or on--- the polygon\'s boundary.--data EdgeFlag = BeginsInteriorEdge | BeginsBoundaryEdge-   deriving ( Eq, Ord, Show )--marshalEdgeFlag :: EdgeFlag -> GLboolean-marshalEdgeFlag = marshalGLboolean . (BeginsBoundaryEdge ==)--unmarshalEdgeFlag :: GLboolean -> EdgeFlag-unmarshalEdgeFlag f =-   if unmarshalGLboolean f then BeginsBoundaryEdge else BeginsBoundaryEdge
− Graphics/Rendering/OpenGL/GL/Evaluators.hs 
@@ -1,369 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Evaluators--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 5.1 (Evaluators) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Evaluators (-   -- * Evaluator-related Types-   Order, maxOrder, Domain, MapDescriptor(..), ControlPoint,--   -- * Defining Evaluator Maps-   -- ** One-dimensional Evaluator Maps-   Map1(..), GLmap1, map1,--   -- ** Two-dimensional Evaluator Maps-   Map2(..), GLmap2, map2,--   -- * Using Evaluator Maps--   -- ** Evaluating an Arbitrary Coordinate Value-   evalCoord1, evalCoord1v, evalCoord2, evalCoord2v,--   -- ** Using Evenly Spaced Coordinate Values--   -- *** Defining a Grid-   mapGrid1, mapGrid2,--   -- *** Evaluating a Whole Mesh-   evalMesh1, evalMesh2,--   -- *** Evaluating a Single Point on a Mesh-   evalPoint1, evalPoint2,--   -- * Normal Generation-   autoNormal-) where--import Control.Monad-import Data.List-import Data.StateVar-import Foreign.ForeignPtr-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.ControlPoint-import Graphics.Rendering.OpenGL.GL.Domain-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.PolygonMode-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexArrays-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glEvalMesh1, glEvalMesh2, glEvalPoint1, glEvalPoint2, glGetMapiv, gl_COEFF,-   gl_DOMAIN, gl_ORDER )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------type Order = GLint--maxOrder :: GettableStateVar Order-maxOrder = makeGettableStateVar (getInteger1 id GetMaxEvalOrder)------------------------------------------------------------------------------------data MapDescriptor d =-   MapDescriptor (d, d) Stride Order NumComponents-   deriving ( Eq, Ord, Show )--totalComponents1 :: Domain d => MapDescriptor d -> Int-totalComponents1 (MapDescriptor _ stride order numComp) =-   fromIntegral stride * (fromIntegral order - 1) + fromIntegral numComp--totalComponents2 :: Domain d => MapDescriptor d -> MapDescriptor d -> Int-totalComponents2 uDescriptor vDescriptor@(MapDescriptor _ _ _ numComp) =-   totalComponents1 uDescriptor + totalComponents1 vDescriptor - fromIntegral numComp------------------------------------------------------------------------------------peekControlPoints1 ::-   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> IO [c d]-peekControlPoints1 descriptor ptr =-   mapM peekControlPoint (controlPointPtrs1 descriptor ptr)--peekControlPoints2 ::-      (ControlPoint c, Domain d)-   => MapDescriptor d -> MapDescriptor d -> Ptr d -> IO [[c d]]-peekControlPoints2 uDescriptor vDescriptor ptr =-   mapM (mapM peekControlPoint) (controlPointPtrs2 uDescriptor vDescriptor ptr)--pokeControlPoints1 ::-   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> [c d] -> IO ()-pokeControlPoints1 descriptor ptr =-   zipWithM_ pokeControlPoint (controlPointPtrs1 descriptor ptr)--pokeControlPoints2 ::-      (ControlPoint c, Domain d)-   => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[c d]] -> IO ()-pokeControlPoints2 uDescriptor vDescriptor ptr =-   zipWithM_ (zipWithM_ pokeControlPoint)-             (controlPointPtrs2 uDescriptor vDescriptor ptr)--controlPointPtrs1 :: Domain d => MapDescriptor d -> Ptr d -> [Ptr a]-controlPointPtrs1 (MapDescriptor _ stride order _) ptr =-   [ ptr `plusPtr` (o * s) | o <- [ 0 .. fromIntegral order - 1 ] ]-   where s = sizeOfPtr ptr * fromIntegral stride--controlPointPtrs2 ::-   Domain d => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[Ptr a]]-controlPointPtrs2 uDescriptor vDescriptor ptr =-   [ controlPointPtrs1 vDescriptor p | p <- controlPointPtrs1 uDescriptor ptr ]--sizeOfPtr :: Storable a => Ptr a -> Int-sizeOfPtr = sizeOf . (const undefined :: Ptr a -> a)------------------------------------------------------------------------------------class Map1 m where-   withNewMap1 :: (ControlPoint c, Domain d)-      => MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)--   withMap1 :: (ControlPoint c, Domain d)-      => m c d -> (MapDescriptor d -> Ptr d -> IO a) -> IO a--   newMap1 :: (ControlPoint c, Domain d)-      => (d, d) -> [c d] -> IO (m c d)--   getMap1Components :: (ControlPoint c, Domain d)-      => m c d -> IO ((d, d), [c d])--   withNewMap1 descriptor@(MapDescriptor domain _ _ _) act = do-      allocaArray (totalComponents1 descriptor) $ \ptr -> do-         act ptr-         controlPoints <- peekControlPoints1 descriptor ptr-         newMap1 domain controlPoints--   withMap1 m act = do-      (domain, controlPoints) <- getMap1Components m-      let stride = numComponents (head controlPoints)-          order = genericLength controlPoints-          descriptor = MapDescriptor domain stride order (fromIntegral stride)-      allocaArray (totalComponents1 descriptor) $ \ptr -> do-         pokeControlPoints1 descriptor ptr controlPoints-         act descriptor ptr--   newMap1 domain controlPoints = do-      let stride = numComponents (head controlPoints)-          order = genericLength controlPoints-          descriptor = MapDescriptor domain stride order (fromIntegral stride)-      withNewMap1 descriptor $ \ptr ->-         pokeControlPoints1 descriptor ptr controlPoints--   getMap1Components m =-      withMap1 m $ \descriptor@(MapDescriptor domain _ _ _) ptr -> do-         controlPoints <- peekControlPoints1 descriptor ptr-         return (domain, controlPoints)------------------------------------------------------------------------------------data (ControlPoint c, Domain d) => GLmap1 c d =-   GLmap1 (MapDescriptor d) (ForeignPtr d)-   deriving ( Eq, Ord, Show )--instance Map1 GLmap1 where-   withNewMap1 descriptor act = do-      fp <- mallocForeignPtrArray (totalComponents1 descriptor)-      withForeignPtr fp act-      return $ GLmap1 descriptor fp--   withMap1 (GLmap1 descriptor fp) act =-      withForeignPtr fp $ act descriptor------------------------------------------------------------------------------------map1 :: (Map1 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))-map1 = makeMap1StateVar enableCap1 getMap1 setMap1--makeMap1StateVar ::-      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())-   -> StateVar (Maybe (m c d))-makeMap1StateVar getCap getAct setAct =-   makeStateVarMaybe-      (return (getCap undefined))-      (getAct undefined)-      (setAct undefined)--getMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> IO (m c d)-getMap1 dummyControlPoint = do-   let target = map1Target dummyControlPoint-       numComp = fromIntegral (numComponents dummyControlPoint)-   domain <- allocaArray 2 $ \ptr -> do-      glGetMapv target (marshalGetMapQuery Domain) ptr-      peek2 (,) ptr-   order <- alloca $ \ptr -> do-      glGetMapiv target (marshalGetMapQuery Order) ptr-      fmap fromIntegral $ peek ptr-   withNewMap1 (MapDescriptor domain (numComponents dummyControlPoint) order numComp) $-      glGetMapv target (marshalGetMapQuery Coeff)--setMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()-setMap1 dummyControlPoint m =-   withMap1 m $ \(MapDescriptor (u1, u2) stride order _) ->-      glMap1 (map1Target dummyControlPoint) u1 u2-             (fromIntegral stride) (fromIntegral order)------------------------------------------------------------------------------------class Map2 m where-   withNewMap2 :: (ControlPoint c, Domain d)-      => MapDescriptor d -> MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)--   withMap2 :: (ControlPoint c, Domain d)-      => m c d -> (MapDescriptor d -> MapDescriptor d -> Ptr d -> IO a) -> IO a--   newMap2 :: (ControlPoint c, Domain d)-      => (d, d) -> (d, d) -> [[c d]] -> IO (m c d)--   getMap2Components :: (ControlPoint c, Domain d)-      => m c d -> IO ((d, d), (d, d), [[c d]])--   withNewMap2 uDescriptor@(MapDescriptor uDomain _ _ _)-               vDescriptor@(MapDescriptor vDomain _ _ _) act =-      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do-         act ptr-         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr-         newMap2 uDomain vDomain controlPoints--   withMap2 m act = do-      (uDomain, vDomain, controlPoints) <- getMap2Components m-      let vStride = numComponents (head (head controlPoints))-          vOrder = genericLength (head controlPoints)-          uStride = vStride * fromIntegral vOrder-          uOrder = genericLength controlPoints-          numComp = fromIntegral vStride-          uDescriptor = MapDescriptor uDomain uStride uOrder numComp-          vDescriptor = MapDescriptor vDomain vStride vOrder numComp-      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do-         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints-         act uDescriptor vDescriptor ptr--   newMap2 uDomain vDomain controlPoints = do-      let vStride = numComponents (head (head controlPoints))-          vOrder = genericLength (head controlPoints)-          uStride = vStride * fromIntegral vOrder-          uOrder = genericLength controlPoints-          numComp = fromIntegral vStride-          uDescriptor = MapDescriptor uDomain uStride uOrder numComp-          vDescriptor = MapDescriptor vDomain vStride vOrder numComp-      withNewMap2 uDescriptor vDescriptor $ \ptr ->-         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints--   getMap2Components m =-      withMap2 m $ \uDescriptor@(MapDescriptor uDomain _ _ _)-                    vDescriptor@(MapDescriptor vDomain _ _ _) ptr -> do-         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr-         return (uDomain, vDomain, controlPoints)------------------------------------------------------------------------------------data (ControlPoint c, Domain d) => GLmap2 c d =-   GLmap2 (MapDescriptor d)  (MapDescriptor d) (ForeignPtr d)-   deriving ( Eq, Ord, Show )--instance Map2 GLmap2 where-   withNewMap2 uDescriptor vDescriptor act = do-      fp <- mallocForeignPtrArray (totalComponents2 uDescriptor vDescriptor)-      withForeignPtr fp act-      return $ GLmap2 uDescriptor vDescriptor fp--   withMap2 (GLmap2 uDescriptor vDescriptor fp) act =-      withForeignPtr fp $ act uDescriptor vDescriptor------------------------------------------------------------------------------------map2 :: (Map2 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))-map2 = makeMap2StateVar enableCap2 getMap2 setMap2--makeMap2StateVar ::-      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())-   -> StateVar (Maybe (m c d))-makeMap2StateVar getCap getAct setAct =-   makeStateVarMaybe-      (return (getCap undefined))-      (getAct undefined)-      (setAct undefined)--getMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> IO (m c d)-getMap2 dummyControlPoint = do-   let target = map2Target dummyControlPoint-   (uDomain, vDomain) <- allocaArray 4 $ \ptr -> do-      glGetMapv target (marshalGetMapQuery Domain) ptr-      peek4 (\u1 u2 v1 v2 -> ((u1, u2), (v1, v2))) ptr-   (uOrder, vOrder) <- allocaArray 2 $ \ptr -> do-      glGetMapiv target (marshalGetMapQuery Order) ptr-      peek2 (,) ptr-   let vStride = numComponents dummyControlPoint-       uStride = vStride * fromIntegral vOrder-   withNewMap2 (MapDescriptor uDomain uStride uOrder (fromIntegral vStride))-               (MapDescriptor vDomain vStride vOrder (fromIntegral vStride)) $-      glGetMapv target (marshalGetMapQuery Coeff)--setMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()-setMap2 dummyControlPoint m =-   withMap2 m $ \(MapDescriptor (u1, u2) uStride uOrder _)-                 (MapDescriptor (v1, v2) vStride vOrder _) ->-      glMap2 (map2Target dummyControlPoint)-             u1 u2 (fromIntegral uStride) (fromIntegral uOrder)-             v1 v2 (fromIntegral vStride) (fromIntegral vOrder)------------------------------------------------------------------------------------data GetMapQuery =-     Coeff-   | Order-   | Domain--marshalGetMapQuery :: GetMapQuery -> GLenum-marshalGetMapQuery x = case x of-   Coeff -> gl_COEFF-   Order -> gl_ORDER-   Domain -> gl_DOMAIN------------------------------------------------------------------------------------mapGrid1 :: Domain d => StateVar (GLint, (d, d))-mapGrid1 =-   makeStateVar-      (do n <- getInteger1 id GetMap1GridSegments-          domain <- get2 (,) GetMap1GridDomain-          return (n, domain))-      (\(n, (u1, u2)) -> glMapGrid1 n u1 u2)--mapGrid2 :: Domain d => StateVar ((GLint, (d, d)), (GLint, (d, d)))-mapGrid2 =-   makeStateVar-      (do (un, vn) <- getInteger2 (,) GetMap2GridSegments-          (u1, u2, v1, v2) <- get4 (,,,) GetMap2GridDomain-          return ((un, (u1, u2)), (vn, (v1, v2))))-      (\((un, (u1, u2)), (vn, (v1, v2))) -> glMapGrid2 un u1 u2 vn v1 v2)------------------------------------------------------------------------------------evalMesh1 :: PolygonMode -> (GLint, GLint) -> IO ()-evalMesh1 m (p1, p2) = glEvalMesh1 (marshalPolygonMode m) p1 p2--evalMesh2 :: PolygonMode -> (GLint, GLint) -> (GLint, GLint) -> IO ()-evalMesh2 m (p1, p2) (q1, q2) = glEvalMesh2 (marshalPolygonMode m) p1 p2 q1 q2------------------------------------------------------------------------------------evalPoint1 :: GLint -> IO ()-evalPoint1 = glEvalPoint1--evalPoint2 :: (GLint, GLint) -> IO ()-evalPoint2 = uncurry glEvalPoint2------------------------------------------------------------------------------------autoNormal :: StateVar Capability-autoNormal = makeCapability CapAutoNormal
− Graphics/Rendering/OpenGL/GL/Exception.hs 
@@ -1,55 +0,0 @@-{-# LANGUAGE CPP #-}--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Exception--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module to compensate for differences between--- Haskell implementations.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Exception (-   bracket, bracket_, unsafeBracket_, finallyRet-) where--import Data.IORef ( newIORef, readIORef, writeIORef )--#ifdef __NHC__-import qualified IO ( bracket, bracket_ )--{-# INLINE bracket #-}-bracket  :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c-bracket = IO.bracket--{-# INLINE bracket_ #-}-bracket_ :: IO a -> IO b -> IO c -> IO c-bracket_ before = IO.bracket_ before . const--finally :: IO a -> IO b -> IO a-finally = flip . bracket_ . return $ undefined-#else-import Control.Exception ( bracket, bracket_, finally )-#endif--{-# INLINE unsafeBracket_ #-}-unsafeBracket_ :: IO a -> IO b -> IO c -> IO c-unsafeBracket_ before after thing = do-   _ <- before-   r <- thing-   _ <- after-   return r--{-# INLINE finallyRet #-}-finallyRet :: IO a -> IO b -> IO (a, b)-a `finallyRet` sequel = do-   r2Ref <- newIORef undefined-   r1 <- a `finally` (sequel >>= writeIORef r2Ref)-   r2 <- readIORef r2Ref-   return (r1, r2)
− Graphics/Rendering/OpenGL/GL/Face.hs 
@@ -1,41 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Face--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling Face.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Face (-   Face(..), marshalFace, unmarshalFace-) where--import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data Face =-     Front-   | Back-   | FrontAndBack-   deriving ( Eq, Ord, Show )--marshalFace :: Face -> GLenum-marshalFace x = case x of-   Front -> gl_FRONT-   Back -> gl_BACK-   FrontAndBack -> gl_FRONT_AND_BACK--unmarshalFace :: GLenum -> Face-unmarshalFace x-   | x == gl_FRONT = Front-   | x == gl_BACK = Back-   | x == gl_FRONT_AND_BACK = FrontAndBack-   | otherwise = error ("unmarshalFace: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/Feedback.hs 
@@ -1,201 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Feedback--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 5.3 (Feedback) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Feedback (-   FeedbackToken(..), VertexInfo(..), ColorInfo, FeedbackType(..),-   getFeedbackTokens, PassThroughValue(..), passThrough-) where--import Control.Monad-import Data.StateVar-import Data.Tensor-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.IOState-import Graphics.Rendering.OpenGL.GL.RenderMode-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glFeedbackBuffer, glPassThrough, gl_2D, gl_3D, gl_3D_COLOR,-   gl_3D_COLOR_TEXTURE, gl_4D_COLOR_TEXTURE, gl_BITMAP_TOKEN,-   gl_COPY_PIXEL_TOKEN, gl_DRAW_PIXEL_TOKEN, gl_LINE_RESET_TOKEN, gl_LINE_TOKEN,-   gl_PASS_THROUGH_TOKEN, gl_POINT_TOKEN, gl_POLYGON_TOKEN )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data FeedbackToken =-     PointToken VertexInfo-   | LineToken VertexInfo VertexInfo-   | LineResetToken VertexInfo VertexInfo-   | PolygonToken [VertexInfo]-   | BitmapToken VertexInfo-   | DrawPixelToken VertexInfo-   | CopyPixelToken VertexInfo-   | PassThroughToken PassThroughValue-   deriving ( Eq, Ord, Show )--data VertexInfo =-     Vertex2D             (Vertex2 GLfloat)-   | Vertex3D             (Vertex3 GLfloat)-   | Vertex3DColor        (Vertex3 GLfloat) ColorInfo-   | Vertex3DColorTexture (Vertex3 GLfloat) ColorInfo (TexCoord4 GLfloat)-   | Vertex4DColorTexture (Vertex4 GLfloat) ColorInfo (TexCoord4 GLfloat)-   deriving ( Eq, Ord, Show )--type ColorInfo = Either (Index1 GLint) (Color4 GLfloat)------------------------------------------------------------------------------------data FeedbackTag =-     PointTag-   | LineTag-   | LineResetTag-   | PolygonTag-   | BitmapTag-   | DrawPixelTag-   | CopyPixelTag-   | PassThroughTag--unmarshalFeedbackTag :: GLenum -> FeedbackTag-unmarshalFeedbackTag x-   | x == gl_POINT_TOKEN = PointTag-   | x == gl_LINE_TOKEN = LineTag-   | x == gl_LINE_RESET_TOKEN = LineResetTag-   | x == gl_POLYGON_TOKEN = PolygonTag-   | x == gl_BITMAP_TOKEN = BitmapTag-   | x == gl_DRAW_PIXEL_TOKEN = DrawPixelTag-   | x == gl_COPY_PIXEL_TOKEN = CopyPixelTag-   | x == gl_PASS_THROUGH_TOKEN = PassThroughTag-   | otherwise = error ("unmarshalFeedbackTag: illegal value " ++ show x)------------------------------------------------------------------------------------data FeedbackType =-     TwoD-   | ThreeD-   | ThreeDColor-   | ThreeDColorTexture-   | FourDColorTexture-   deriving ( Eq, Ord, Show )--marshalFeedbackType :: FeedbackType -> GLenum-marshalFeedbackType x = case x of-   TwoD -> gl_2D-   ThreeD -> gl_3D-   ThreeDColor -> gl_3D_COLOR-   ThreeDColorTexture -> gl_3D_COLOR_TEXTURE-   FourDColorTexture -> gl_4D_COLOR_TEXTURE------------------------------------------------------------------------------------getFeedbackTokens ::-   GLsizei -> FeedbackType -> IO a -> IO (a, Maybe [FeedbackToken])-getFeedbackTokens bufSize feedbackType action =-   allocaArray (fromIntegral bufSize) $ \buf -> do-      glFeedbackBuffer bufSize (marshalFeedbackType feedbackType) buf-      (value, numValues) <- withRenderMode Feedback action-      tokens <- parseFeedbackBuffer numValues buf feedbackType-      return (value, tokens)------------------------------------------------------------------------------------parseFeedbackBuffer ::-   GLint -> Ptr GLfloat -> FeedbackType -> IO (Maybe [FeedbackToken])-parseFeedbackBuffer numValues buf feedbackType-   | numValues < 0 = return Nothing-   | otherwise     = do-      rgba <- get rgbaMode-      let end = buf `plusPtr`-                  (sizeOf (undefined :: GLfloat) * fromIntegral numValues)-          infoParser = calcInfoParser feedbackType (calcColorParser rgba)-          loop tokens = do-             ptr <- getIOState-             if ptr == end-                then return (reverse tokens)-                else do token <- tokenParser infoParser-                        loop (token : tokens)-      fmap Just $ evalIOState (loop []) buf--type Parser a = IOState GLfloat a--tokenParser :: Parser VertexInfo -> Parser FeedbackToken-tokenParser infoParser = do-   tag <- parseGLenum-   case unmarshalFeedbackTag tag of-      PointTag -> fmap PointToken infoParser-      LineTag -> liftM2 LineToken infoParser infoParser-      LineResetTag -> liftM2 LineResetToken infoParser infoParser-      PolygonTag -> do n <- parseGLint; fmap PolygonToken (nTimes n infoParser)-      BitmapTag -> fmap BitmapToken infoParser-      DrawPixelTag -> fmap DrawPixelToken infoParser-      CopyPixelTag -> fmap CopyPixelToken infoParser-      PassThroughTag -> fmap PassThroughToken parsePassThroughValue--calcInfoParser :: FeedbackType -> Parser ColorInfo -> Parser VertexInfo-calcInfoParser feedbackType colorParser = case feedbackType of-   TwoD ->-      fmap Vertex2D parseVertex2-   ThreeD ->-      fmap Vertex3D parseVertex3-   ThreeDColor ->-      liftM2 Vertex3DColor parseVertex3 colorParser-   ThreeDColorTexture ->-      liftM3 Vertex3DColorTexture parseVertex3 colorParser parseTexCoord4-   FourDColorTexture ->-      liftM3 Vertex4DColorTexture parseVertex4 colorParser parseTexCoord4--parseVertex2 :: Parser (Vertex2 GLfloat)-parseVertex2 = liftM2 Vertex2 parseGLfloat parseGLfloat--parseVertex3 :: Parser (Vertex3 GLfloat)-parseVertex3 = liftM3 Vertex3 parseGLfloat parseGLfloat parseGLfloat--parseVertex4 :: Parser (Vertex4 GLfloat)-parseVertex4 =-   liftM4 Vertex4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat--calcColorParser :: Bool -> Parser ColorInfo-calcColorParser False = fmap Left parseIndex1-calcColorParser True  = fmap Right parseColor4--parseIndex1 :: Parser (Index1 GLint)-parseIndex1 = fmap Index1 parseGLint--parseColor4 :: Parser (Color4 GLfloat)-parseColor4 = liftM4 Color4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat--parseTexCoord4 :: Parser (TexCoord4 GLfloat)-parseTexCoord4 =-   liftM4 TexCoord4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat--parsePassThroughValue :: Parser PassThroughValue-parsePassThroughValue = fmap PassThroughValue parseGLfloat--parseGLenum :: Parser GLenum-parseGLenum = fmap round parseGLfloat--parseGLint :: Parser GLint-parseGLint = fmap round parseGLfloat--parseGLfloat :: Parser GLfloat-parseGLfloat = peekIOState------------------------------------------------------------------------------------newtype PassThroughValue = PassThroughValue GLfloat-   deriving ( Eq, Ord, Show )--passThrough :: PassThroughValue -> IO ()-passThrough (PassThroughValue ptv) = glPassThrough ptv
− Graphics/Rendering/OpenGL/GL/FlushFinish.hs 
@@ -1,50 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.FlushFinish--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 5.5 (Flush and Finish) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.FlushFinish (-   flush, finish      -) where--import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | Different GL implementations buffer commands in several different--- locations, including network buffers and the graphics accelerator itself.--- 'flush' empties all of these buffers, causing all issued commands to be--- executed as quickly as they are accepted by the actual rendering engine.--- Though this execution may not be completed in any particular time period, it--- does complete in finite time.--- --- Because any GL program might be executed over a network, or on an accelerator--- that buffers commands, all programs should call 'flush' whenever they count--- on having all of their previously issued commands completed. For example,--- call 'flush' before waiting for user input that depends on the generated--- image.--- --- Note that 'flush' can return at any time. It does not wait until the--- execution of all previously issued GL commands is complete.--flush :: IO ()-flush = glFlush---- | 'finish' does not return until the effects of all previously called GL--- commands are complete. Such effects include all changes to GL state, all--- changes to connection state, and all changes to the frame buffer contents.--- --- Note that 'finish' requires a round trip to the server.--finish :: IO ()-finish = glFinish
− Graphics/Rendering/OpenGL/GL/Fog.hs 
@@ -1,207 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Fog--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.10 (Fog) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Fog (-   fog,-   FogMode(..), fogMode,-   fogColor, fogIndex,-   FogCoordSrc(..), fogCoordSrc,-   FogDistanceMode(..), fogDistanceMode-) where--import Data.StateVar-import Foreign.Marshal.Utils-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glFogf, glFogfv, glFogi, gl_EXP, gl_EXP2, gl_EYE_PLANE, gl_FOG_COLOR,-   gl_FOG_COORD, gl_FOG_COORD_SRC, gl_FOG_DENSITY, gl_FOG_END, gl_FOG_INDEX,-   gl_FOG_MODE, gl_FOG_START, gl_FRAGMENT_DEPTH )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------fog :: StateVar Capability-fog = makeCapability CapFog------------------------------------------------------------------------------------data FogParameter =-     FogIndex-   | FogDensity-   | FogStart-   | FogEnd-   | FogMode-   | FogColor-   | FogCoordSrc-   | FogDistanceMode--marshalFogParameter :: FogParameter -> GLenum-marshalFogParameter x = case x of-   FogIndex -> gl_FOG_INDEX-   FogDensity -> gl_FOG_DENSITY-   FogStart -> gl_FOG_START-   FogEnd -> gl_FOG_END-   FogMode -> gl_FOG_MODE-   FogColor -> gl_FOG_COLOR-   FogCoordSrc -> gl_FOG_COORD_SRC-   -- TODO: Use FOG_DISTANCE_MODE_NV from NV_fog_distance extension-   FogDistanceMode -> 0x855a------------------------------------------------------------------------------------data FogMode' =-     Linear'-   | Exp'-   | Exp2'--marshalFogMode' :: FogMode' -> GLint-marshalFogMode' x = fromIntegral $ case x of-   Linear' -> gl_LINEAR-   Exp' -> gl_EXP-   Exp2' -> gl_EXP2--unmarshalFogMode' :: GLint -> FogMode'-unmarshalFogMode' x-   | y == gl_LINEAR = Linear'-   | y == gl_EXP = Exp'-   | y == gl_EXP2 = Exp2'-   | otherwise = error ("unmarshalFogMode': illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------data FogMode =-     Linear GLfloat GLfloat-   | Exp GLfloat-   | Exp2 GLfloat-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------fogMode :: StateVar FogMode-fogMode = makeStateVar getFogMode setFogMode--getFogMode :: IO FogMode-getFogMode = do-   mode <- getInteger1 unmarshalFogMode' GetFogMode-   case mode of-      Linear' -> do-         start <- getFloat1 id GetFogStart-         end <- getFloat1 id GetFogEnd-         return $ Linear start end-      Exp' -> getFloat1 Exp GetFogDensity-      Exp2' -> getFloat1 Exp2 GetFogDensity--setFogMode :: FogMode -> IO ()-setFogMode (Linear start end) = do-   fogi FogMode (marshalFogMode' Linear')-   fogf FogStart start-   fogf FogEnd end-setFogMode (Exp density) = do-   fogi FogMode (marshalFogMode' Exp')-   fogf FogDensity density-setFogMode (Exp2 density) = do-   fogi FogMode (marshalFogMode' Exp2')-   fogf FogDensity density------------------------------------------------------------------------------------fogi :: FogParameter -> GLint -> IO ()-fogi = glFogi . marshalFogParameter--fogf :: FogParameter -> GLfloat -> IO ()-fogf = glFogf . marshalFogParameter--fogfv :: FogParameter -> Ptr (Color4 GLfloat) -> IO ()-fogfv param ptr = glFogfv (marshalFogParameter param) (castPtr ptr)------------------------------------------------------------------------------------fogColor :: StateVar (Color4 GLclampf)-fogColor =-   makeStateVar-      (getClampf4 Color4 GetFogColor)-      (\c -> with c $ (fogfv FogColor . castPtr))------------------------------------------------------------------------------------fogIndex :: StateVar (Index1 GLint)-fogIndex =-   makeStateVar-      (getInteger1 Index1 GetFogIndex)-      (\(Index1 i) -> fogi FogIndex i)------------------------------------------------------------------------------------data FogCoordSrc =-     FogCoord-   | FragmentDepth-   deriving ( Eq, Ord, Show )--marshalFogCoordSrc :: FogCoordSrc -> GLint-marshalFogCoordSrc x = fromIntegral $ case x of-   FogCoord -> gl_FOG_COORD-   FragmentDepth -> gl_FRAGMENT_DEPTH--unmarshalFogCoordSrc :: GLint -> FogCoordSrc-unmarshalFogCoordSrc x-   | y == gl_FOG_COORD = FogCoord-   | y == gl_FRAGMENT_DEPTH = FragmentDepth-   | otherwise = error ("unmarshalFogCoordSrc: illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------fogCoordSrc :: StateVar FogCoordSrc-fogCoordSrc =-   makeStateVar-      (getInteger1 unmarshalFogCoordSrc GetFogCoordSrc)-      (fogi FogCoordSrc . marshalFogCoordSrc)------------------------------------------------------------------------------------data FogDistanceMode =-     EyeRadial-   | EyePlaneSigned-   | EyePlaneAbsolute-   deriving ( Eq, Ord, Show )--marshalFogDistanceMode :: FogDistanceMode -> GLint-marshalFogDistanceMode x = fromIntegral $ case x of-   -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension-   EyeRadial -> 0x855b-   EyePlaneSigned ->gl_EYE_PLANE-   -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension-   EyePlaneAbsolute -> 0x855c--unmarshalFogDistanceMode :: GLint -> FogDistanceMode-unmarshalFogDistanceMode x-   -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension-   | y == 0x855b = EyeRadial-   | y == gl_EYE_PLANE = EyePlaneSigned-   -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension-   | y == 0x855c = EyePlaneAbsolute-   | otherwise = error ("unmarshalFogDistanceMode: illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------fogDistanceMode :: StateVar FogDistanceMode-fogDistanceMode =-   makeStateVar-      (getInteger1 unmarshalFogDistanceMode GetFogDistanceMode)-      (fogi FogDistanceMode . marshalFogDistanceMode)
− Graphics/Rendering/OpenGL/GL/Framebuffer.hs 
@@ -1,410 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Framebuffer--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 4.2 (Whole Framebuffer Operations) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Framebuffer (-   -- * Querying the Buffer Configuration-   auxBuffers, doubleBuffer, stereoBuffer,-   rgbaBits, stencilBits, depthBits, accumBits, rgbaSignedComponents,--   -- * Selecting a Buffer for Writing-   BufferMode(..), drawBuffer, drawBuffers, maxDrawBuffers,--   -- * Fine Control of Buffer Updates-   indexMask, colorMask, stencilMask, stencilMaskSeparate, depthMask,--   -- * Clearing the Buffers-   ClearBuffer(..), clear,-   clearColor, clearIndex, clearStencil, clearDepth, clearAccum,--   -- * The Accumulation Buffer-   AccumOp(..), accum-) where--import Control.Monad-import Data.List-import Data.Maybe-import Data.StateVar-import Foreign.Marshal.Array-import Graphics.Rendering.OpenGL.GL.BufferMode-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.Face-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glAccum, glClearAccum, glClearIndex, glIndexMask, gl_ACCUM,-   gl_ACCUM_BUFFER_BIT, gl_ADD, gl_LOAD, gl_MULT, gl_RETURN )-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | The implementation and context dependent number of auxiliary buffers.--auxBuffers :: GettableStateVar GLsizei-auxBuffers = makeGettableStateVar $ getSizei1 id GetAuxBuffers---- | 'True' if front and back buffers exist.--doubleBuffer :: GettableStateVar Bool-doubleBuffer =-   makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetDoublebuffer---- | 'True' if left and right buffers exist.--stereoBuffer :: GettableStateVar Bool-stereoBuffer =-    makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetStereo--rgbaBits :: GettableStateVar (Color4 GLsizei)-rgbaBits =-   makeGettableStateVar $-      liftM4 Color4 (getSizei1 id GetRedBits)-                    (getSizei1 id GetGreenBits)-                    (getSizei1 id GetBlueBits)-                    (getSizei1 id GetAlphaBits)--stencilBits :: GettableStateVar GLsizei-stencilBits = makeGettableStateVar $ getSizei1 id GetStencilBits--depthBits :: GettableStateVar GLsizei-depthBits = makeGettableStateVar $ getSizei1 id GetDepthBits--accumBits :: GettableStateVar (Color4 GLsizei)-accumBits =-   makeGettableStateVar $-      liftM4 Color4 (getSizei1 id GetAccumRedBits)-                    (getSizei1 id GetAccumGreenBits)-                    (getSizei1 id GetAccumBlueBits)-                    (getSizei1 id GetAccumAlphaBits)--rgbaSignedComponents :: GettableStateVar (Color4 Bool)-rgbaSignedComponents =-   makeGettableStateVar $-      getInteger4 (\r g b a -> Color4 (unmarshalGLboolean r)-                                      (unmarshalGLboolean g)-                                      (unmarshalGLboolean b)-                                      (unmarshalGLboolean a))-                  GetRGBASignedComponents-------------------------------------------------------------------------------------- | When colors are written to the framebuffer, they are written into the color--- buffers specified by 'drawBuffer'.--- --- If more than one color buffer is selected for drawing, then blending or--- logical operations are computed and applied independently for each color--- buffer and can produce different results in each buffer.------ Monoscopic contexts include only left buffers, and stereoscopic contexts--- include both left and right buffers. Likewise, single-buffered contexts--- include only front buffers, and double-buffered contexts include both front--- and back buffers. The context is selected at GL initialization.------ The initial value is 'FrontBuffers' for single-buffered contexts, and--- 'BackBuffers' for double-buffered contexts.--drawBuffer :: StateVar BufferMode-drawBuffer =-   makeStateVar-      (getEnum1 unmarshalBufferMode GetDrawBuffer)-      (maybe recordInvalidValue glDrawBuffer . marshalBufferMode)-------------------------------------------------------------------------------------- | 'drawBuffers' defines the draw buffers to which all fragment colors are--- written. The draw buffers being defined correspond in order to the respective--- fragment colors. The draw buffer for fragment colors beyond those specified--- is set to 'NoBuffers'.------ Except for 'NoBuffers', a buffer may not appear more then once in the given--- list. Specifying a buffer more then once will result in an--- 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation'.------ If fixed-function fragment shading is being performed, 'drawBuffers'--- specifies a set of draw buffers into which the fragment color is written.------ If a fragment shader writes to @gl_FragColor@, 'drawBuffers' specifies a set--- of draw buffers into which the single fragment color defined by--- @gl_FragColor@ is written. If a fragment shader writes to @gl_FragData@,--- 'drawBuffers' specifies a set of draw buffers into which each of the multiple--- fragment colors defined by @gl_FragData@ are separately written. If a--- fragment shader writes to neither @gl_FragColor@ nor @gl_FragData@, the--- values of the fragment colors following shader execution are undefined, and--- may differ for each fragment color.--drawBuffers :: StateVar [BufferMode]-drawBuffers = makeStateVar getDrawBuffers setDrawBuffers--getDrawBuffers :: IO [BufferMode]-getDrawBuffers = do-   n <- get maxDrawBuffers-   mapM (getEnum1 unmarshalBufferMode . GetDrawBufferN) [ 0 .. n ]--setDrawBuffers :: [BufferMode] -> IO ()-setDrawBuffers modes = do-   let ms = map marshalBufferMode modes-   if all isJust ms-      then withArray (map fromJust ms) $-              glDrawBuffers (genericLength ms)-      else recordInvalidValue-------------------------------------------------------------------------------------- | Contains the maximum number of buffers that can activated via 'drawBuffers'--- or which can be simultaneously written into from within a fragment shader--- using the special output variable array @gl_FragData@. This constant--- effectively defines the size of the @gl_FragData@ array. The minimum legal--- value is 1.--maxDrawBuffers :: GettableStateVar GLsizei-maxDrawBuffers = makeGettableStateVar $ getSizei1 id GetMaxDrawBuffers-------------------------------------------------------------------------------------- | Controls the writing of individual bits in the color index buffers. The--- least significant /n/ bits of its value, where /n/ is the number of bits in a--- color index buffer, specify a mask.  Where a 1 appears in the mask, it is--- possible to write to the corresponding bit in the color index buffer (or--- buffers). Where a 0 appears, the corresponding bit is write-protected.------ This mask is used only in color index mode, and it affects only the buffers--- currently selected for writing (see 'drawBuffer'). Initially, all bits are--- enabled for writing.--indexMask :: StateVar GLuint-indexMask =-   makeStateVar (getInteger1 fromIntegral GetIndexWritemask) glIndexMask-------------------------------------------------------------------------------------- | Controls whether the individual color components in the framebuffer can or--- cannot be written. If the red flag is 'Disabled', for example, no change is--- made to the red component of any pixel in any of the color buffers,--- regardless of the drawing operation attempted. Initially, all color--- components can be written.------ Changes to individual bits of components cannot be controlled. Rather,--- changes are either enabled or disabled for entire color components.--- Furthermore, this mask is used only in RGBA mode.--colorMask :: StateVar (Color4 Capability)-colorMask =-   makeStateVar-      (getBoolean4 (\r g b a -> Color4 (unmarshalCapability r)-                                       (unmarshalCapability g)-                                       (unmarshalCapability b)-                                       (unmarshalCapability a))-                                      GetColorWritemask)-      (\(Color4 r g b a) -> glColorMask (marshalCapability r)-                                        (marshalCapability g)-                                        (marshalCapability b)-                                        (marshalCapability a))-------------------------------------------------------------------------------------- | Controls whether the depth buffer is enabled for writing. The initial state--- is 'Enabled'.--depthMask :: StateVar Capability-depthMask = makeStateVar (getBoolean1 unmarshalCapability GetDepthWritemask)-                         (glDepthMask . marshalCapability)-------------------------------------------------------------------------------------- | Controls the writing of individual bits in the stencil planes. The least--- significant /n/ bits of its value, where /n/ is the number of bits in the--- stencil buffer, specify a mask. Where a 1 appears in the mask, it is--- possible to write to the corresponding bit in the stencil buffer. Where a 0--- appears, the corresponding bit is write-protected.--- Initially, all bits are enabled for writing.--stencilMask :: StateVar GLuint-stencilMask =-   makeStateVar (getInteger1 fromIntegral GetStencilWritemask) glStencilMask--stencilMaskSeparate :: Face -> SettableStateVar GLuint-stencilMaskSeparate face =-   makeSettableStateVar $-      glStencilMaskSeparate (marshalFace face)-------------------------------------------------------------------------------------- | The buffers which can be cleared with 'clear'.--data ClearBuffer =-     ColorBuffer   -- ^ The buffers currently enabled for color writing.-   | AccumBuffer   -- ^ The accumulation buffer.-   | StencilBuffer -- ^ The stencil buffer.-   | DepthBuffer   -- ^ The depth buffer.-   deriving ( Eq, Ord, Show )--marshalClearBuffer :: ClearBuffer -> GLbitfield-marshalClearBuffer x = fromIntegral $ case x of-   ColorBuffer -> gl_COLOR_BUFFER_BIT-   AccumBuffer -> gl_ACCUM_BUFFER_BIT-   StencilBuffer -> gl_STENCIL_BUFFER_BIT-   DepthBuffer -> gl_DEPTH_BUFFER_BIT-------------------------------------------------------------------------------------- | Set the bitplane area of the window to values previously selected by--- 'clearColor', 'clearIndex', 'clearDepth', 'clearStencil', and 'clearAccum'.--- Multiple color buffers can be cleared simultaneously by selecting more than--- one buffer at a time using 'drawBuffer'.------ The pixel ownership test, the scissor test, dithering, and the buffer--- writemasks affect the operation of 'clear'. The scissor box bounds the--- cleared region. Alpha function, blend function, logical operation,--- stenciling, texure mapping, and depth-buffering are ignored by 'clear'.------ 'clear' takes a list of buffers, indicating which buffers are to be cleared.--- If a buffer is not present, then a 'clear' directed at that buffer has no--- effect.------ The value to which each buffer is cleared depends on the setting of the clear--- value for that buffer.--clear :: [ClearBuffer] -> IO ()-clear = glClear . sum . map marshalClearBuffer-------------------------------------------------------------------------------------- | Controls the red, green, blue, and alpha values used by 'clear' to clear--- the color buffers. Values written into 'clearColor' are clamped to the range--- [0, 1]. Initially, all values are 0.--clearColor :: StateVar (Color4 GLclampf)-clearColor = makeStateVar (getClampf4 Color4 GetColorClearValue)-                          (\(Color4 r g b a) -> glClearColor r g b a)-------------------------------------------------------------------------------------- | Controls the index /c/ used by 'clear' to clear the color index buffers.--- /c/ is not clamped. Rather, /c/ is converted to a fixed-point value with--- unspecified precision to the right of the binary point. The integer part of--- this value is then masked with 2^/m/-1, where /m/ is the number of bits in a--- color index stored in the framebuffer. Initially, the value is 0.--clearIndex :: StateVar (Index1 GLfloat)-clearIndex = makeStateVar (getFloat1 Index1 GetIndexClearValue)-                          (\(Index1 i) -> glClearIndex i)-------------------------------------------------------------------------------------- | Controls the depth value used by 'clear' to clear the depth buffer. Values--- written into 'clearDepth' are clamped to the range [0, 1]. The initial value--- is 1.--clearDepth :: StateVar GLclampd-clearDepth = makeStateVar (getClampd1 id GetDepthClearValue) glClearDepth-------------------------------------------------------------------------------------- | Controls the value /s/ used by 'clear' to clear the stencil buffer. /s/ is--- masked with 2^/m/-1, where /m/ is the number of bits in the stencil buffer.--- Initially, the value is 0.--clearStencil :: StateVar GLint-clearStencil = makeStateVar (getInteger1 id GetStencilClearValue) glClearStencil-------------------------------------------------------------------------------------- | Controls the red, green, blue, and alpha values used by 'clear' to clear--- the accumulation buffer. Values written into 'clearAccum' are clamped to the--- range [-1, 1]. The initial values are all 0.--clearAccum :: StateVar (Color4 GLfloat)-clearAccum =-   makeStateVar (getFloat4 Color4 GetAccumClearValue)-                (\(Color4 r g b a) -> glClearAccum r g b a)-------------------------------------------------------------------------------------- | An operation on the accumulation buffer.--data AccumOp =-     Accum-     -- ^ Obtains /R/, /G/, /B/, and /A/ values from the buffer currently-     -- selected for reading (see-     -- 'Graphics.Rendering.OpenGL.GL.ReadCopyPixels.readBuffer'). Each-     -- component value is divided by 2^/n/-1, where /n/ is the number of bits-     -- allocated to each color component in the currently selected buffer. The-     -- result is a floating-point value in the range [0, 1], which is-     -- multiplied by the value given to 'accum' and added to the corresponding-     -- pixel component in the accumulation buffer, thereby updating the-     -- accumulation buffer.-   | Load-     -- ^ Similar to 'Accum', except that the current value in the accumulation-     -- buffer is not used in the calculation of the new value. That is, the-     -- /R/, /G/, /B/, and /A/ values from the currently selected buffer are-     -- divided by 2^/n/-1, multiplied by the value given to 'accum', and then-     -- stored in the corresponding accumulation buffer cell, overwriting the-     -- current value.-   | Return-     -- ^ Transfers accumulation buffer values to the color buffer or buffers-     -- currently selected for writing. Each /R/, /G/, /B/, and /A/ component-     -- is multiplied by the value given to 'accum', then multiplied by 2^/n/-1,-     -- clamped to the range [0, 2^/n/-1], and stored in the corresponding-     -- display buffer cell. The only fragment operations that are applied to-     -- this transfer are pixel ownership, scissor, dithering, and color-     -- writemasks.-   | Mult-     -- ^ Multiplies each /R/, /G/, /B/, and /A/ in the accumulation buffer by-     -- the value given to 'accum' and returns the scaled component to its-     -- corresponding accumulation buffer location.-   | Add-     -- ^ Adds the value given to 'accum' to each /R/, /G/, /B/, and /A/ in the-     -- accumulation buffer.-   deriving ( Eq, Ord, Show )--marshalAccumOp :: AccumOp -> GLenum-marshalAccumOp x = case x of-   Accum -> gl_ACCUM-   Load -> gl_LOAD-   Return -> gl_RETURN-   Mult -> gl_MULT-   Add -> gl_ADD-------------------------------------------------------------------------------------- | The accumulation buffer is an extended-range color buffer. Images are not--- rendered into it. Rather, images rendered into one of the color buffers are--- added to the contents of the accumulation buffer after rendering. Effects--- such as antialiasing (of points, lines, and polygons), motion blur, and--- depth of field can be created by accumulating images generated with different--- transformation matrices.------ Each pixel in the accumulation buffer consists of red, green, blue, and alpha--- values. The number of bits per component in the accumulation buffer depends--- on the implementation (see 'accumBits'). Regardless of the number of bits per--- component, the range of values stored by each component is [-1, 1]. The--- accumulation buffer pixels are mapped one-to-one with frame buffer pixels.------ 'accum' operates on the accumulation buffer. The first argument selects an--- accumulation buffer operation. The second argument, is a floating-point value--- to be used in that operation, see 'AccumOp'.------ All accumulation buffer operations are limited to the area of the current--- scissor box and applied identically to the red, green, blue, and alpha--- components of each pixel. If an 'accum' operation results in a value outside--- the range [-1, 1], the contents of an accumulation buffer pixel component--- are undefined.------ To clear the accumulation buffer, use 'clearAccum' to specify the clear--- value, then call 'clear' with the accumulation buffer enabled.--accum :: AccumOp -> GLfloat -> IO ()-accum = glAccum . marshalAccumOp
− Graphics/Rendering/OpenGL/GL/GLboolean.hs 
@@ -1,30 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.GLboolean--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling GLboolean.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.GLboolean (-   marshalGLboolean, unmarshalGLboolean-) where--import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------marshalGLboolean :: Num a => Bool -> a-marshalGLboolean x = fromIntegral $ case x of-   False -> gl_FALSE-   True -> gl_TRUE--unmarshalGLboolean :: (Eq a, Num a) => a -> Bool-unmarshalGLboolean = (/= fromIntegral gl_FALSE)
− Graphics/Rendering/OpenGL/GL/Hints.hs 
@@ -1,93 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Hints--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 5.6 (Hints) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Hints (-   HintTarget(..), HintMode(..), hint-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_FOG_HINT, gl_GENERATE_MIPMAP_HINT, gl_PERSPECTIVE_CORRECTION_HINT,-   gl_POINT_SMOOTH_HINT )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka (-   gl_PACK_CMYK_HINT, gl_UNPACK_CMYK_HINT )------------------------------------------------------------------------------------data HintTarget =-     PerspectiveCorrection-   | PointSmooth-   | LineSmooth-   | PolygonSmooth-   | Fog-   | GenerateMipmap-   | TextureCompression-   | PackCMYK-   | UnpackCMYK-   deriving ( Eq, Ord, Show )--marshalHintTarget :: HintTarget -> GLenum-marshalHintTarget x = case x of-   PerspectiveCorrection -> gl_PERSPECTIVE_CORRECTION_HINT-   PointSmooth -> gl_POINT_SMOOTH_HINT-   LineSmooth -> gl_LINE_SMOOTH_HINT-   PolygonSmooth -> gl_POLYGON_SMOOTH_HINT-   Fog -> gl_FOG_HINT-   GenerateMipmap -> gl_GENERATE_MIPMAP_HINT-   TextureCompression -> gl_TEXTURE_COMPRESSION_HINT-   PackCMYK -> gl_PACK_CMYK_HINT-   UnpackCMYK -> gl_UNPACK_CMYK_HINT--hintTargetToGetPName :: HintTarget -> GetPName-hintTargetToGetPName x = case x of-   PerspectiveCorrection -> GetPerspectiveCorrectionHint-   PointSmooth -> GetPointSmoothHint-   LineSmooth -> GetLineSmoothHint-   PolygonSmooth -> GetPolygonSmoothHint-   Fog -> GetFogHint-   GenerateMipmap -> GetGenerateMipmapHint-   TextureCompression -> GetTextureCompressionHint-   PackCMYK -> GetPackCMYKHint-   UnpackCMYK -> GetUnpackCMYKHint------------------------------------------------------------------------------------data HintMode =-     DontCare-   | Fastest-   | Nicest-   deriving ( Eq, Ord, Show )--marshalHintMode :: HintMode -> GLenum-marshalHintMode x = case x of-   DontCare -> gl_DONT_CARE-   Fastest -> gl_FASTEST-   Nicest -> gl_NICEST--unmarshalHintMode :: GLenum -> HintMode-unmarshalHintMode x-   | x == gl_DONT_CARE = DontCare-   | x == gl_FASTEST = Fastest-   | x == gl_NICEST = Nicest-   | otherwise = error ("unmarshalHintMode: illegal value " ++ show x)------------------------------------------------------------------------------------hint ::  HintTarget -> StateVar HintMode-hint t =-   makeStateVar-      (getEnum1 unmarshalHintMode (hintTargetToGetPName t))-      (glHint (marshalHintTarget t) . marshalHintMode)
− Graphics/Rendering/OpenGL/GL/IOState.hs 
@@ -1,56 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.IOState--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for an IO monad with a pointer as an--- additional state, basically a /StateT (Ptr s) IO a/.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.IOState (-   IOState(..), getIOState, peekIOState, evalIOState, nTimes-) where--import Foreign.Ptr ( Ptr, plusPtr )-import Foreign.Storable ( Storable(sizeOf,peek) )------------------------------------------------------------------------------------newtype IOState s a = IOState { runIOState :: Ptr s -> IO (a, Ptr s) }--instance Functor (IOState s) where-   fmap f m = IOState $ \s -> do (x, s') <- runIOState m s ; return (f x, s')--instance Monad (IOState s) where-   return a = IOState $ \s -> return (a, s)-   m >>= k  = IOState $ \s -> do (a, s') <- runIOState m s ; runIOState (k a) s'-   fail str = IOState $ \_ -> fail str--getIOState :: IOState s (Ptr s)-getIOState = IOState $ \s -> return (s, s)--putIOState :: Ptr s -> IOState s ()-putIOState s = IOState $ \_ -> return ((), s)--peekIOState :: Storable a => IOState a a-peekIOState = do-   ptr <- getIOState-   x <- liftIOState $ peek ptr-   putIOState (ptr `plusPtr` sizeOf x)-   return x--liftIOState :: IO a -> IOState s a-liftIOState m = IOState $ \s -> do a <- m ; return (a, s)--evalIOState :: IOState s a -> Ptr s -> IO a-evalIOState m s = do (a, _) <- runIOState m s ; return a--nTimes :: Integral a => a -> IOState b c -> IOState b [c]-nTimes n = sequence . replicate (fromIntegral n)
− Graphics/Rendering/OpenGL/GL/LineSegments.hs 
@@ -1,151 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.LineSegments--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.4 (Line Segments) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.LineSegments (-   -- * Line Rasterization-   lineWidth,--   -- * Line Stipple-   lineStipple,--   -- * Line Antialiasing-  lineSmooth,--   -- * Implementation-Dependent Limits-   aliasedLineWidthRange, smoothLineWidthRange, smoothLineWidthGranularity-) where--import Control.Monad-import Data.StateVar-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glLineStipple )-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | 'lineWidth' contains the rasterized width of both aliased and antialiased--- lines. The initial value is 1. Using a line width other than 1 has different--- effects, depending on whether line antialiasing is enabled (see--- 'lineSmooth'). Line antialiasing is initially disabled.------ If line antialiasing is disabled, the actual width is determined by rounding--- the supplied width to the nearest integer. (If the rounding results in the--- value 0, it is as if the line width were 1.) If /delta x/ >= /delta y/, /i/--- pixels are filled in each column that is rasterized, where /i/ is the--- rounded value of 'lineWidth'. Otherwise, /i/ pixels are filled in each row--- that is rasterized.------ If antialiasing is enabled, line rasterization produces a fragment for each--- pixel square that intersects the region lying within the rectangle having--- width equal to the current line width, length equal to the actual length of--- the line, and centered on the mathematical line segment. The coverage value--- for each fragment is the window coordinate area of the intersection of the--- rectangular region with the corresponding pixel square. This value is saved--- and used in the final rasterization step.------ Not all widths can be supported when line antialiasing is enabled. If an--- unsupported width is requested, the nearest supported width is used. Only--- width 1 is guaranteed to be supported; others depend on the implementation.---  Likewise, there is a range for aliased line widths as well. To query the--- range of supported widths of antialiased lines and the size difference--- between supported widths within the range, query 'smoothLineWidthRange' and--- 'smoothLineWidthGranularity', respectively. For aliased lines, query the--- supported range with 'aliasedLineWidthRange'.------ The line width specified when 'lineWidth' is set is always returned when it--- is queried. Clamping and rounding for aliased and antialiased lines have no--- effect on the specified value.------ A non-antialiased line width may be clamped to an implementation-dependent--- maximum.  Query 'aliasedLineWidthRange' to determine the maximum width.------ An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if--- 'lineWidth' is set to a value less than or equal to zero.------ An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if--- 'lineWidth' is set during--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.--lineWidth :: StateVar GLfloat-lineWidth = makeStateVar (getFloat1 id GetLineWidth) glLineWidth-------------------------------------------------------------------------------------- | Line stippling masks out certain fragments produced by rasterization; those--- fragments will not be drawn. The masking is achieved by using three--- parameters: the repeat count (1st element of the 'lineStipple' pair, clamped--- to the range [ 1 .. 256 ]), the 16-bit line stipple pattern (2nd element),--- and an integer stipple counter /s/.------ The counter /s/ is reset to 0 at before the first action during--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is called and before--- each line segment during--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is generated. It is--- incremented after each fragment of a unit width aliased line segment is--- generated or after each /i/ fragments of an /i/ width line segment are--- generated. The /i/ fragments associated with count /s/ are masked out if--- @'Data.Bits.testBit' /pattern/ (( /s/ \/ /factor/ ) /mod/ 16)@ is 'False',--- otherwise these fragments are sent to the frame buffer. Bit zero of the--- pattern is the least significant bit, i.e. it is used first.------ Antialiased lines are treated as a sequence of rectangles of height 1 for--- purposes of stippling. Whether rectangle /s/ is rasterized or not depends on--- the fragment rule described for aliased lines, counting rectangles rather--- than groups of fragments.------ The initial value of 'lineStipple' is 'Nothing', i.e. line stippling is--- disabled.------ An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if--- 'lineStipple' is set during--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.--lineStipple :: StateVar (Maybe (GLint, GLushort))-lineStipple =-   makeStateVarMaybe-      (return CapLineStipple)-      (liftM2 (,) (getInteger1 id GetLineStippleRepeat)-                  (getInteger1 fromIntegral GetLineStipplePattern))-      (uncurry glLineStipple)-------------------------------------------------------------------------------------- | Controls whether line antialiasing is enabled. The initial state is--- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.--lineSmooth :: StateVar Capability-lineSmooth = makeCapability CapLineSmooth-------------------------------------------------------------------------------------- | The smallest and largest supported width of aliased lines.--aliasedLineWidthRange :: GettableStateVar (GLfloat, GLfloat)-aliasedLineWidthRange =-   makeGettableStateVar $ getFloat2 (,) GetAliasedLineWidthRange---- | The smallest and largest supported width of antialiased lines.--smoothLineWidthRange :: GettableStateVar (GLfloat, GLfloat)-smoothLineWidthRange =-   makeGettableStateVar $ getFloat2 (,) GetSmoothLineWidthRange---- | The antialiased line width granularity, i.e. the size difference between--- supported widths.--smoothLineWidthGranularity :: GettableStateVar GLfloat-smoothLineWidthGranularity =-   makeGettableStateVar $ getFloat1 id GetSmoothLineWidthGranularity
− Graphics/Rendering/OpenGL/GL/PeekPoke.hs 
@@ -1,107 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PeekPoke--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module with peek- and poke-related utilities.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PeekPoke (-   poke1, poke2, poke3, poke4,-   peek1, peek2, peek3, peek4,-   peek1M, peek2M, peek3M, peek4M-) where--import Foreign.Ptr-import Foreign.Storable------------------------------------------------------------------------------------- The implementation is little bit verbose/redundant, but seems to generate--- better code than mapM/zipWithM_.------------------------------------------------------------------------------------{-# INLINE poke1 #-}-poke1 :: Storable a => Ptr a -> a -> IO ()-poke1 ptr x =-   pokeElemOff ptr 0 x--{-# INLINE poke2 #-}-poke2 :: Storable a => Ptr a -> a -> a -> IO ()-poke2 ptr x y = do-   pokeElemOff ptr 0 x-   pokeElemOff ptr 1 y--{-# INLINE poke3 #-}-poke3 :: Storable a => Ptr a -> a -> a -> a -> IO ()-poke3 ptr x y z = do-   pokeElemOff ptr 0 x-   pokeElemOff ptr 1 y-   pokeElemOff ptr 2 z--{-# INLINE poke4 #-}-poke4 :: Storable a => Ptr a -> a -> a -> a -> a -> IO ()-poke4 ptr x y z w = do-   pokeElemOff ptr 0 x-   pokeElemOff ptr 1 y-   pokeElemOff ptr 2 z-   pokeElemOff ptr 3 w------------------------------------------------------------------------------------{-# INLINE peek1 #-}-peek1 :: Storable a => (a -> b) -> Ptr a -> IO b-peek1 f ptr = do-   x <- peekElemOff ptr 0-   return $ f x--{-# INLINE peek2 #-}-peek2 :: Storable a => (a -> a -> b) -> Ptr a -> IO b-peek2 f = peek2M $ \x y -> return (f x y)--{-# INLINE peek3 #-}-peek3 :: Storable a => (a -> a -> a -> b) -> Ptr a -> IO b-peek3 f = peek3M $ \x y z -> return (f x y z)--{-# INLINE peek4 #-}-peek4 :: Storable a => (a -> a -> a -> a -> b) -> Ptr a -> IO b-peek4 f = peek4M $ \x y z w -> return (f x y z w)------------------------------------------------------------------------------------{-# INLINE peek1M #-}-peek1M :: Storable a => (a -> IO b) -> Ptr a -> IO b-peek1M f ptr = do-   x <- peekElemOff ptr 0-   f x--{-# INLINE peek2M #-}-peek2M :: Storable a => (a -> a -> IO b) -> Ptr a -> IO b-peek2M f ptr = do-   x <- peekElemOff ptr 0-   y <- peekElemOff ptr 1-   f x y--{-# INLINE peek3M #-}-peek3M :: Storable a => (a -> a -> a -> IO b) -> Ptr a -> IO b-peek3M f ptr = do-   x <- peekElemOff ptr 0-   y <- peekElemOff ptr 1-   z <- peekElemOff ptr 2-   f x y z--{-# INLINE peek4M #-}-peek4M :: Storable a => (a -> a -> a -> a -> IO b) -> Ptr a -> IO b-peek4M f ptr = do-   x <- peekElemOff ptr 0-   y <- peekElemOff ptr 1-   z <- peekElemOff ptr 2-   w <- peekElemOff ptr 3-   f x y z w
− Graphics/Rendering/OpenGL/GL/PerFragment.hs 
@@ -1,468 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PerFragment--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 4.1 (Per-Fragment Operations) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PerFragment (-   -- * Scissor Test-   scissor,--   -- * Multisample Fragment Operations-   sampleAlphaToCoverage,  sampleAlphaToOne, sampleCoverage,--   -- * Depth Bounds Test-   depthBounds,--   -- * Alpha Test-   ComparisonFunction(..), alphaFunc,--   -- * Stencil Test-   stencilTest, stencilFunc, stencilFuncSeparate, StencilOp(..), stencilOp,-   stencilOpSeparate, activeStencilFace,--   -- * Depth Buffer Test-   depthFunc,--   -- * Occlusion Queries-   QueryObject(QueryObject), QueryTarget(..), withQuery,-   beginQuery, endQuery,-   queryCounterBits, currentQuery,-   queryResult, queryResultAvailable,--   -- * Blending-   blend, BlendEquation(..), blendEquation, blendEquationSeparate,-   BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor,--   -- * Dithering-   dither,--   -- * Logical Operation-   LogicOp(..), logicOp-) where--import Control.Monad-import Data.ObjectName-import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Graphics.Rendering.OpenGL.GL.BlendingFactor-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.ComparisonFunction-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.Face-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glAlphaFunc, gl_INDEX_LOGIC_OP )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( glDepthBounds )-import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( glActiveStencilFace )------------------------------------------------------------------------------------scissor :: StateVar (Maybe (Position, Size))-scissor =-   makeStateVarMaybe-      (return CapScissorTest)-      (getInteger4 makeSB GetScissorBox)-      (\(Position x y, Size w h) -> glScissor x y w h)-   where makeSB x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))------------------------------------------------------------------------------------sampleAlphaToCoverage :: StateVar Capability-sampleAlphaToCoverage = makeCapability CapSampleAlphaToCoverage--sampleAlphaToOne :: StateVar Capability-sampleAlphaToOne = makeCapability CapSampleAlphaToOne--sampleCoverage :: StateVar (Maybe (GLclampf, Bool))-sampleCoverage =-   makeStateVarMaybe-      (return CapSampleCoverage)-      (liftM2 (,) (getClampf1 id GetSampleCoverageValue)-                  (getBoolean1 unmarshalGLboolean GetSampleCoverageInvert))-      (\(value, invert) -> glSampleCoverage value (marshalGLboolean invert))------------------------------------------------------------------------------------depthBounds :: StateVar (Maybe (GLclampd, GLclampd))-depthBounds =-   makeStateVarMaybe-      (return CapDepthBoundsTest)-      (getClampd2 (,) GetDepthBounds)-      (uncurry glDepthBounds)------------------------------------------------------------------------------------alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))-alphaFunc =-   makeStateVarMaybe-      (return CapAlphaTest)-      (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc)-                  (getClampf1 id GetAlphaTestRef))-      (uncurry (glAlphaFunc . marshalComparisonFunction))------------------------------------------------------------------------------------stencilTest :: StateVar Capability-stencilTest = makeCapability CapStencilTest------------------------------------------------------------------------------------stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint)-stencilFunc =-   makeStateVar-      (liftM3 (,,) (getEnum1 unmarshalComparisonFunction GetStencilFunc)-                   (getInteger1 id GetStencilRef)-                   (getInteger1 fromIntegral GetStencilValueMask))-      (\(func, ref, mask) ->-         glStencilFunc (marshalComparisonFunction func) ref mask)--stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint)-stencilFuncSeparate face =-   makeSettableStateVar $ \(func, ref, mask) ->-      glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask------------------------------------------------------------------------------------data StencilOp =-     OpZero-   | OpKeep-   | OpReplace-   | OpIncr-   | OpIncrWrap-   | OpDecr-   | OpDecrWrap-   | OpInvert-   deriving ( Eq, Ord, Show )--marshalStencilOp :: StencilOp -> GLenum-marshalStencilOp x = case x of-   OpZero -> gl_ZERO-   OpKeep -> gl_KEEP-   OpReplace -> gl_REPLACE-   OpIncr -> gl_INCR-   OpIncrWrap -> gl_INCR_WRAP-   OpDecr -> gl_DECR-   OpDecrWrap -> gl_DECR_WRAP-   OpInvert -> gl_INVERT--unmarshalStencilOp :: GLenum -> StencilOp-unmarshalStencilOp x-   | x == gl_ZERO = OpZero-   | x == gl_KEEP = OpKeep-   | x == gl_REPLACE = OpReplace-   | x == gl_INCR = OpIncr-   | x == gl_INCR_WRAP = OpIncrWrap-   | x == gl_DECR = OpDecr-   | x == gl_DECR_WRAP = OpDecrWrap-   | x == gl_INVERT = OpInvert-   | otherwise = error ("unmarshalStencilOp: illegal value " ++ show x)------------------------------------------------------------------------------------stencilOp :: StateVar (StencilOp, StencilOp, StencilOp)-stencilOp =-   makeStateVar-      (liftM3 (,,) (getEnum1 unmarshalStencilOp GetStencilFail)-                   (getEnum1 unmarshalStencilOp GetStencilPassDepthFail)-                   (getEnum1 unmarshalStencilOp GetStencilPassDepthPass))-      (\(sf, spdf, spdp) -> glStencilOp (marshalStencilOp sf)-                                        (marshalStencilOp spdf)-                                        (marshalStencilOp spdp))--stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp)-stencilOpSeparate face =-   makeSettableStateVar $ \(sf, spdf, spdp) ->-      glStencilOpSeparate (marshalFace face)-                          (marshalStencilOp sf)-                          (marshalStencilOp spdf)-                          (marshalStencilOp spdp)------------------------------------------------------------------------------------activeStencilFace :: StateVar (Maybe Face)-activeStencilFace =-   makeStateVarMaybe-      (return CapStencilTestTwoSide)-      (getEnum1 unmarshalFace GetActiveStencilFace)-      (glActiveStencilFace . marshalFace)------------------------------------------------------------------------------------depthFunc :: StateVar (Maybe ComparisonFunction)-depthFunc =-   makeStateVarMaybe-      (return CapDepthTest)-      (getEnum1 unmarshalComparisonFunction GetDepthFunc)-      (glDepthFunc . marshalComparisonFunction)------------------------------------------------------------------------------------newtype QueryObject = QueryObject { queryID :: GLuint }-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------instance ObjectName QueryObject where-   genObjectNames n =-      allocaArray n $ \buf -> do-        glGenQueries (fromIntegral n) buf-        fmap (map QueryObject) $ peekArray n buf--   deleteObjectNames queryObjects =-      withArrayLen (map queryID queryObjects) $-         glDeleteQueries . fromIntegral--   isObjectName = fmap unmarshalGLboolean . glIsQuery . queryID------------------------------------------------------------------------------------data QueryTarget =-     SamplesPassed-   deriving ( Eq, Ord, Show )--marshalQueryTarget :: QueryTarget -> GLenum-marshalQueryTarget x = case x of-   SamplesPassed -> gl_SAMPLES_PASSED------------------------------------------------------------------------------------beginQuery :: QueryTarget -> QueryObject -> IO ()-beginQuery t = glBeginQuery (marshalQueryTarget t) . queryID--endQuery :: QueryTarget -> IO ()-endQuery = glEndQuery . marshalQueryTarget---- | Convenience function for an exception-safe combination of 'beginQuery' and--- 'endQuery'.-withQuery :: QueryTarget -> QueryObject -> IO a -> IO a-withQuery t q = bracket_ (beginQuery t q) (endQuery t)------------------------------------------------------------------------------------data GetQueryPName =-     QueryCounterBits-   | CurrentQuery--marshalGetQueryPName :: GetQueryPName -> GLenum-marshalGetQueryPName x = case x of-   QueryCounterBits -> gl_QUERY_COUNTER_BITS-   CurrentQuery -> gl_CURRENT_QUERY------------------------------------------------------------------------------------queryCounterBits :: QueryTarget -> GettableStateVar GLsizei-queryCounterBits = getQueryi fromIntegral QueryCounterBits--currentQuery :: QueryTarget -> GettableStateVar (Maybe QueryObject)-currentQuery =-   getQueryi-      (\q -> if q == 0 then Nothing else Just (QueryObject (fromIntegral q)))-      CurrentQuery--getQueryi :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a-getQueryi f p t =-   makeGettableStateVar $-      alloca $ \buf -> do-         glGetQueryiv (marshalQueryTarget t) (marshalGetQueryPName p) buf-         peek1 f buf------------------------------------------------------------------------------------data GetQueryObjectPName =-     QueryResult-   | QueryResultAvailable--marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum-marshalGetQueryObjectPName x = case x of-   QueryResult -> gl_QUERY_RESULT-   QueryResultAvailable -> gl_QUERY_RESULT_AVAILABLE------------------------------------------------------------------------------------queryResult :: QueryObject -> GettableStateVar GLuint-queryResult = getQueryObjectui id QueryResult--queryResultAvailable :: QueryObject -> GettableStateVar Bool-queryResultAvailable = getQueryObjectui unmarshalGLboolean QueryResultAvailable--getQueryObjectui ::-   (GLuint -> a) -> GetQueryObjectPName -> QueryObject -> GettableStateVar a-getQueryObjectui f p q =-   makeGettableStateVar $-      alloca $ \buf -> do-         glGetQueryObjectuiv (queryID q) (marshalGetQueryObjectPName p) buf-         peek1 f buf------------------------------------------------------------------------------------blend :: StateVar Capability-blend = makeCapability CapBlend------------------------------------------------------------------------------------data BlendEquation =-     FuncAdd-   | FuncSubtract-   | FuncReverseSubtract-   | Min-   | Max-   | LogicOp-   deriving ( Eq, Ord, Show )--marshalBlendEquation :: BlendEquation -> GLenum-marshalBlendEquation x = case x of-   FuncAdd -> gl_FUNC_ADD-   FuncSubtract -> gl_FUNC_SUBTRACT-   FuncReverseSubtract -> gl_FUNC_REVERSE_SUBTRACT-   Min -> gl_MIN-   Max -> gl_MAX-   LogicOp -> gl_INDEX_LOGIC_OP--unmarshalBlendEquation :: GLenum -> BlendEquation-unmarshalBlendEquation x-   | x == gl_FUNC_ADD = FuncAdd-   | x == gl_FUNC_SUBTRACT = FuncSubtract-   | x == gl_FUNC_REVERSE_SUBTRACT = FuncReverseSubtract-   | x == gl_MIN = Min-   | x == gl_MAX = Max-   | x == gl_INDEX_LOGIC_OP = LogicOp-   | otherwise = error ("unmarshalBlendEquation: illegal value " ++ show x)------------------------------------------------------------------------------------blendEquation :: StateVar BlendEquation-blendEquation =-   makeStateVar-      (getEnum1 unmarshalBlendEquation GetBlendEquation)-      (glBlendEquation . marshalBlendEquation)--blendEquationSeparate :: StateVar (BlendEquation,BlendEquation)-blendEquationSeparate =-   makeStateVar-      (liftM2 (,) (getEnum1 unmarshalBlendEquation GetBlendEquation)-                  (getEnum1 unmarshalBlendEquation GetBlendEquationAlpha))-      (\(funcRGB, funcAlpha) ->-          glBlendEquationSeparate (marshalBlendEquation funcRGB)-                                  (marshalBlendEquation funcAlpha))------------------------------------------------------------------------------------blendFuncSeparate ::-   StateVar ((BlendingFactor, BlendingFactor), (BlendingFactor, BlendingFactor))-blendFuncSeparate =-   makeStateVar-      (do srcRGB   <- getEnum1 unmarshalBlendingFactor GetBlendSrcRGB-          srcAlpha <- getEnum1 unmarshalBlendingFactor GetBlendSrcAlpha-          dstRGB   <- getEnum1 unmarshalBlendingFactor GetBlendDstRGB-          dstAlpha <- getEnum1 unmarshalBlendingFactor GetBlendDstAlpha-          return ((srcRGB, srcAlpha), (dstRGB, dstAlpha)))-      (\((srcRGB, srcAlpha), (dstRGB, dstAlpha)) ->-         glBlendFuncSeparate (marshalBlendingFactor srcRGB)-                             (marshalBlendingFactor srcAlpha)-                             (marshalBlendingFactor dstRGB)-                             (marshalBlendingFactor dstAlpha))--blendFunc :: StateVar (BlendingFactor, BlendingFactor)-blendFunc =-   makeStateVar-      (liftM2 (,) (getEnum1 unmarshalBlendingFactor GetBlendSrc)-                  (getEnum1 unmarshalBlendingFactor GetBlendDst))-      (\(s, d) ->-         glBlendFunc (marshalBlendingFactor s) (marshalBlendingFactor d))--blendColor :: StateVar (Color4 GLclampf)-blendColor =-   makeStateVar-      (getClampf4 Color4 GetBlendColor)-      (\(Color4 r g b a) -> glBlendColor r g b a)------------------------------------------------------------------------------------dither :: StateVar Capability-dither = makeCapability CapDither------------------------------------------------------------------------------------data LogicOp =-     Clear-   | And-   | AndReverse-   | Copy-   | AndInverted-   | Noop-   | Xor-   | Or-   | Nor-   | Equiv-   | Invert-   | OrReverse-   | CopyInverted-   | OrInverted-   | Nand-   | Set-   deriving ( Eq, Ord, Show )--marshalLogicOp :: LogicOp -> GLenum-marshalLogicOp x = case x of-   Clear -> gl_CLEAR-   And -> gl_AND-   AndReverse -> gl_AND_REVERSE-   Copy -> gl_COPY-   AndInverted -> gl_AND_INVERTED-   Noop -> gl_NOOP-   Xor -> gl_XOR-   Or -> gl_OR-   Nor -> gl_NOR-   Equiv -> gl_EQUIV-   Invert -> gl_INVERT-   OrReverse -> gl_OR_REVERSE-   CopyInverted -> gl_COPY_INVERTED-   OrInverted -> gl_OR_INVERTED-   Nand -> gl_NAND-   Set -> gl_SET--unmarshalLogicOp :: GLenum -> LogicOp-unmarshalLogicOp x-   | x == gl_CLEAR = Clear-   | x == gl_AND = And-   | x == gl_AND_REVERSE = AndReverse-   | x == gl_COPY = Copy-   | x == gl_AND_INVERTED = AndInverted-   | x == gl_NOOP = Noop-   | x == gl_XOR = Xor-   | x == gl_OR = Or-   | x == gl_NOR = Nor-   | x == gl_EQUIV = Equiv-   | x == gl_INVERT = Invert-   | x == gl_OR_REVERSE = OrReverse-   | x == gl_COPY_INVERTED = CopyInverted-   | x == gl_OR_INVERTED = OrInverted-   | x == gl_NAND = Nand-   | x == gl_SET = Set-   | otherwise = error ("unmarshalLogicOp: illegal value " ++ show x)------------------------------------------------------------------------------------logicOp :: StateVar (Maybe LogicOp)-logicOp =-   makeStateVarMaybe-      (do rgba <- get rgbaMode-          return $ if rgba then CapColorLogicOp else CapIndexLogicOp)-      (getEnum1 unmarshalLogicOp GetLogicOpMode)-      (glLogicOp . marshalLogicOp)
− Graphics/Rendering/OpenGL/GL/PixelData.hs 
@@ -1,32 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelData--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal helper module.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelData (-   PixelData(..), withPixelData-) where--import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.DataType-import Graphics.Rendering.OpenGL.GL.PixelFormat-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data PixelData a = PixelData PixelFormat DataType (Ptr a)-   deriving ( Eq, Ord, Show )--withPixelData :: PixelData a -> (GLenum -> GLenum -> Ptr a -> b) -> b-withPixelData (PixelData pixelFormat dataType ptr) f =-   f (marshalPixelFormat pixelFormat) (marshalDataType dataType) ptr
− Graphics/Rendering/OpenGL/GL/PixelFormat.hs 
@@ -1,106 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelFormat--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling PixelFormat.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelFormat (-   PixelFormat(..), marshalPixelFormat, unmarshalPixelFormat-) where--import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_COLOR_INDEX, gl_LUMINANCE, gl_LUMINANCE_ALPHA )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.Abgr ( gl_ABGR )-import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka ( gl_CMYK, gl_CMYKA )-import Graphics.Rendering.OpenGL.Raw.EXT.FourTwoTwoPixels (-   gl_422, gl_422_AVERAGE, gl_422_REV, gl_422_REV_AVERAGE )------------------------------------------------------------------------------------data PixelFormat =-     ColorIndex-   | StencilIndex-   | DepthComponent-   | Red-   | Green-   | Blue-   | Alpha-   | RGB-   | RGBA-   | Luminance-   | LuminanceAlpha-   | ABGR-   | BGR-   | BGRA-   | CMYK-   | CMYKA-   | FourTwoTwo-   | FourTwoTwoRev-   | FourTwoTwoAverage-   | FourTwoTwoRevAverage-   | YCBCR422-   | DepthStencil-   deriving ( Eq, Ord, Show )--marshalPixelFormat :: PixelFormat -> GLenum-marshalPixelFormat x = case x of-   ColorIndex -> gl_COLOR_INDEX-   StencilIndex -> gl_STENCIL_INDEX-   DepthComponent -> gl_DEPTH_COMPONENT-   Red -> gl_RED-   Green -> gl_GREEN-   Blue -> gl_BLUE-   Alpha -> gl_ALPHA-   RGB -> gl_RGB-   RGBA -> gl_RGBA-   Luminance -> gl_LUMINANCE-   LuminanceAlpha -> gl_LUMINANCE_ALPHA-   ABGR -> gl_ABGR-   BGR -> gl_BGR-   BGRA -> gl_BGRA-   CMYK -> gl_CMYK-   CMYKA -> gl_CMYKA-   FourTwoTwo -> gl_422-   FourTwoTwoRev -> gl_422_REV-   FourTwoTwoAverage -> gl_422_AVERAGE-   FourTwoTwoRevAverage -> gl_422_REV_AVERAGE-   -- TODO: Use YCBCR_422_APPLE from APPLE_ycbcr_422 extension-   YCBCR422 -> 0x85B9-   DepthStencil -> gl_DEPTH_STENCIL--unmarshalPixelFormat :: GLenum -> PixelFormat-unmarshalPixelFormat x-   | x == gl_COLOR_INDEX = ColorIndex-   | x == gl_STENCIL_INDEX = StencilIndex-   | x == gl_DEPTH_COMPONENT = DepthComponent-   | x == gl_RED = Red-   | x == gl_GREEN = Green-   | x == gl_BLUE = Blue-   | x == gl_ALPHA = Alpha-   | x == gl_RGB = RGB-   | x == gl_RGBA = RGBA-   | x == gl_LUMINANCE = Luminance-   | x == gl_LUMINANCE_ALPHA = LuminanceAlpha-   | x == gl_ABGR = ABGR-   | x == gl_BGR = BGR-   | x == gl_BGRA = BGRA-   | x == gl_CMYK = CMYK-   | x == gl_CMYKA = CMYKA-   | x == gl_422 = FourTwoTwo-   | x == gl_422_REV = FourTwoTwoRev-   | x == gl_422_AVERAGE = FourTwoTwoAverage-   | x == gl_422_REV_AVERAGE = FourTwoTwoRevAverage-   -- TODO: Use YCBCR_422_APPLE from APPLE_ycbcr_422 extension-   | x == 0x85B9 = YCBCR422-   | x == gl_DEPTH_STENCIL = DepthStencil-   | otherwise = error ("unmarshalPixelFormat: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/PixelRectangles.hs 
@@ -1,34 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.6 (Pixel Rectangles) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles (-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax,-   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization-) where--import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage-import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer-import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization
− Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs 
@@ -1,262 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of--- the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (-   ColorTableStage(..), colorTableStage,-   Proxy(..), ColorTable(..), PixelInternalFormat(..),-   colorTable, getColorTable, copyColorTable, colorSubTable, copyColorSubTable,-   colorTableScale, colorTableBias, colorTableFormat, colorTableWidth,-   colorTableRGBASizes, colorTableLuminanceSize, colorTableIntesitySize,-) where--import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.PixelData-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glColorSubTable, glColorTable, glColorTableParameterfv, glCopyColorSubTable,-   glCopyColorTable, glGetColorTable, glGetColorTableParameterfv,-   glGetColorTableParameteriv, gl_COLOR_TABLE, gl_COLOR_TABLE_ALPHA_SIZE,-   gl_COLOR_TABLE_BIAS, gl_COLOR_TABLE_BLUE_SIZE, gl_COLOR_TABLE_FORMAT,-   gl_COLOR_TABLE_GREEN_SIZE, gl_COLOR_TABLE_INTENSITY_SIZE,-   gl_COLOR_TABLE_LUMINANCE_SIZE, gl_COLOR_TABLE_RED_SIZE, gl_COLOR_TABLE_SCALE,-   gl_COLOR_TABLE_WIDTH, gl_POST_COLOR_MATRIX_COLOR_TABLE,-   gl_POST_CONVOLUTION_COLOR_TABLE, gl_PROXY_COLOR_TABLE,-   gl_PROXY_POST_COLOR_MATRIX_COLOR_TABLE,-   gl_PROXY_POST_CONVOLUTION_COLOR_TABLE )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.SharedTexturePalette (-   gl_SHARED_TEXTURE_PALETTE )------------------------------------------------------------------------------------data ColorTableStage =-     ColorTableStage-   | PostConvolutionColorTableStage-   | PostColorMatrixColorTableStage-   | TextureColorTableStage-   deriving ( Eq, Ord, Show )--colorTableStageToColorTable :: ColorTableStage -> ColorTable-colorTableStageToColorTable x = case x of-   ColorTableStage -> ColorTable-   PostConvolutionColorTableStage -> PostConvolutionColorTable-   PostColorMatrixColorTableStage -> PostColorMatrixColorTable-   TextureColorTableStage -> TextureColorTable--colorTableStageToEnableCap :: ColorTableStage -> EnableCap-colorTableStageToEnableCap x = case x of-   ColorTableStage -> CapColorTable-   PostConvolutionColorTableStage -> CapPostConvolutionColorTable-   PostColorMatrixColorTableStage -> CapPostColorMatrixColorTable-   TextureColorTableStage -> CapTextureColorTable------------------------------------------------------------------------------------colorTableStage :: ColorTableStage -> StateVar Capability-colorTableStage = makeCapability . colorTableStageToEnableCap------------------------------------------------------------------------------------data ColorTable =-     ColorTable-   | PostConvolutionColorTable-   | PostColorMatrixColorTable-   | Texture1DColorTable-   | Texture2DColorTable-   | Texture3DColorTable-   | TextureCubeMapColorTable-   | TextureColorTable-   | SharedTexturePalette-   deriving ( Eq, Ord, Show )--marshalColorTable :: ColorTable -> GLenum-marshalColorTable x = case x of-   ColorTable -> gl_COLOR_TABLE-   PostConvolutionColorTable -> gl_POST_CONVOLUTION_COLOR_TABLE-   PostColorMatrixColorTable -> gl_POST_COLOR_MATRIX_COLOR_TABLE-   Texture1DColorTable -> gl_TEXTURE_1D-   Texture2DColorTable -> gl_TEXTURE_2D-   Texture3DColorTable -> gl_TEXTURE_3D-   TextureCubeMapColorTable -> gl_TEXTURE_CUBE_MAP-   -- TODO: Use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension-   TextureColorTable -> 0x80bc-   SharedTexturePalette -> gl_SHARED_TEXTURE_PALETTE------------------------------------------------------------------------------------data Proxy =-     NoProxy-   | Proxy-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------marshalProxyColorTable :: Proxy -> ColorTable -> Maybe GLenum-marshalProxyColorTable NoProxy x = Just (marshalColorTable x)-marshalProxyColorTable Proxy   x = case x of-   ColorTable -> Just gl_PROXY_COLOR_TABLE-   PostConvolutionColorTable -> Just gl_PROXY_POST_CONVOLUTION_COLOR_TABLE-   PostColorMatrixColorTable -> Just gl_PROXY_POST_COLOR_MATRIX_COLOR_TABLE-   Texture1DColorTable -> Just gl_PROXY_TEXTURE_1D-   Texture2DColorTable -> Just gl_PROXY_TEXTURE_2D-   Texture3DColorTable -> Just gl_PROXY_TEXTURE_3D-   TextureCubeMapColorTable -> Just gl_PROXY_TEXTURE_CUBE_MAP-   -- TODO: Use PROXY_TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension-   TextureColorTable -> Just 0x80bd-   SharedTexturePalette -> Nothing------------------------------------------------------------------------------------colorTable ::-   Proxy -> ColorTable -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()-colorTable proxy ct int w pd =-   maybe recordInvalidEnum-         (\target -> withPixelData pd $-            glColorTable target (marshalPixelInternalFormat' int) w)-         (marshalProxyColorTable proxy ct)------------------------------------------------------------------------------------getColorTable :: ColorTable -> PixelData a -> IO ()-getColorTable ct pd =-   withPixelData pd $ glGetColorTable (marshalColorTable ct)------------------------------------------------------------------------------------copyColorTable :: ColorTable -> PixelInternalFormat -> Position -> GLsizei -> IO ()-copyColorTable ct int (Position x y) =-   glCopyColorTable (marshalColorTable ct) (marshalPixelInternalFormat' int) x y------------------------------------------------------------------------------------colorSubTable :: ColorTable -> GLsizei -> GLsizei -> PixelData a -> IO ()-colorSubTable ct start count pd =-   withPixelData pd $ glColorSubTable (marshalColorTable ct) start count------------------------------------------------------------------------------------copyColorSubTable :: ColorTable -> GLsizei -> Position -> GLsizei -> IO ()-copyColorSubTable ct start (Position x y) =-   glCopyColorSubTable (marshalColorTable ct) start x y------------------------------------------------------------------------------------data ColorTablePName =-     ColorTableScale-   | ColorTableBias-   | ColorTableFormat-   | ColorTableWidth-   | ColorTableRedSize-   | ColorTableGreenSize-   | ColorTableBlueSize-   | ColorTableAlphaSize-   | ColorTableLuminanceSize-   | ColorTableIntensitySize--marshalColorTablePName :: ColorTablePName -> GLenum-marshalColorTablePName x = case x of-   ColorTableScale -> gl_COLOR_TABLE_SCALE-   ColorTableBias -> gl_COLOR_TABLE_BIAS-   ColorTableFormat -> gl_COLOR_TABLE_FORMAT-   ColorTableWidth -> gl_COLOR_TABLE_WIDTH-   ColorTableRedSize -> gl_COLOR_TABLE_RED_SIZE-   ColorTableGreenSize -> gl_COLOR_TABLE_GREEN_SIZE-   ColorTableBlueSize -> gl_COLOR_TABLE_BLUE_SIZE-   ColorTableAlphaSize -> gl_COLOR_TABLE_ALPHA_SIZE-   ColorTableLuminanceSize -> gl_COLOR_TABLE_LUMINANCE_SIZE-   ColorTableIntensitySize -> gl_COLOR_TABLE_INTENSITY_SIZE------------------------------------------------------------------------------------colorTableScale :: ColorTableStage -> StateVar (Color4 GLfloat)-colorTableScale = colorTableScaleBias ColorTableScale--colorTableBias :: ColorTableStage -> StateVar (Color4 GLfloat)-colorTableBias = colorTableScaleBias ColorTableBias--colorTableScaleBias ::-   ColorTablePName -> ColorTableStage -> StateVar (Color4 GLfloat)-colorTableScaleBias p s =-   makeStateVar (getColorTableParameterC4f ct p) (colorTableParameterC4f ct p)-   where ct = colorTableStageToColorTable s--getColorTableParameterC4f ::-   ColorTable -> ColorTablePName -> IO (Color4 GLfloat)-getColorTableParameterC4f ct p =-   alloca $ \buf -> do-      glGetColorTableParameterfv-         (marshalColorTable ct)-         (marshalColorTablePName p)-         (castPtr buf)-      peek buf--colorTableParameterC4f ::-   ColorTable -> ColorTablePName -> Color4 GLfloat -> IO ()-colorTableParameterC4f ct p c =-   with c $ \ptr ->-      glColorTableParameterfv (marshalColorTable ct) (marshalColorTablePName p) (castPtr ptr)------------------------------------------------------------------------------------colorTableFormat :: ColorTable -> GettableStateVar PixelInternalFormat-colorTableFormat ct =-   makeGettableStateVar $-      getColorTableParameteri unmarshalPixelInternalFormat ct ColorTableFormat--getColorTableParameteri :: (GLint -> a) -> ColorTable -> ColorTablePName -> IO a-getColorTableParameteri f ct p =-   alloca $ \buf -> do-      glGetColorTableParameteriv-         (marshalColorTable ct)-         (marshalColorTablePName p)-         buf-      peek1 f buf------------------------------------------------------------------------------------colorTableWidth :: ColorTable -> GettableStateVar GLsizei-colorTableWidth ct =-   makeGettableStateVar $-      getColorTableParameteri fromIntegral ct ColorTableWidth------------------------------------------------------------------------------------colorTableRGBASizes :: ColorTable -> GettableStateVar (Color4 GLsizei)-colorTableRGBASizes ct =-   makeGettableStateVar $ do-      r <- getColorTableParameteri fromIntegral ct ColorTableRedSize-      g <- getColorTableParameteri fromIntegral ct ColorTableGreenSize-      b <- getColorTableParameteri fromIntegral ct ColorTableBlueSize-      a <- getColorTableParameteri fromIntegral ct ColorTableAlphaSize-      return $ Color4 r g b a--colorTableLuminanceSize :: ColorTable -> GettableStateVar GLsizei-colorTableLuminanceSize ct =-   makeGettableStateVar $-      getColorTableParameteri fromIntegral ct ColorTableLuminanceSize--colorTableIntesitySize :: ColorTable -> GettableStateVar GLsizei-colorTableIntesitySize ct =-   makeGettableStateVar $-      getColorTableParameteri fromIntegral ct ColorTableIntensitySize
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs 
@@ -1,292 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of--- the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution (-   ConvolutionTarget(..), convolution,-   convolutionFilter1D, getConvolutionFilter1D,-   convolutionFilter2D, getConvolutionFilter2D,-   separableFilter2D, getSeparableFilter2D,-   copyConvolutionFilter1D, copyConvolutionFilter2D,-   convolutionWidth, convolutionHeight,-   maxConvolutionWidth, maxConvolutionHeight,-   ConvolutionBorderMode(..), convolutionBorderMode,-   convolutionFilterScale, convolutionFilterBias,-) where--import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.PixelData-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glConvolutionFilter1D, glConvolutionFilter2D, glConvolutionParameterfv,-   glConvolutionParameteri, glCopyConvolutionFilter1D,-   glCopyConvolutionFilter2D, glGetConvolutionFilter,-   glGetConvolutionParameterfv, glGetConvolutionParameteriv,-   glGetSeparableFilter, glSeparableFilter2D, gl_CONSTANT_BORDER,-   gl_CONVOLUTION_1D, gl_CONVOLUTION_2D, gl_CONVOLUTION_BORDER_COLOR,-   gl_CONVOLUTION_BORDER_MODE, gl_CONVOLUTION_FILTER_BIAS,-   gl_CONVOLUTION_FILTER_SCALE, gl_CONVOLUTION_FORMAT, gl_CONVOLUTION_HEIGHT,-   gl_CONVOLUTION_WIDTH, gl_MAX_CONVOLUTION_HEIGHT, gl_MAX_CONVOLUTION_WIDTH,-   gl_REDUCE, gl_REPLICATE_BORDER, gl_SEPARABLE_2D )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data ConvolutionTarget =-     Convolution1D-   | Convolution2D-   | Separable2D-   deriving ( Eq, Ord, Show )--marshalConvolutionTarget :: ConvolutionTarget -> GLenum-marshalConvolutionTarget x = case x of-   Convolution1D -> gl_CONVOLUTION_1D-   Convolution2D -> gl_CONVOLUTION_2D-   Separable2D -> gl_SEPARABLE_2D--convolutionTargetToEnableCap :: ConvolutionTarget -> EnableCap-convolutionTargetToEnableCap x = case x of-   Convolution1D -> CapConvolution1D-   Convolution2D -> CapConvolution2D-   Separable2D -> CapSeparable2D------------------------------------------------------------------------------------convolution :: ConvolutionTarget -> StateVar Capability-convolution = makeCapability . convolutionTargetToEnableCap------------------------------------------------------------------------------------convolutionFilter1D :: PixelInternalFormat -> GLsizei -> PixelData a -> IO ()-convolutionFilter1D int w pd =-   withPixelData pd $-      glConvolutionFilter1D-         (marshalConvolutionTarget Convolution1D)-         (marshalPixelInternalFormat' int) w------------------------------------------------------------------------------------getConvolutionFilter1D :: PixelData a -> IO ()-getConvolutionFilter1D = getConvolutionFilter Convolution1D--getConvolutionFilter :: ConvolutionTarget -> PixelData a -> IO ()-getConvolutionFilter t pd =-   withPixelData pd $ glGetConvolutionFilter (marshalConvolutionTarget t)------------------------------------------------------------------------------------convolutionFilter2D :: PixelInternalFormat -> Size -> PixelData a -> IO ()-convolutionFilter2D int (Size w h) pd =-   withPixelData pd $-      glConvolutionFilter2D-         (marshalConvolutionTarget Convolution2D)-         (marshalPixelInternalFormat' int) w h------------------------------------------------------------------------------------getConvolutionFilter2D :: PixelData a -> IO ()-getConvolutionFilter2D = getConvolutionFilter Convolution2D------------------------------------------------------------------------------------separableFilter2D ::-   PixelInternalFormat -> Size -> PixelData a -> PixelData a -> IO ()-separableFilter2D int (Size w h) pdRow pdCol =-   withPixelData pdRow $ \f1 d1 p1 ->-      withPixelData pdCol $ \f2 d2 p2 ->-         if f1 == f2 && d1 == d2-            then glSeparableFilter2D-                    (marshalConvolutionTarget Separable2D)-                    (marshalPixelInternalFormat' int) w h f1 d1 p1 p2-            else recordInvalidValue------------------------------------------------------------------------------------getSeparableFilter2D :: PixelData a -> PixelData a -> IO ()-getSeparableFilter2D pdRow pdCol =-   withPixelData pdRow $ \f1 d1 p1 ->-      withPixelData pdCol $ \f2 d2 p2 ->-         if f1 == f2 && d1 == d2-            then glGetSeparableFilter-                    (marshalConvolutionTarget Separable2D) f1 d1 p1 p2 nullPtr-            else recordInvalidValue------------------------------------------------------------------------------------copyConvolutionFilter1D :: PixelInternalFormat -> Position -> GLsizei -> IO ()-copyConvolutionFilter1D int (Position x y) =-   glCopyConvolutionFilter1D-      (marshalConvolutionTarget Convolution1D) (marshalPixelInternalFormat' int)-      x y------------------------------------------------------------------------------------copyConvolutionFilter2D :: PixelInternalFormat -> Position -> Size -> IO ()-copyConvolutionFilter2D int (Position x y) (Size w h) =-   glCopyConvolutionFilter2D-      (marshalConvolutionTarget Convolution2D) (marshalPixelInternalFormat' int)-      x y w h------------------------------------------------------------------------------------data ConvolutionParameter =-     ConvolutionBorderColor-   | ConvolutionBorderMode-   | ConvolutionFilterScale-   | ConvolutionFilterBias-   | ConvolutionFormat-   | ConvolutionWidth-   | ConvolutionHeight-   | MaxConvolutionWidth-   | MaxConvolutionHeight-   deriving ( Eq, Ord, Show )--marshalConvolutionParameter :: ConvolutionParameter -> GLenum-marshalConvolutionParameter x = case x of-   ConvolutionBorderColor -> gl_CONVOLUTION_BORDER_COLOR-   ConvolutionBorderMode -> gl_CONVOLUTION_BORDER_MODE-   ConvolutionFilterScale -> gl_CONVOLUTION_FILTER_SCALE-   ConvolutionFilterBias -> gl_CONVOLUTION_FILTER_BIAS-   ConvolutionFormat -> gl_CONVOLUTION_FORMAT-   ConvolutionWidth -> gl_CONVOLUTION_WIDTH-   ConvolutionHeight -> gl_CONVOLUTION_HEIGHT-   MaxConvolutionWidth -> gl_MAX_CONVOLUTION_WIDTH-   MaxConvolutionHeight -> gl_MAX_CONVOLUTION_HEIGHT------------------------------------------------------------------------------------convolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei-convolutionWidth t = convolutionParameteri t ConvolutionWidth--convolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei-convolutionHeight t = convolutionParameteri t ConvolutionHeight--maxConvolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei-maxConvolutionWidth t = convolutionParameteri t MaxConvolutionWidth--maxConvolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei-maxConvolutionHeight t = convolutionParameteri t MaxConvolutionHeight--convolutionParameteri ::-   ConvolutionTarget -> ConvolutionParameter -> GettableStateVar GLsizei-convolutionParameteri t p =-   makeGettableStateVar (getConvolutionParameteri fromIntegral t p)--getConvolutionParameteri ::-   (GLint -> a) -> ConvolutionTarget -> ConvolutionParameter -> IO a-getConvolutionParameteri f t p =-   alloca $ \buf -> do-      glGetConvolutionParameteriv-         (marshalConvolutionTarget t) (marshalConvolutionParameter p) buf-      peek1 f buf------------------------------------------------------------------------------------data ConvolutionBorderMode' =-     Reduce'-   | ConstantBorder'-   | ReplicateBorder'--marshalConvolutionBorderMode' :: ConvolutionBorderMode' -> GLint-marshalConvolutionBorderMode' x = fromIntegral $ case x of-   Reduce' -> gl_REDUCE-   ConstantBorder' -> gl_CONSTANT_BORDER-   ReplicateBorder' -> gl_REPLICATE_BORDER--unmarshalConvolutionBorderMode' :: GLint -> ConvolutionBorderMode'-unmarshalConvolutionBorderMode' x-   | y == gl_REDUCE = Reduce'-   | y == gl_CONSTANT_BORDER = ConstantBorder'-   | y == gl_REPLICATE_BORDER = ReplicateBorder'-   | otherwise = error ("unmarshalConvolutionBorderMode': illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------data ConvolutionBorderMode =-     Reduce-   | ConstantBorder (Color4 GLfloat)-   | ReplicateBorder-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------convolutionBorderMode :: ConvolutionTarget -> StateVar ConvolutionBorderMode-convolutionBorderMode t =-   makeStateVar (getConvolutionBorderMode t) (setConvolutionBorderMode t)--getConvolutionBorderMode :: ConvolutionTarget -> IO ConvolutionBorderMode-getConvolutionBorderMode t = do-   mode <- getConvolutionParameteri-              unmarshalConvolutionBorderMode' t ConvolutionBorderMode-   case mode of-      Reduce' -> return Reduce-      ConstantBorder' -> do-         c <- getConvolutionParameterC4f t ConvolutionBorderColor-         return $ ConstantBorder c-      ReplicateBorder' -> return ReplicateBorder--setConvolutionBorderMode :: ConvolutionTarget -> ConvolutionBorderMode -> IO ()-setConvolutionBorderMode t mode = do-   let setBM = setConvolutionParameteri-                  marshalConvolutionBorderMode' t ConvolutionBorderMode-   case mode of-      Reduce -> setBM Reduce'-      ConstantBorder c -> do-         setBM ConstantBorder'-         convolutionParameterC4f t ConvolutionBorderColor c-      ReplicateBorder -> setBM ReplicateBorder'--setConvolutionParameteri ::-   (a -> GLint) -> ConvolutionTarget -> ConvolutionParameter -> a -> IO ()-setConvolutionParameteri f t p x =-   glConvolutionParameteri-      (marshalConvolutionTarget t) (marshalConvolutionParameter p) (f x)------------------------------------------------------------------------------------convolutionFilterScale :: ConvolutionTarget -> StateVar (Color4 GLfloat)-convolutionFilterScale = convolutionC4f ConvolutionFilterScale--convolutionFilterBias :: ConvolutionTarget -> StateVar (Color4 GLfloat)-convolutionFilterBias = convolutionC4f ConvolutionFilterBias--convolutionC4f ::-   ConvolutionParameter -> ConvolutionTarget -> StateVar (Color4 GLfloat)-convolutionC4f p t =-   makeStateVar (getConvolutionParameterC4f t p) (convolutionParameterC4f t p)--getConvolutionParameterC4f ::-   ConvolutionTarget -> ConvolutionParameter -> IO (Color4 GLfloat)-getConvolutionParameterC4f t p =-   alloca $ \buf -> do-      glGetConvolutionParameterfv-         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr buf)-      peek buf--convolutionParameterC4f ::-   ConvolutionTarget -> ConvolutionParameter -> Color4 GLfloat -> IO ()-convolutionParameterC4f t p c =-   with c $ \ptr ->-      glConvolutionParameterfv-         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr ptr)
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs 
@@ -1,138 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of--- the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram (-   Sink(..), histogram, Reset(..), getHistogram, resetHistogram,-   histogramRGBASizes, histogramLuminanceSize-) where--import Data.StateVar-import Foreign.Marshal.Alloc-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.PixelData-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glGetHistogram, glGetHistogramParameteriv, glHistogram, glResetHistogram,-   gl_HISTOGRAM, gl_HISTOGRAM_ALPHA_SIZE, gl_HISTOGRAM_BLUE_SIZE,-   gl_HISTOGRAM_FORMAT, gl_HISTOGRAM_GREEN_SIZE, gl_HISTOGRAM_LUMINANCE_SIZE,-   gl_HISTOGRAM_RED_SIZE, gl_HISTOGRAM_SINK, gl_HISTOGRAM_WIDTH,-   gl_PROXY_HISTOGRAM )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data HistogramTarget =-     Histogram-   | ProxyHistogram--marshalHistogramTarget :: HistogramTarget -> GLenum-marshalHistogramTarget x = case x of-   Histogram -> gl_HISTOGRAM-   ProxyHistogram -> gl_PROXY_HISTOGRAM--proxyToHistogramTarget :: Proxy -> HistogramTarget-proxyToHistogramTarget x = case x of-   NoProxy -> Histogram-   Proxy -> ProxyHistogram------------------------------------------------------------------------------------histogram :: Proxy -> StateVar (Maybe (GLsizei, PixelInternalFormat, Sink))-histogram proxy =-   makeStateVarMaybe-      (return CapHistogram) (getHistogram' proxy) (setHistogram proxy)--getHistogram' :: Proxy -> IO (GLsizei, PixelInternalFormat, Sink)-getHistogram' proxy = do-   w <- getHistogramParameteri fromIntegral proxy HistogramWidth-   f <- getHistogramParameteri unmarshalPixelInternalFormat proxy HistogramFormat-   s <- getHistogramParameteri unmarshalSink proxy HistogramSink-   return (w, f, s)--getHistogramParameteri ::-   (GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a-getHistogramParameteri f proxy p =-   alloca $ \buf -> do-      glGetHistogramParameteriv-         (marshalHistogramTarget (proxyToHistogramTarget proxy))-         (marshalGetHistogramParameterPName p)-         buf-      peek1 f buf--setHistogram :: Proxy -> (GLsizei, PixelInternalFormat, Sink) -> IO ()-setHistogram proxy (w, int, sink) =-   glHistogram-      (marshalHistogramTarget (proxyToHistogramTarget proxy))-      w-      (marshalPixelInternalFormat' int)-      (marshalSink sink)------------------------------------------------------------------------------------getHistogram :: Reset -> PixelData a -> IO ()-getHistogram reset pd =-   withPixelData pd $-      glGetHistogram-         (marshalHistogramTarget Histogram)-         (marshalReset reset)------------------------------------------------------------------------------------resetHistogram :: IO ()-resetHistogram = glResetHistogram (marshalHistogramTarget Histogram)------------------------------------------------------------------------------------data GetHistogramParameterPName =-     HistogramWidth-   | HistogramFormat-   | HistogramRedSize-   | HistogramGreenSize-   | HistogramBlueSize-   | HistogramAlphaSize-   | HistogramLuminanceSize-   | HistogramSink--marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum-marshalGetHistogramParameterPName x = case x of-   HistogramWidth -> gl_HISTOGRAM_WIDTH-   HistogramFormat -> gl_HISTOGRAM_FORMAT-   HistogramRedSize -> gl_HISTOGRAM_RED_SIZE-   HistogramGreenSize -> gl_HISTOGRAM_GREEN_SIZE-   HistogramBlueSize -> gl_HISTOGRAM_BLUE_SIZE-   HistogramAlphaSize -> gl_HISTOGRAM_ALPHA_SIZE-   HistogramLuminanceSize -> gl_HISTOGRAM_LUMINANCE_SIZE-   HistogramSink -> gl_HISTOGRAM_SINK------------------------------------------------------------------------------------histogramRGBASizes :: Proxy -> GettableStateVar (Color4 GLsizei)-histogramRGBASizes proxy =-   makeGettableStateVar $ do-      r <- getHistogramParameteri fromIntegral proxy HistogramRedSize-      g <- getHistogramParameteri fromIntegral proxy HistogramGreenSize-      b <- getHistogramParameteri fromIntegral proxy HistogramBlueSize-      a <- getHistogramParameteri fromIntegral proxy HistogramAlphaSize-      return $ Color4 r g b a--histogramLuminanceSize :: Proxy -> GettableStateVar GLsizei-histogramLuminanceSize proxy =-   makeGettableStateVar $-      getHistogramParameteri fromIntegral proxy HistogramLuminanceSize
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs 
@@ -1,92 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of--- the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax (-   minmax, getMinmax, resetMinmax-) where--import Data.StateVar-import Foreign.Marshal.Alloc-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.PixelData-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glGetMinmax, glGetMinmaxParameteriv, glMinmax, glResetMinmax, gl_MINMAX,-   gl_MINMAX_FORMAT, gl_MINMAX_SINK )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data MinmaxTarget =-     Minmax--marshalMinmaxTarget :: MinmaxTarget -> GLenum-marshalMinmaxTarget x = case x of-   Minmax -> gl_MINMAX------------------------------------------------------------------------------------minmax :: StateVar (Maybe (PixelInternalFormat, Sink))-minmax = makeStateVarMaybe (return CapMinmax) getMinmax' setMinmax--getMinmax' :: IO (PixelInternalFormat, Sink)-getMinmax' = do-   f <- getMinmaxParameteri unmarshalPixelInternalFormat MinmaxFormat-   s <- getMinmaxParameteri unmarshalSink MinmaxSink-   return (f, s)--setMinmax :: (PixelInternalFormat, Sink) -> IO ()-setMinmax (int, sink) =-   glMinmax-      (marshalMinmaxTarget Minmax)-      (marshalPixelInternalFormat' int)-      (marshalSink sink)------------------------------------------------------------------------------------getMinmax :: Reset -> PixelData a -> IO ()-getMinmax reset pd =-   withPixelData pd $-      glGetMinmax (marshalMinmaxTarget Minmax) (marshalReset reset)------------------------------------------------------------------------------------resetMinmax :: IO ()-resetMinmax = glResetMinmax (marshalMinmaxTarget Minmax)------------------------------------------------------------------------------------data GetMinmaxParameterPName =-     MinmaxFormat-   | MinmaxSink--marshalGetMinmaxParameterPName :: GetMinmaxParameterPName -> GLenum-marshalGetMinmaxParameterPName x = case x of-   MinmaxFormat -> gl_MINMAX_FORMAT-   MinmaxSink -> gl_MINMAX_SINK------------------------------------------------------------------------------------getMinmaxParameteri :: (GLint -> a) -> GetMinmaxParameterPName -> IO a-getMinmaxParameteri f p =-   alloca $ \buf -> do-      glGetMinmaxParameteriv-         (marshalMinmaxTarget Minmax)-         (marshalGetMinmaxParameterPName p)-         buf-      peek1 f buf
− Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs 
@@ -1,212 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of--- the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap (-   PixelMapTarget(..), PixelMapComponent, PixelMap(..), GLpixelmap,-   maxPixelMapTable, pixelMap, pixelMapIToRGBA, pixelMapRGBAToRGBA,-) where--import Data.List-import Data.StateVar-import Foreign.ForeignPtr-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glGetPixelMapfv, glGetPixelMapuiv, glGetPixelMapusv, glPixelMapfv,-   glPixelMapuiv, glPixelMapusv, gl_PIXEL_MAP_A_TO_A, gl_PIXEL_MAP_B_TO_B,-   gl_PIXEL_MAP_G_TO_G, gl_PIXEL_MAP_I_TO_A, gl_PIXEL_MAP_I_TO_B,-   gl_PIXEL_MAP_I_TO_G, gl_PIXEL_MAP_I_TO_I, gl_PIXEL_MAP_I_TO_R,-   gl_PIXEL_MAP_R_TO_R, gl_PIXEL_MAP_S_TO_S )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data PixelMapTarget =-     IToI-   | SToS-   | IToR-   | IToG-   | IToB-   | IToA-   | RToR-   | GToG-   | BToB-   | AToA--marshalPixelMapTarget :: PixelMapTarget -> GLenum-marshalPixelMapTarget x = case x of-   IToI -> gl_PIXEL_MAP_I_TO_I-   SToS -> gl_PIXEL_MAP_S_TO_S-   IToR -> gl_PIXEL_MAP_I_TO_R-   IToG -> gl_PIXEL_MAP_I_TO_G-   IToB -> gl_PIXEL_MAP_I_TO_B-   IToA -> gl_PIXEL_MAP_I_TO_A-   RToR -> gl_PIXEL_MAP_R_TO_R-   GToG -> gl_PIXEL_MAP_G_TO_G-   BToB -> gl_PIXEL_MAP_B_TO_B-   AToA -> gl_PIXEL_MAP_A_TO_A--pixelMapTargetToGetPName :: PixelMapTarget -> GetPName-pixelMapTargetToGetPName x = case x of-   IToI -> GetPixelMapIToISize-   SToS -> GetPixelMapSToSSize-   IToR -> GetPixelMapIToRSize-   IToG -> GetPixelMapIToGSize-   IToB -> GetPixelMapIToBSize-   IToA -> GetPixelMapIToASize-   RToR -> GetPixelMapRToRSize-   GToG -> GetPixelMapGToGSize-   BToB -> GetPixelMapBToBSize-   AToA -> GetPixelMapAToASize------------------------------------------------------------------------------------maxPixelMapTable :: GettableStateVar GLsizei-maxPixelMapTable = makeGettableStateVar $ getSizei1 id GetMaxPixelMapTable------------------------------------------------------------------------------------class Storable c => PixelMapComponent c where-   getPixelMapv :: GLenum -> Ptr c -> IO ()-   pixelMapv :: GLenum -> GLsizei -> Ptr c -> IO ()--instance PixelMapComponent GLushort where-   getPixelMapv = glGetPixelMapusv-   pixelMapv = glPixelMapusv--instance PixelMapComponent GLuint where-   getPixelMapv = glGetPixelMapuiv-   pixelMapv = glPixelMapuiv--instance PixelMapComponent GLfloat where-   getPixelMapv = glGetPixelMapfv-   pixelMapv = glPixelMapfv------------------------------------------------------------------------------------class PixelMap m where-   withNewPixelMap ::-      PixelMapComponent c => Int -> (Ptr c -> IO ()) -> IO (m c)-   withPixelMap ::-      PixelMapComponent c => m c -> (Int -> Ptr c -> IO a) -> IO a-   newPixelMap :: PixelMapComponent c => [c] -> IO (m c)-   getPixelMapComponents :: PixelMapComponent c => m c -> IO [c]--   withNewPixelMap size act =-      allocaArray size $ \p -> do-         act p-         components <- peekArray size p-         newPixelMap components--   withPixelMap m act = do-      components <- getPixelMapComponents m-      withArrayLen components act--   newPixelMap elements =-      withNewPixelMap (length elements) $ flip pokeArray elements--   getPixelMapComponents m =-      withPixelMap m peekArray------------------------------------------------------------------------------------data GLpixelmap a = GLpixelmap Int (ForeignPtr a)-   deriving ( Eq, Ord, Show )--instance PixelMap GLpixelmap where-   withNewPixelMap size f = do-      fp <- mallocForeignPtrArray size-      withForeignPtr fp f-      return $ GLpixelmap size fp--   withPixelMap (GLpixelmap size fp) f = withForeignPtr fp (f size)------------------------------------------------------------------------------------pixelMap :: (PixelMap m, PixelMapComponent c) => PixelMapTarget -> StateVar (m c)-pixelMap pm =-   makeStateVar-      (do size <- pixelMapSize pm-          withNewPixelMap size $ getPixelMapv (marshalPixelMapTarget pm))-      (\theMap -> withPixelMap theMap $ pixelMapv (marshalPixelMapTarget pm) . fromIntegral)--pixelMapSize :: PixelMapTarget -> IO Int-pixelMapSize = getInteger1 fromIntegral . pixelMapTargetToGetPName-------------------------------------------------------------------------------------- | Convenience state variable--pixelMapIToRGBA :: PixelMapComponent c => StateVar [Color4 c]-pixelMapIToRGBA = pixelMapXToY (IToR, IToG, IToB, IToA)---- | Convenience state variable--pixelMapRGBAToRGBA :: PixelMapComponent c => StateVar [Color4 c]-pixelMapRGBAToRGBA = pixelMapXToY (RToR, GToG, BToB, AToA)--pixelMapXToY :: PixelMapComponent c =>-      (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)-   -> StateVar [Color4 c]-pixelMapXToY targets =-   makeStateVar (getPixelMapXToY targets) (setPixelMapXToY targets)--getPixelMapXToY :: PixelMapComponent c-   => (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)-   -> IO [Color4 c]-getPixelMapXToY (toR, toG, toB, toA) = do-   withPixelMapFor toR $ \sizeR bufR ->-      withPixelMapFor toG $ \sizeG bufG ->-         withPixelMapFor toB $ \sizeB bufB ->-            withPixelMapFor toA $ \sizeA bufA -> do-               let maxSize = sizeR `max` sizeG `max` sizeB `max` sizeA-               r <- sample sizeR bufR maxSize-               g <- sample sizeR bufG maxSize-               b <- sample sizeR bufB maxSize-               a <- sample sizeR bufA maxSize-               return $ zipWith4 Color4 r g b a--withPixelMapFor ::-    PixelMapComponent c => PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a-withPixelMapFor target f = do-    theMap <- get (pixelMap target)-    withGLpixelmap theMap f--withGLpixelmap :: PixelMapComponent c-               => GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a-withGLpixelmap = withPixelMap--sample :: Storable a => Int -> Ptr a -> Int -> IO [a]-sample len ptr newLen = f (fromIntegral (newLen - 1)) []-   where scale :: Float-         scale = fromIntegral len / fromIntegral newLen-         f l acc | l < 0     = return acc-                 | otherwise = do e <- peekElemOff ptr (truncate (l * scale))-                                  f (l - 1) (e : acc)--setPixelMapXToY :: PixelMapComponent c-   => (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)-   -> [Color4 c] -> IO ()-setPixelMapXToY (toR, toG, toB, toA) colors = do-   (pixelMap toR $=) =<< newGLpixelmap [ r | Color4 r _ _ _ <- colors ]-   (pixelMap toG $=) =<< newGLpixelmap [ g | Color4 _ g _ _ <- colors ]-   (pixelMap toB $=) =<< newGLpixelmap [ b | Color4 _ _ b _ <- colors ]-   (pixelMap toA $=) =<< newGLpixelmap [ a | Color4 _ _ _ a <- colors ]--newGLpixelmap :: PixelMapComponent c => [c] -> IO (GLpixelmap c)-newGLpixelmap = newPixelMap
− Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs 
@@ -1,118 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.6.1 (Pixel Storage Modes) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage (-   PixelStoreDirection(..), swapBytes, lsbFirst, rowLength, skipRows,-   skipPixels, rowAlignment, imageHeight, skipImages-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data PixelStoreDirection =-     Pack-   | Unpack-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------data PixelStore =-     UnpackSwapBytes-   | UnpackLSBFirst-   | UnpackRowLength-   | UnpackSkipRows-   | UnpackSkipPixels-   | UnpackAlignment-   | PackSwapBytes-   | PackLSBFirst-   | PackRowLength-   | PackSkipRows-   | PackSkipPixels-   | PackAlignment-   | PackSkipImages-   | PackImageHeight-   | UnpackSkipImages-   | UnpackImageHeight--marshalPixelStore :: PixelStore -> GLenum-marshalPixelStore x = case x of-   UnpackSwapBytes -> gl_UNPACK_SWAP_BYTES-   UnpackLSBFirst -> gl_UNPACK_LSB_FIRST-   UnpackRowLength -> gl_UNPACK_ROW_LENGTH-   UnpackSkipRows -> gl_UNPACK_SKIP_ROWS-   UnpackSkipPixels -> gl_UNPACK_SKIP_PIXELS-   UnpackAlignment -> gl_UNPACK_ALIGNMENT-   PackSwapBytes -> gl_PACK_SWAP_BYTES-   PackLSBFirst -> gl_PACK_LSB_FIRST-   PackRowLength -> gl_PACK_ROW_LENGTH-   PackSkipRows -> gl_PACK_SKIP_ROWS-   PackSkipPixels -> gl_PACK_SKIP_PIXELS-   PackAlignment -> gl_PACK_ALIGNMENT-   PackSkipImages -> gl_PACK_SKIP_IMAGES-   PackImageHeight -> gl_PACK_IMAGE_HEIGHT-   UnpackSkipImages -> gl_UNPACK_SKIP_IMAGES-   UnpackImageHeight -> gl_UNPACK_IMAGE_HEIGHT------------------------------------------------------------------------------------swapBytes :: PixelStoreDirection -> StateVar Bool-swapBytes Pack   = pixelStoreb GetPackSwapBytes PackSwapBytes-swapBytes Unpack = pixelStoreb GetUnpackSwapBytes UnpackSwapBytes--lsbFirst :: PixelStoreDirection -> StateVar Bool-lsbFirst Pack   = pixelStoreb GetPackLSBFirst PackLSBFirst-lsbFirst Unpack = pixelStoreb GetUnpackLSBFirst UnpackLSBFirst--rowLength :: PixelStoreDirection -> StateVar GLint-rowLength Pack   = pixelStorei GetPackRowLength PackRowLength-rowLength Unpack = pixelStorei GetUnpackRowLength UnpackRowLength--skipRows :: PixelStoreDirection -> StateVar GLint-skipRows Pack   = pixelStorei GetPackSkipRows PackSkipRows-skipRows Unpack = pixelStorei GetUnpackSkipRows UnpackSkipRows--skipPixels :: PixelStoreDirection -> StateVar GLint-skipPixels Pack   = pixelStorei GetPackSkipPixels PackSkipPixels-skipPixels Unpack = pixelStorei GetUnpackSkipPixels UnpackSkipPixels--rowAlignment :: PixelStoreDirection -> StateVar GLint-rowAlignment Pack   = pixelStorei GetPackAlignment PackAlignment-rowAlignment Unpack = pixelStorei GetUnpackAlignment UnpackAlignment--imageHeight :: PixelStoreDirection -> StateVar GLint-imageHeight Pack   = pixelStorei GetPackImageHeight PackImageHeight-imageHeight Unpack = pixelStorei GetUnpackImageHeight UnpackImageHeight--skipImages :: PixelStoreDirection -> StateVar GLint-skipImages Pack   = pixelStorei GetPackSkipImages PackSkipImages-skipImages Unpack = pixelStorei GetUnpackSkipImages UnpackSkipImages------------------------------------------------------------------------------------pixelStoreb :: GetPName -> PixelStore -> StateVar Bool-pixelStoreb pn ps =-   makeStateVar-      (getBoolean1 unmarshalGLboolean pn)-      (glPixelStorei (marshalPixelStore ps) . marshalGLboolean)--pixelStorei :: GetPName -> PixelStore -> StateVar GLint-pixelStorei pn ps =-   makeStateVar-      (getInteger1 id pn)-      (glPixelStorei (marshalPixelStore ps))
− Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs 
@@ -1,246 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of--- the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer (-   PixelTransferStage(..),-   mapColor, mapStencil, indexShift, indexOffset, depthScale, depthBias,-   rgbaScale, rgbaBias-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glPixelTransferf, glPixelTransferi, gl_ALPHA_BIAS, gl_ALPHA_SCALE,-   gl_BLUE_BIAS, gl_BLUE_SCALE, gl_DEPTH_BIAS, gl_DEPTH_SCALE, gl_GREEN_BIAS,-   gl_GREEN_SCALE, gl_INDEX_OFFSET, gl_INDEX_SHIFT, gl_MAP_COLOR,-   gl_MAP_STENCIL, gl_POST_COLOR_MATRIX_ALPHA_BIAS,-   gl_POST_COLOR_MATRIX_ALPHA_SCALE, gl_POST_COLOR_MATRIX_BLUE_BIAS,-   gl_POST_COLOR_MATRIX_BLUE_SCALE, gl_POST_COLOR_MATRIX_GREEN_BIAS,-   gl_POST_COLOR_MATRIX_GREEN_SCALE, gl_POST_COLOR_MATRIX_RED_BIAS,-   gl_POST_COLOR_MATRIX_RED_SCALE, gl_POST_CONVOLUTION_ALPHA_BIAS,-   gl_POST_CONVOLUTION_ALPHA_SCALE, gl_POST_CONVOLUTION_BLUE_BIAS,-   gl_POST_CONVOLUTION_BLUE_SCALE, gl_POST_CONVOLUTION_GREEN_BIAS,-   gl_POST_CONVOLUTION_GREEN_SCALE, gl_POST_CONVOLUTION_RED_BIAS,-   gl_POST_CONVOLUTION_RED_SCALE, gl_RED_BIAS, gl_RED_SCALE )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data PixelTransfer =-     MapColor-   | MapStencil-   | IndexShift-   | IndexOffset-   | RedScale-   | RedBias-   | GreenScale-   | GreenBias-   | BlueScale-   | BlueBias-   | AlphaScale-   | AlphaBias-   | DepthScale-   | DepthBias-   | PostConvolutionRedScale-   | PostConvolutionGreenScale-   | PostConvolutionBlueScale-   | PostConvolutionAlphaScale-   | PostConvolutionRedBias-   | PostConvolutionGreenBias-   | PostConvolutionBlueBias-   | PostConvolutionAlphaBias-   | PostColorMatrixRedScale-   | PostColorMatrixGreenScale-   | PostColorMatrixBlueScale-   | PostColorMatrixAlphaScale-   | PostColorMatrixRedBias-   | PostColorMatrixGreenBias-   | PostColorMatrixBlueBias-   | PostColorMatrixAlphaBias--marshalPixelTransfer :: PixelTransfer -> GLenum-marshalPixelTransfer x = case x of-   MapColor -> gl_MAP_COLOR-   MapStencil -> gl_MAP_STENCIL-   IndexShift -> gl_INDEX_SHIFT-   IndexOffset -> gl_INDEX_OFFSET-   RedScale -> gl_RED_SCALE-   RedBias -> gl_RED_BIAS-   GreenScale -> gl_GREEN_SCALE-   GreenBias -> gl_GREEN_BIAS-   BlueScale -> gl_BLUE_SCALE-   BlueBias -> gl_BLUE_BIAS-   AlphaScale -> gl_ALPHA_SCALE-   AlphaBias -> gl_ALPHA_BIAS-   DepthScale -> gl_DEPTH_SCALE-   DepthBias -> gl_DEPTH_BIAS-   PostConvolutionRedScale -> gl_POST_CONVOLUTION_RED_SCALE-   PostConvolutionGreenScale -> gl_POST_CONVOLUTION_GREEN_SCALE-   PostConvolutionBlueScale -> gl_POST_CONVOLUTION_BLUE_SCALE-   PostConvolutionAlphaScale -> gl_POST_CONVOLUTION_ALPHA_SCALE-   PostConvolutionRedBias -> gl_POST_CONVOLUTION_RED_BIAS-   PostConvolutionGreenBias -> gl_POST_CONVOLUTION_GREEN_BIAS-   PostConvolutionBlueBias -> gl_POST_CONVOLUTION_BLUE_BIAS-   PostConvolutionAlphaBias -> gl_POST_CONVOLUTION_ALPHA_BIAS-   PostColorMatrixRedScale -> gl_POST_COLOR_MATRIX_RED_SCALE-   PostColorMatrixGreenScale -> gl_POST_COLOR_MATRIX_GREEN_SCALE-   PostColorMatrixBlueScale -> gl_POST_COLOR_MATRIX_BLUE_SCALE-   PostColorMatrixAlphaScale -> gl_POST_COLOR_MATRIX_ALPHA_SCALE-   PostColorMatrixRedBias -> gl_POST_COLOR_MATRIX_RED_BIAS-   PostColorMatrixGreenBias -> gl_POST_COLOR_MATRIX_GREEN_BIAS-   PostColorMatrixBlueBias -> gl_POST_COLOR_MATRIX_BLUE_BIAS-   PostColorMatrixAlphaBias -> gl_POST_COLOR_MATRIX_ALPHA_BIAS------------------------------------------------------------------------------------data PixelTransferStage =-     PreConvolution-   | PostConvolution-   | PostColorMatrix-   deriving ( Eq, Ord, Show )--stageToGetScales ::-      PixelTransferStage-   -> (GetPName, GetPName, GetPName, GetPName)-stageToGetScales s = case s of-   PreConvolution  -> (GetRedScale,-                       GetGreenScale,-                       GetBlueScale,-                       GetAlphaScale)-   PostConvolution -> (GetPostConvolutionRedScale,-                       GetPostConvolutionGreenScale,-                       GetPostConvolutionBlueScale,-                       GetPostConvolutionAlphaScale)-   PostColorMatrix -> (GetPostColorMatrixRedScale,-                       GetPostColorMatrixGreenScale,-                       GetPostColorMatrixBlueScale,-                       GetPostColorMatrixAlphaScale)--stageToSetScales ::-      PixelTransferStage-   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)-stageToSetScales s = case s of-   PreConvolution  -> (RedScale,-                       GreenScale,-                       BlueScale,-                       AlphaScale)-   PostConvolution -> (PostConvolutionRedScale,-                       PostConvolutionGreenScale,-                       PostConvolutionBlueScale,-                       PostConvolutionAlphaScale)-   PostColorMatrix -> (PostColorMatrixRedScale,-                       PostColorMatrixGreenScale,-                       PostColorMatrixBlueScale,-                       PostColorMatrixAlphaScale)--stageToGetBiases ::-      PixelTransferStage-   -> (GetPName, GetPName, GetPName, GetPName)-stageToGetBiases s = case s of-   PreConvolution  -> (GetRedBias,-                       GetGreenBias,-                       GetBlueBias,-                       GetAlphaBias)-   PostConvolution -> (GetPostConvolutionRedBias,-                       GetPostConvolutionGreenBias,-                       GetPostConvolutionBlueBias,-                       GetPostConvolutionAlphaBias)-   PostColorMatrix -> (GetPostColorMatrixRedBias,-                       GetPostColorMatrixGreenBias,-                       GetPostColorMatrixBlueBias,-                       GetPostColorMatrixAlphaBias)--stageToSetBiases ::-      PixelTransferStage-   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)-stageToSetBiases s = case s of-   PreConvolution  -> (RedBias,-                       GreenBias,-                       BlueBias,-                       AlphaBias)-   PostConvolution -> (PostConvolutionRedBias,-                       PostConvolutionGreenBias,-                       PostConvolutionBlueBias,-                       PostConvolutionAlphaBias)-   PostColorMatrix -> (PostColorMatrixRedBias,-                       PostColorMatrixGreenBias,-                       PostColorMatrixBlueBias,-                       PostColorMatrixAlphaBias)------------------------------------------------------------------------------------mapColor :: StateVar Capability-mapColor = pixelTransferb GetMapColor MapColor--mapStencil :: StateVar Capability-mapStencil = pixelTransferb GetMapStencil MapStencil--indexShift :: StateVar GLint-indexShift = pixelTransferi GetIndexShift IndexShift--indexOffset :: StateVar GLint-indexOffset = pixelTransferi GetIndexOffset IndexOffset--depthScale :: StateVar GLfloat-depthScale = pixelTransferf GetDepthScale DepthScale--depthBias :: StateVar GLfloat-depthBias = pixelTransferf GetDepthBias DepthBias--rgbaScale :: PixelTransferStage -> StateVar (Color4 GLfloat)-rgbaScale s = pixelTransfer4f (stageToGetScales s) (stageToSetScales s)--rgbaBias :: PixelTransferStage -> StateVar (Color4 GLfloat)-rgbaBias s = pixelTransfer4f (stageToGetBiases s) (stageToSetBiases s)------------------------------------------------------------------------------------pixelTransferb :: GetPName -> PixelTransfer -> StateVar Capability-pixelTransferb pn pt =-   makeStateVar-      (getBoolean1 unmarshalCapability pn)-      (glPixelTransferi (marshalPixelTransfer pt) .-       fromIntegral . marshalCapability)--pixelTransferi :: GetPName -> PixelTransfer -> StateVar GLint-pixelTransferi pn pt =-   makeStateVar-      (getInteger1 id pn)-      (glPixelTransferi (marshalPixelTransfer pt))--pixelTransferf :: GetPName -> PixelTransfer -> StateVar GLfloat-pixelTransferf pn pt =-   makeStateVar-      (getFloat1 id pn)-      (glPixelTransferf (marshalPixelTransfer pt))--pixelTransfer4f ::-      (GetPName,      GetPName,      GetPName,      GetPName)-   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)-   -> StateVar (Color4 GLfloat)-pixelTransfer4f (pr, pg, pb, pa) (tr, tg, tb, ta) = makeStateVar get4f set4f-   where get4f = do-            r <- getFloat1 id pr-            g <- getFloat1 id pg-            b <- getFloat1 id pb-            a <- getFloat1 id pa-            return $ Color4 r g b a-         set4f (Color4 r g b a) = do-            glPixelTransferf (marshalPixelTransfer tr) r-            glPixelTransferf (marshalPixelTransfer tg) g-            glPixelTransferf (marshalPixelTransfer tb) b-            glPixelTransferf (marshalPixelTransfer ta) a
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs 
@@ -1,41 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to a part of section 3.6.4 (Rasterization of Pixel--- Rectangles) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization (-   PixelData(..), PixelFormat(..), drawPixels, pixelZoom-) where--import Control.Monad-import Data.StateVar-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.PixelData-import Graphics.Rendering.OpenGL.GL.PixelFormat-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glDrawPixels, glPixelZoom )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------drawPixels :: Size -> PixelData a -> IO ()-drawPixels (Size w h) pd = withPixelData pd $ glDrawPixels w h------------------------------------------------------------------------------------pixelZoom :: StateVar (GLfloat, GLfloat)-pixelZoom =-   makeStateVar-      (liftM2 (,) (getFloat1 id GetZoomX) (getFloat1 id GetZoomY))-      (uncurry glPixelZoom)
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs 
@@ -1,31 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling Reset.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset (-   Reset(..), marshalReset-) where--import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data Reset =-     NoReset-   | Reset-   deriving ( Eq, Ord, Show )--marshalReset :: Reset -> GLboolean-marshalReset x = marshalGLboolean (x == Reset)
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs 
@@ -1,34 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling Sink.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink (-   Sink(..), marshalSink, unmarshalSink-) where--import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data Sink =-     PassThrough-   | Sink-   deriving ( Eq, Ord, Show )--marshalSink :: Sink -> GLboolean-marshalSink x = marshalGLboolean (x == Sink)--unmarshalSink :: GLint -> Sink-unmarshalSink s = if unmarshalGLboolean s then Sink else PassThrough
− Graphics/Rendering/OpenGL/GL/PointParameter.hs 
@@ -1,46 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PointParameter--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for setting point parameters.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PointParameter (-   PointParameter(..), pointParameterf, pointParameterfv-) where--import Foreign.Ptr-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (- gl_POINT_DISTANCE_ATTENUATION, gl_POINT_SIZE_MAX, gl_POINT_SIZE_MIN )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data PointParameter =-     PointSizeMin-   | PointSizeMax-   | PointFadeThresholdSize-   | PointDistanceAttenuation--marshalPointParameter :: PointParameter -> GLenum-marshalPointParameter x = case x of-   PointSizeMin -> gl_POINT_SIZE_MIN-   PointSizeMax -> gl_POINT_SIZE_MAX-   PointFadeThresholdSize -> gl_POINT_FADE_THRESHOLD_SIZE-   PointDistanceAttenuation -> gl_POINT_DISTANCE_ATTENUATION------------------------------------------------------------------------------------pointParameterf :: PointParameter -> GLfloat -> IO ()-pointParameterf = glPointParameterf . marshalPointParameter--pointParameterfv :: PointParameter -> Ptr GLfloat -> IO ()-pointParameterfv = glPointParameterfv . marshalPointParameter
− Graphics/Rendering/OpenGL/GL/Points.hs 
@@ -1,217 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Points--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.3 (Points) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Points (-   -- * Point Rasterization-   pointSize, vertexProgramPointSize,--   -- * Controlling the Derived Size-   pointSizeRange, pointDistanceAttenuation,--   -- * Fading Points-   pointFadeThresholdSize,--   -- * Point Antialiasing-   pointSmooth,--   -- * Point Sprites-   pointSprite,--   -- * Implementation-Dependent Limits-   aliasedPointSizeRange, smoothPointSizeRange, smoothPointSizeGranularity-) where--import Control.Monad-import Data.StateVar-import Foreign.Marshal.Array-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.PointParameter-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | 'pointSize' contains the rasterized diameter of both aliased and--- antialiased points. The initial value is 1. Using a point size other than 1--- has different effects, depending on whether point antialiasing is enabled--- (see 'pointSmooth') or point sprites are enabled (see 'pointSprite'). Both--- are initially disabled.------ The specified point size is multiplied with a distance attenuation factor--- and clamped to the specified 'pointSizeRange', and further clamped to the--- implementation-dependent point size range to produce the derived point size--- using------ @   /derivedSize/ = /clamp/ (/size/ * /sqrt/ (1 \/ (/a/ + /b/ * /d/ + /c/ * /d/^2)))@------ where /d/ is the eye-coordinate distance from the eye to the vertex, and /a/,--- /b/, and /c/ are the distance attenuation coefficients (see--- 'pointDistanceAttenuation').------ If multisampling is disabled, the computed point size is used as the point\'s--- width.------ If multisampling is enabled, the point may be faded by modifying the point--- alpha value (see 'Graphics.Rendering.OpenGL.GL.PerFragment.sampleCoverage')--- instead of allowing the point width to go below a given--- 'pointFadeThresholdSize'. In this case, the width is further modified in--- the following manner:------ @   /width/ = if /derivedSize/ >= /threshold/ then /derivedSize/ else /threshold/@------ The point alpha value is modified by computing:------ @   /alpha/ = if /derivedSize/ >= /threshold/ then 1 else (/derivedSize/ \/ /threshold/)^2@------ If point antialiasing is disabled, the actual size is determined by rounding--- the supplied size to the nearest integer. (If the rounding results in the--- value 0, it is as if the point size were 1.) If the rounded size is odd,--- then the center point (/x/, /y/) of the pixel fragment that represents--- the point is computed as------ @   (/x/, /y/) = (/floor/ /xw/ + 0.5, /floor/ /yw/ + 0.5)@------ where /xw/ and /yw/ indicate window coordinates. All pixels that lie within--- the square grid of the rounded size centered at (/x/, /y/) make up the--- fragment. If the size is even, the center point is------ @   (/x/, /y/) = (/floor/ (/xw/ + 0.5), /floor/ (/yw/ + 0.5))@------ and the rasterized fragment\'s centers are the half-integer window--- coordinates within the square of the rounded size centered at (/x/, /y/). All--- pixel fragments produced in rasterizing a nonantialiased point are assigned--- the same associated data, that of the vertex corresponding to the point.------ If antialiasing is enabled, then point rasterization produces a fragment for--- each pixel square that intersects the region lying within the circle having--- diameter equal to the current point size and centered at the point\'s--- (/xw/, /yw/). The coverage value for each fragment is the window coordinate--- area of the intersection of the circular region with the corresponding pixel--- square. This value is saved and used in the final rasterization step. The--- data associated with each fragment is the data associated with the point--- being rasterized.------ Not all sizes are supported when point antialiasing is enabled. If an--- unsupported size is requested, the nearest supported size is used.  Only size--- 1 is guaranteed to be supported; others depend on the implementation. To--- query the range of supported sizes for antialiased points and the size--- difference between supported sizes within the range, query--- 'smoothPointSizeRange' and 'smoothPointSizeGranularity', respectively. For--- aliased points, query the supported range with 'aliasedPointSizeRange'.------ The point size specified when 'pointSize' is set is always returned when it--- is queried. Clamping and rounding for aliased and antialiased points have no--- effect on the specified value.------ A non-antialiased point size may be clamped to an implementation-dependent--- maximum. Although this maximum cannot be queried, it must be no less than the--- maximum value for antialiased points, rounded to the nearest integer value.------ An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if--- 'pointSize' is set to a value less than or equal to zero.------ An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if--- 'pointSize' is set during--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.--pointSize :: StateVar GLfloat-pointSize = makeStateVar (getFloat1 id GetPointSize) glPointSize------------------------------------------------------------------------------------vertexProgramPointSize :: StateVar Capability-vertexProgramPointSize = makeCapability CapVertexProgramPointSize-------------------------------------------------------------------------------------- | The range to which the derived point size is clamped, see 'pointSize'. Note--- that the size is further clamped to the implementation-dependent limits, see--- 'aliasedPointSizeRange' and 'smoothPointSizeRange'. The initial range is--- (0, 1).------ An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the--- lower or upper bound of the range is set to a value less than zero. If the--- lower bound is greater than the upper bound, the point size after clamping is--- undefined, but no error is generated.--pointSizeRange :: StateVar (GLfloat, GLfloat)-pointSizeRange =-   makeStateVar-   (liftM2 (,) (getFloat1 id GetPointSizeMin) (getFloat1 id GetPointSizeMax))-   (\(sizeMin, sizeMax) -> do pointParameterf PointSizeMin sizeMin-                              pointParameterf PointSizeMax sizeMax)-------------------------------------------------------------------------------------- | The  constant, linear, and quadratic distance attenuation coefficients, see--- 'pointSize'. The initial coefficients are (1, 0, 0).--pointDistanceAttenuation :: StateVar (GLfloat, GLfloat, GLfloat)-pointDistanceAttenuation =-   makeStateVar-      (getFloat3 (,,) GetPointDistanceAttenuation)-      (\(a, b, c) -> withArray [a, b, c] $-                        pointParameterfv PointDistanceAttenuation)-------------------------------------------------------------------------------------- | The threshold for alpha attenuation of points when multisampling is used,--- see 'pointSize'. The initial threshold is 1.------ An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the--- threshold is set to a value less than zero.--pointFadeThresholdSize :: StateVar GLfloat-pointFadeThresholdSize =-   makeStateVar-      (getFloat1 id GetPointFadeThresholdSize)-      (pointParameterf PointFadeThresholdSize)-------------------------------------------------------------------------------------- | Controls whether point antialiasing is enabled. The initial state is--- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.--pointSmooth :: StateVar Capability-pointSmooth = makeCapability CapPointSmooth-------------------------------------------------------------------------------------- | Controls whether point sprites are enabled. The initial state is--- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'. When point sprites are--- enabled, the state of point antialiasing (i.e. 'pointSmooth') is ignored.--pointSprite :: StateVar Capability-pointSprite = makeCapability CapPointSprite-------------------------------------------------------------------------------------- | The smallest and largest supported size of aliased points.--aliasedPointSizeRange :: GettableStateVar (GLfloat, GLfloat)-aliasedPointSizeRange =-   makeGettableStateVar $ getFloat2 (,) GetAliasedPointSizeRange---- | The smallest and largest supported size of antialiased points.--smoothPointSizeRange :: GettableStateVar (GLfloat, GLfloat)-smoothPointSizeRange =-   makeGettableStateVar $ getFloat2 (,) GetSmoothPointSizeRange---- | The antialiased point size granularity, i.e. the size difference between--- supported sizes.--smoothPointSizeGranularity :: GettableStateVar GLfloat-smoothPointSizeGranularity =-   makeGettableStateVar $ getFloat1 id GetSmoothPointSizeGranularity
− Graphics/Rendering/OpenGL/GL/PolygonMode.hs 
@@ -1,41 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PolygonMode--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling PolygonMode.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PolygonMode (-   PolygonMode(..), marshalPolygonMode, unmarshalPolygonMode-) where--import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data PolygonMode =-     Point-   | Line-   | Fill-   deriving ( Eq, Ord, Show )--marshalPolygonMode :: PolygonMode -> GLenum-marshalPolygonMode x = case x of-   Point -> gl_POINT-   Line -> gl_LINE-   Fill -> gl_FILL--unmarshalPolygonMode :: GLenum -> PolygonMode-unmarshalPolygonMode x-   | x == gl_POINT = Point-   | x == gl_LINE = Line-   | x == gl_FILL = Fill-   | otherwise = error ("unmarshalPolygonMode: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/Polygons.hs 
@@ -1,139 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Polygons--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.5 (Polygons) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Polygons (-   polygonSmooth, cullFace,-   PolygonStipple(..), GLpolygonstipple, polygonStipple,-   PolygonMode(..), polygonMode, polygonOffset,-   polygonOffsetPoint, polygonOffsetLine, polygonOffsetFill-) where--import Control.Monad-import Data.StateVar-import Foreign.ForeignPtr-import Foreign.Marshal.Array-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.Face-import Graphics.Rendering.OpenGL.GL.PixelRectangles-import Graphics.Rendering.OpenGL.GL.PolygonMode-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.SavingState-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glPolygonStipple, glGetPolygonStipple )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------polygonSmooth :: StateVar Capability-polygonSmooth = makeCapability CapPolygonSmooth------------------------------------------------------------------------------------cullFace :: StateVar (Maybe Face)-cullFace = makeStateVarMaybe (return CapCullFace)-                             (getEnum1 unmarshalFace GetCullFaceMode)-                             (glCullFace . marshalFace)------------------------------------------------------------------------------------numPolygonStippleBytes :: Int-numPolygonStippleBytes = 128   -- 32x32 bits divided into GLubytes--class PolygonStipple s where-   withNewPolygonStipple :: (Ptr GLubyte -> IO ()) -> IO s-   withPolygonStipple :: s -> (Ptr GLubyte -> IO a) -> IO a-   newPolygonStipple :: [GLubyte] -> IO s-   getPolygonStippleComponents :: s -> IO [GLubyte]--   withNewPolygonStipple act =-      allocaArray numPolygonStippleBytes $ \p -> do-         act p-         components <- peekArray numPolygonStippleBytes p-         newPolygonStipple components--   withPolygonStipple s act = do-      components <- getPolygonStippleComponents s-      withArray components act--   newPolygonStipple components =-      withNewPolygonStipple $-         flip pokeArray (take numPolygonStippleBytes components)--   getPolygonStippleComponents s =-      withPolygonStipple s $ peekArray numPolygonStippleBytes------------------------------------------------------------------------------------data GLpolygonstipple = GLpolygonstipple (ForeignPtr GLubyte)-   deriving ( Eq, Ord, Show )--instance PolygonStipple GLpolygonstipple where-   withNewPolygonStipple f = do-      fp <- mallocForeignPtrArray numPolygonStippleBytes-      withForeignPtr fp f-      return $ GLpolygonstipple fp--   withPolygonStipple (GLpolygonstipple fp) = withForeignPtr fp------------------------------------------------------------------------------------polygonStipple :: PolygonStipple s => StateVar (Maybe s)-polygonStipple =-   makeStateVarMaybe (return CapPolygonStipple)-      (withoutGaps Pack $ withNewPolygonStipple glGetPolygonStipple)-      (\s -> withoutGaps Unpack $ withPolygonStipple s glPolygonStipple)---- Note: No need to set rowAlignment, our memory allocator always returns a--- region which is at least 8-byte aligned (the maximum)-withoutGaps :: PixelStoreDirection -> IO a -> IO a-withoutGaps direction action =-   preservingClientAttrib [ PixelStoreAttributes ] $ do-      rowLength  direction $= 0-      skipRows   direction $= 0-      skipPixels direction $= 0-      action------------------------------------------------------------------------------------polygonMode :: StateVar (PolygonMode, PolygonMode)-polygonMode = makeStateVar getPolygonMode setPolygonMode--getPolygonMode :: IO (PolygonMode, PolygonMode)-getPolygonMode = getInteger2 (\front back -> (un front, un back)) GetPolygonMode-   where un = unmarshalPolygonMode . fromIntegral--setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()-setPolygonMode (front, back) = do-   glPolygonMode (marshalFace Front) (marshalPolygonMode front)-   glPolygonMode (marshalFace Back ) (marshalPolygonMode back )------------------------------------------------------------------------------------polygonOffset :: StateVar (GLfloat, GLfloat)-polygonOffset =-   makeStateVar (liftM2 (,) (getFloat1 id GetPolygonOffsetFactor)-                            (getFloat1 id GetPolygonOffsetUnits))-                (uncurry glPolygonOffset)------------------------------------------------------------------------------------polygonOffsetPoint :: StateVar Capability-polygonOffsetPoint = makeCapability CapPolygonOffsetPoint--polygonOffsetLine :: StateVar Capability-polygonOffsetLine = makeCapability CapPolygonOffsetLine--polygonOffsetFill :: StateVar Capability-polygonOffsetFill = makeCapability CapPolygonOffsetFill
− Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs 
@@ -1,98 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.PrimitiveMode--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling PrimitiveMode.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.PrimitiveMode (-   PrimitiveMode(..), marshalPrimitiveMode, unmarshalPrimitiveMode-) where--import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_QUADS, gl_QUAD_STRIP, gl_POLYGON )-------------------------------------------------------------------------------------- | Specification of the way the vertices given during 'renderPrimitive' are--- interpreted. In the description of the constructors, /n/ is an integer count--- starting at one, and /N/ is the total number of vertices specified.--data PrimitiveMode =-     Points-     -- ^ Treats each vertex as a single point. Vertex /n/ defines point /n/.-     -- /N/ points are drawn.-   | Lines-     -- ^ Treats each pair of vertices as an independent line segment. Vertices-     -- 2/n/-1 and 2/n/ define line /n/. /N/\/2 lines are drawn.-   | LineLoop-     -- ^ Draws a connected group of line segments from the first vertex to the-     -- last, then back to the first. Vertices /n/ and /n/+1 define line /n/.-     -- The last line, however, is defined by vertices /N/ and 1. /N/ lines-     -- are drawn.-   | LineStrip-     -- ^ Draws a connected group of line  segments from the first vertex to the-     -- last. Vertices /n/ and /n/+1 define line /n/. /N/-1 lines are drawn.-   | Triangles-     -- ^ Treats each triplet of vertices as an independent triangle. Vertices-     -- /3n-2/, /3n-1/, and /3n/ define triangle /n/. /N\/3/ triangles are drawn.-   | TriangleStrip-     -- ^ Draws a connected group of triangles. One triangle is defined for each-     -- vertex presented after the first two vertices. For odd /n/, vertices-     -- /n/, /n/+1, and /n/+2 define triangle /n/. For even /n/, vertices /n/+1,-     -- /n/, and /n/+2 define triangle /n/. /N/-2 triangles are drawn.-   | TriangleFan-     -- ^ Draws a connected group of triangles. One triangle is defined for each-     -- vertex presented after the first two vertices. Vertices 1, /n/+1, and-     -- /n/+2 define triangle /n/. /N/-2 triangles are drawn.-   | Quads-     -- ^ Treats each group of four vertices as an independent quadrilateral.-     -- Vertices 4/n/-3, 4/n/-2, 4/n/-1, and 4/n/ define quadrilateral /n/.-     -- /N/\/4 quadrilaterals are drawn.-   | QuadStrip-     -- ^ Draws a connected group of quadrilaterals. One quadrilateral is-     --defined for each pair of vertices presented after the first pair.-     -- Vertices 2/n/-1, 2/n/, 2/n/+2, and 2/n/+1 define quadrilateral /n/.-     -- /N/\/2-1 quadrilaterals are drawn. Note that the order in which vertices-     -- are used to construct a quadrilateral from strip data is different from-     -- that used with independent data.-   | Polygon-     -- ^ Draws a single, convex polygon. Vertices 1 through /N/ define this-     -- polygon.-   deriving ( Eq, Ord, Show )--marshalPrimitiveMode :: PrimitiveMode -> GLenum-marshalPrimitiveMode x = case x of-   Points -> gl_POINTS-   Lines -> gl_LINES-   LineLoop -> gl_LINE_LOOP-   LineStrip -> gl_LINE_STRIP-   Triangles -> gl_TRIANGLES-   TriangleStrip -> gl_TRIANGLE_STRIP-   TriangleFan -> gl_TRIANGLE_FAN-   Quads -> gl_QUADS-   QuadStrip -> gl_QUAD_STRIP-   Polygon -> gl_POLYGON--unmarshalPrimitiveMode :: GLenum -> PrimitiveMode-unmarshalPrimitiveMode x-   | x == gl_POINTS = Points-   | x == gl_LINES = Lines-   | x == gl_LINE_LOOP = LineLoop-   | x == gl_LINE_STRIP = LineStrip-   | x == gl_TRIANGLES = Triangles-   | x == gl_TRIANGLE_STRIP = TriangleStrip-   | x == gl_TRIANGLE_FAN = TriangleFan-   | x == gl_QUADS = Quads-   | x == gl_QUAD_STRIP = QuadStrip-   | x == gl_POLYGON = Polygon-   | otherwise = error ("unmarshalPrimitiveMode: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/QueryUtils.hs 
@@ -1,1178 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module with utilities to query OpenGL state.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(..),-   clipPlaneIndexToEnum, lightIndexToEnum,-   modelviewIndexToEnum, modelviewEnumToIndex,-   getBoolean1, getBoolean4,-   getInteger1, getInteger2, getInteger4, getIntegerv,-   getEnum1,-   getSizei1, getSizei2,-   getFloat1, getFloat2, getFloat3, getFloat4, getFloatv,-   getClampf1, getClampf4,-   getDouble1, getDouble2, getDouble4, getDoublev,-   getClampd1, getClampd2,-   maybeNullPtr,-   AttribLocation(..), GetVertexAttribPName(..),-   getVertexAttribInteger1, getVertexAttribEnum1, getVertexAttribBoolean1,-   getVertexAttribFloat4, getVertexAttribIInteger4, getVertexAttribIuInteger4, -   GetVertexAttribPointerPName(..), getVertexAttribPointer-) where--import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_ACCUM_ALPHA_BITS, gl_ACCUM_BLUE_BITS, gl_ACCUM_CLEAR_VALUE,-   gl_ACCUM_GREEN_BITS, gl_ACCUM_RED_BITS, gl_ALIASED_POINT_SIZE_RANGE,-   gl_ALPHA_BIAS, gl_ALPHA_BITS, gl_ALPHA_SCALE, gl_ALPHA_TEST,-   gl_ALPHA_TEST_FUNC, gl_ALPHA_TEST_REF, gl_ATTRIB_STACK_DEPTH, gl_AUTO_NORMAL,-   gl_AUX_BUFFERS, gl_BLUE_BIAS, gl_BLUE_BITS, gl_BLUE_SCALE,-   gl_CLIENT_ACTIVE_TEXTURE, gl_CLIENT_ATTRIB_STACK_DEPTH, gl_COLOR_ARRAY,-   gl_COLOR_ARRAY_BUFFER_BINDING, gl_COLOR_ARRAY_SIZE, gl_COLOR_ARRAY_STRIDE,-   gl_COLOR_ARRAY_TYPE, gl_COLOR_MATERIAL, gl_COLOR_MATERIAL_FACE,-   gl_COLOR_MATERIAL_PARAMETER, gl_COLOR_MATRIX, gl_COLOR_MATRIX_STACK_DEPTH,-   gl_COLOR_SUM, gl_COLOR_TABLE, gl_CONVOLUTION_1D, gl_CONVOLUTION_2D,-   gl_CURRENT_COLOR, gl_CURRENT_FOG_COORD, gl_CURRENT_INDEX, gl_CURRENT_NORMAL,-   gl_CURRENT_RASTER_COLOR, gl_CURRENT_RASTER_DISTANCE, gl_CURRENT_RASTER_INDEX,-   gl_CURRENT_RASTER_POSITION, gl_CURRENT_RASTER_POSITION_VALID,-   gl_CURRENT_RASTER_SECONDARY_COLOR, gl_CURRENT_RASTER_TEXTURE_COORDS,-   gl_CURRENT_SECONDARY_COLOR, gl_CURRENT_TEXTURE_COORDS, gl_DEPTH_BIAS,-   gl_DEPTH_BITS, gl_DEPTH_SCALE, gl_EDGE_FLAG, gl_EDGE_FLAG_ARRAY,-   gl_EDGE_FLAG_ARRAY_BUFFER_BINDING, gl_EDGE_FLAG_ARRAY_STRIDE,-   gl_FEEDBACK_BUFFER_SIZE, gl_FEEDBACK_BUFFER_TYPE, gl_FOG, gl_FOG_COLOR,-   gl_FOG_COORD_ARRAY, gl_FOG_COORD_ARRAY_BUFFER_BINDING,-   gl_FOG_COORD_ARRAY_STRIDE, gl_FOG_COORD_ARRAY_TYPE, gl_FOG_COORD_SRC,-   gl_FOG_DENSITY, gl_FOG_END, gl_FOG_HINT, gl_FOG_INDEX, gl_FOG_MODE,-   gl_FOG_START, gl_GENERATE_MIPMAP_HINT, gl_GREEN_BIAS, gl_GREEN_BITS,-   gl_GREEN_SCALE, gl_HISTOGRAM, gl_INDEX_ARRAY, gl_INDEX_ARRAY_BUFFER_BINDING,-   gl_INDEX_ARRAY_STRIDE, gl_INDEX_ARRAY_TYPE, gl_INDEX_BITS,-   gl_INDEX_CLEAR_VALUE, gl_INDEX_LOGIC_OP, gl_INDEX_MODE, gl_INDEX_OFFSET,-   gl_INDEX_SHIFT, gl_INDEX_WRITEMASK, gl_LIGHT0, gl_LIGHTING,-   gl_LIGHT_MODEL_AMBIENT, gl_LIGHT_MODEL_COLOR_CONTROL,-   gl_LIGHT_MODEL_LOCAL_VIEWER, gl_LIGHT_MODEL_TWO_SIDE, gl_LINE_STIPPLE,-   gl_LINE_STIPPLE_PATTERN, gl_LINE_STIPPLE_REPEAT, gl_LIST_BASE, gl_LIST_INDEX,-   gl_LIST_MODE, gl_MAP1_COLOR_4, gl_MAP1_GRID_DOMAIN, gl_MAP1_GRID_SEGMENTS,-   gl_MAP1_INDEX, gl_MAP1_NORMAL, gl_MAP1_TEXTURE_COORD_1,-   gl_MAP1_TEXTURE_COORD_2, gl_MAP1_TEXTURE_COORD_3, gl_MAP1_TEXTURE_COORD_4,-   gl_MAP1_VERTEX_3, gl_MAP1_VERTEX_4, gl_MAP2_COLOR_4, gl_MAP2_GRID_DOMAIN,-   gl_MAP2_GRID_SEGMENTS, gl_MAP2_INDEX, gl_MAP2_NORMAL,-   gl_MAP2_TEXTURE_COORD_1, gl_MAP2_TEXTURE_COORD_2, gl_MAP2_TEXTURE_COORD_3,-   gl_MAP2_TEXTURE_COORD_4, gl_MAP2_VERTEX_3, gl_MAP2_VERTEX_4, gl_MAP_COLOR,-   gl_MAP_STENCIL, gl_MATRIX_MODE, gl_MAX_ATTRIB_STACK_DEPTH,-   gl_MAX_CLIENT_ATTRIB_STACK_DEPTH, gl_MAX_COLOR_MATRIX_STACK_DEPTH,-   gl_MAX_CONVOLUTION_HEIGHT, gl_MAX_CONVOLUTION_WIDTH, gl_MAX_EVAL_ORDER,-   gl_MAX_LIGHTS, gl_MAX_LIST_NESTING, gl_MAX_MODELVIEW_STACK_DEPTH,-   gl_MAX_NAME_STACK_DEPTH, gl_MAX_PIXEL_MAP_TABLE,-   gl_MAX_PROJECTION_STACK_DEPTH, gl_MAX_TEXTURE_COORDS,-   gl_MAX_TEXTURE_STACK_DEPTH, gl_MAX_TEXTURE_UNITS, gl_MINMAX, gl_MODELVIEW,-   gl_MODELVIEW_MATRIX, gl_MODELVIEW_STACK_DEPTH, gl_NAME_STACK_DEPTH,-   gl_NORMALIZE, gl_NORMAL_ARRAY, gl_NORMAL_ARRAY_BUFFER_BINDING,-   gl_NORMAL_ARRAY_STRIDE, gl_NORMAL_ARRAY_TYPE, gl_PERSPECTIVE_CORRECTION_HINT,-   gl_PIXEL_MAP_A_TO_A_SIZE, gl_PIXEL_MAP_B_TO_B_SIZE, gl_PIXEL_MAP_G_TO_G_SIZE,-   gl_PIXEL_MAP_I_TO_A_SIZE, gl_PIXEL_MAP_I_TO_B_SIZE, gl_PIXEL_MAP_I_TO_G_SIZE,-   gl_PIXEL_MAP_I_TO_I_SIZE, gl_PIXEL_MAP_I_TO_R_SIZE, gl_PIXEL_MAP_R_TO_R_SIZE,-   gl_PIXEL_MAP_S_TO_S_SIZE, gl_POINT_DISTANCE_ATTENUATION, gl_POINT_SIZE_MAX,-   gl_POINT_SIZE_MIN, gl_POINT_SMOOTH, gl_POINT_SMOOTH_HINT, gl_POLYGON_MODE,-   gl_POLYGON_STIPPLE, gl_POST_COLOR_MATRIX_ALPHA_BIAS,-   gl_POST_COLOR_MATRIX_ALPHA_SCALE, gl_POST_COLOR_MATRIX_BLUE_BIAS,-   gl_POST_COLOR_MATRIX_BLUE_SCALE, gl_POST_COLOR_MATRIX_COLOR_TABLE,-   gl_POST_COLOR_MATRIX_GREEN_BIAS, gl_POST_COLOR_MATRIX_GREEN_SCALE,-   gl_POST_COLOR_MATRIX_RED_BIAS, gl_POST_COLOR_MATRIX_RED_SCALE,-   gl_POST_CONVOLUTION_ALPHA_BIAS, gl_POST_CONVOLUTION_ALPHA_SCALE,-   gl_POST_CONVOLUTION_BLUE_BIAS, gl_POST_CONVOLUTION_BLUE_SCALE,-   gl_POST_CONVOLUTION_COLOR_TABLE, gl_POST_CONVOLUTION_GREEN_BIAS,-   gl_POST_CONVOLUTION_GREEN_SCALE, gl_POST_CONVOLUTION_RED_BIAS,-   gl_POST_CONVOLUTION_RED_SCALE, gl_PROJECTION_MATRIX,-   gl_PROJECTION_STACK_DEPTH, gl_RED_BIAS, gl_RED_BITS, gl_RED_SCALE,-   gl_RENDER_MODE, gl_RESCALE_NORMAL, gl_RGBA_MODE, gl_SECONDARY_COLOR_ARRAY,-   gl_SECONDARY_COLOR_ARRAY_BUFFER_BINDING, gl_SECONDARY_COLOR_ARRAY_SIZE,-   gl_SECONDARY_COLOR_ARRAY_STRIDE, gl_SECONDARY_COLOR_ARRAY_TYPE,-   gl_SELECTION_BUFFER_SIZE, gl_SEPARABLE_2D, gl_SHADE_MODEL, gl_STENCIL_BITS,-   gl_TEXTURE_COORD_ARRAY, gl_TEXTURE_COORD_ARRAY_BUFFER_BINDING,-   gl_TEXTURE_COORD_ARRAY_SIZE, gl_TEXTURE_COORD_ARRAY_STRIDE,-   gl_TEXTURE_COORD_ARRAY_TYPE, gl_TEXTURE_GEN_Q, gl_TEXTURE_GEN_R,-   gl_TEXTURE_GEN_S, gl_TEXTURE_GEN_T, gl_TEXTURE_MATRIX,-   gl_TEXTURE_STACK_DEPTH, gl_TRANSPOSE_COLOR_MATRIX,-   gl_TRANSPOSE_MODELVIEW_MATRIX, gl_TRANSPOSE_PROJECTION_MATRIX,-   gl_TRANSPOSE_TEXTURE_MATRIX, gl_VERTEX_ARRAY, gl_VERTEX_ARRAY_BUFFER_BINDING,-   gl_VERTEX_ARRAY_SIZE, gl_VERTEX_ARRAY_STRIDE, gl_VERTEX_ARRAY_TYPE,-   gl_ZOOM_X, gl_ZOOM_Y )-import Graphics.Rendering.OpenGL.Raw.ARB.FragmentProgram (-   gl_CURRENT_MATRIX, gl_CURRENT_MATRIX_STACK_DEPTH )-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette (-   gl_CURRENT_MATRIX_INDEX, gl_CURRENT_PALETTE_MATRIX, gl_MATRIX_INDEX_ARRAY,-   gl_MATRIX_INDEX_ARRAY_SIZE, gl_MATRIX_INDEX_ARRAY_STRIDE,-   gl_MATRIX_INDEX_ARRAY_TYPE, gl_MATRIX_PALETTE,-   gl_MAX_MATRIX_PALETTE_STACK_DEPTH, gl_MAX_PALETTE_MATRICES )-import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend (-   gl_ACTIVE_VERTEX_UNITS, gl_CURRENT_WEIGHT, gl_MAX_VERTEX_UNITS,-   gl_MODELVIEW1, gl_MODELVIEW2, gl_MODELVIEW31, gl_VERTEX_BLEND,-   gl_WEIGHT_ARRAY, gl_WEIGHT_ARRAY_SIZE, gl_WEIGHT_ARRAY_STRIDE,-   gl_WEIGHT_ARRAY_TYPE, gl_WEIGHT_SUM_UNITY )-import Graphics.Rendering.OpenGL.Raw.Core32-import Graphics.Rendering.OpenGL.Raw.EXT ( gl_RGBA_SIGNED_COMPONENTS )-import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka ( gl_PACK_CMYK_HINT, gl_UNPACK_CMYK_HINT )-import Graphics.Rendering.OpenGL.Raw.EXT.CompiledVertexArray ( gl_ARRAY_ELEMENT_LOCK_FIRST, gl_ARRAY_ELEMENT_LOCK_COUNT )-import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( gl_DEPTH_BOUNDS, )-import Graphics.Rendering.OpenGL.Raw.EXT.SharedTexturePalette ( gl_SHARED_TEXTURE_PALETTE )-import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( gl_ACTIVE_STENCIL_FACE )-import Graphics.Rendering.OpenGL.Raw.EXT.TextureFilterAnisotropic ( gl_MAX_TEXTURE_MAX_ANISOTROPY )-import Graphics.Rendering.OpenGL.Raw.NV.FogDistance ( gl_FOG_DISTANCE_MODE )-import Graphics.Rendering.OpenGL.Raw.NV.LightMaxExponent (  gl_MAX_SHININESS, gl_MAX_SPOT_EXPONENT )-import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart ( gl_PRIMITIVE_RESTART_INDEX_NV, gl_PRIMITIVE_RESTART_NV )------------------------------------------------------------------------------------data GetPName =-     GetCurrentColor-   | GetCurrentIndex-   | GetCurrentNormal-   | GetCurrentTextureCoords-   | GetCurrentRasterColor-   | GetCurrentRasterSecondaryColor-   | GetCurrentRasterIndex-   | GetCurrentRasterTextureCoords-   | GetCurrentRasterPosition-   | GetCurrentRasterPositionValid-   | GetCurrentRasterDistance-   | GetCurrentMatrixIndex-   | GetPointSmooth-   | GetPointSize-   | GetPointSizeRange-   | GetPointSizeGranularity-   | GetLineSmooth-   | GetLineWidth-   | GetLineWidthRange-   | GetLineWidthGranularity-   | GetLineStipple-   | GetLineStipplePattern-   | GetLineStippleRepeat-   | GetSmoothPointSizeRange-   | GetSmoothPointSizeGranularity-   | GetSmoothLineWidthRange-   | GetSmoothLineWidthGranularity-   | GetAliasedPointSizeRange-   | GetAliasedLineWidthRange-   | GetListMode-   | GetMaxListNesting-   | GetListBase-   | GetListIndex-   | GetPolygonMode-   | GetPolygonSmooth-   | GetPolygonStipple-   | GetEdgeFlag-   | GetCullFace-   | GetCullFaceMode-   | GetFrontFace-   | GetLighting-   | GetLightModelLocalViewer-   | GetLightModelTwoSide-   | GetLightModelAmbient-   | GetShadeModel-   | GetColorMaterialFace-   | GetColorMaterialParameter-   | GetColorMaterial-   | GetFog-   | GetFogIndex-   | GetFogDensity-   | GetFogStart-   | GetFogEnd-   | GetFogMode-   | GetFogColor-   | GetFogCoordSrc-   | GetCurrentFogCoord-   | GetDepthRange-   | GetDepthTest-   | GetDepthWritemask-   | GetDepthClearValue-   | GetDepthFunc-   | GetAccumClearValue-   | GetStencilTest-   | GetStencilClearValue-   | GetStencilFunc-   | GetStencilValueMask-   | GetStencilFail-   | GetStencilPassDepthFail-   | GetStencilPassDepthPass-   | GetStencilRef-   | GetStencilWritemask-   | GetMatrixMode-   | GetNormalize-   | GetViewport-   | GetModelviewStackDepth-   | GetProjectionStackDepth-   | GetTextureStackDepth-   | GetModelviewMatrix-   | GetProjectionMatrix-   | GetTextureMatrix-   | GetAttribStackDepth-   | GetClientAttribStackDepth-   | GetAlphaTest-   | GetAlphaTestFunc-   | GetAlphaTestRef-   | GetDither-   | GetBlendDst-   | GetBlendSrc-   | GetBlend-   | GetLogicOpMode-   | GetIndexLogicOp-   | GetLogicOp-   | GetColorLogicOp-   | GetAuxBuffers-   | GetDrawBuffer-   | GetReadBuffer-   | GetScissorBox-   | GetScissorTest-   | GetIndexClearValue-   | GetIndexWritemask-   | GetColorClearValue-   | GetColorWritemask-   | GetIndexMode-   | GetRGBAMode-   | GetDoublebuffer-   | GetStereo-   | GetRenderMode-   | GetPerspectiveCorrectionHint-   | GetPointSmoothHint-   | GetLineSmoothHint-   | GetPolygonSmoothHint-   | GetFogHint-   | GetGenerateMipmapHint-   | GetTextureCompressionHint-   | GetTextureGenS-   | GetTextureGenT-   | GetTextureGenR-   | GetTextureGenQ-   | GetPixelMapIToISize-   | GetPixelMapSToSSize-   | GetPixelMapIToRSize-   | GetPixelMapIToGSize-   | GetPixelMapIToBSize-   | GetPixelMapIToASize-   | GetPixelMapRToRSize-   | GetPixelMapGToGSize-   | GetPixelMapBToBSize-   | GetPixelMapAToASize-   | GetUnpackSwapBytes-   | GetUnpackLSBFirst-   | GetUnpackRowLength-   | GetUnpackSkipRows-   | GetUnpackSkipPixels-   | GetUnpackAlignment-   | GetPackSwapBytes-   | GetPackLSBFirst-   | GetPackRowLength-   | GetPackSkipRows-   | GetPackSkipPixels-   | GetPackAlignment-   | GetMapColor-   | GetMapStencil-   | GetIndexShift-   | GetIndexOffset-   | GetRedScale-   | GetRedBias-   | GetZoomX-   | GetZoomY-   | GetGreenScale-   | GetGreenBias-   | GetBlueScale-   | GetBlueBias-   | GetAlphaScale-   | GetAlphaBias-   | GetDepthScale-   | GetDepthBias-   | GetMaxEvalOrder-   | GetMaxLights-   | GetMaxClipPlanes-   | GetMaxTextureSize-   | GetMaxPixelMapTable-   | GetMaxAttribStackDepth-   | GetMaxModelviewStackDepth-   | GetMaxNameStackDepth-   | GetMaxProjectionStackDepth-   | GetMaxTextureStackDepth-   | GetMaxViewportDims-   | GetMaxClientAttribStackDepth-   | GetSubpixelBits-   | GetIndexBits-   | GetRedBits-   | GetGreenBits-   | GetBlueBits-   | GetAlphaBits-   | GetDepthBits-   | GetStencilBits-   | GetAccumRedBits-   | GetAccumGreenBits-   | GetAccumBlueBits-   | GetAccumAlphaBits-   | GetNameStackDepth-   | GetAutoNormal-   | GetMap1Color4-   | GetMap1Index-   | GetMap1Normal-   | GetMap1TextureCoord1-   | GetMap1TextureCoord2-   | GetMap1TextureCoord3-   | GetMap1TextureCoord4-   | GetMap1Vertex3-   | GetMap1Vertex4-   | GetMap2Color4-   | GetMap2Index-   | GetMap2Normal-   | GetMap2TextureCoord1-   | GetMap2TextureCoord2-   | GetMap2TextureCoord3-   | GetMap2TextureCoord4-   | GetMap2Vertex3-   | GetMap2Vertex4-   | GetMap1GridDomain-   | GetMap1GridSegments-   | GetMap2GridDomain-   | GetMap2GridSegments-   | GetTexture1D-   | GetTexture2D-   | GetFeedbackBufferSize-   | GetFeedbackBufferType-   | GetSelectionBufferSize-   | GetPolygonOffsetUnits-   | GetPolygonOffsetPoint-   | GetPolygonOffsetLine-   | GetPolygonOffsetFill-   | GetPolygonOffsetFactor-   | GetTextureBinding1D-   | GetTextureBinding2D-   | GetTextureBinding3D-   | GetVertexArray-   | GetNormalArray-   | GetColorArray-   | GetIndexArray-   | GetTextureCoordArray-   | GetEdgeFlagArray-   | GetFogCoordArray-   | GetSecondaryColorArray-   | GetMatrixIndexArray-   | GetVertexArraySize-   | GetVertexArrayType-   | GetVertexArrayStride-   | GetNormalArrayType-   | GetNormalArrayStride-   | GetColorArraySize-   | GetColorArrayType-   | GetColorArrayStride-   | GetIndexArrayType-   | GetIndexArrayStride-   | GetTextureCoordArraySize-   | GetTextureCoordArrayType-   | GetTextureCoordArrayStride-   | GetEdgeFlagArrayStride-   | GetFogCoordArrayType-   | GetFogCoordArrayStride-   | GetSecondaryColorArraySize-   | GetSecondaryColorArrayType-   | GetSecondaryColorArrayStride-   | GetMatrixIndexArraySize-   | GetMatrixIndexArrayType-   | GetMatrixIndexArrayStride-   | GetClipPlane GLsizei-   | GetLight GLsizei-   | GetTransposeModelviewMatrix-   | GetTransposeProjectionMatrix-   | GetTransposeTextureMatrix-   | GetTransposeColorMatrix-   | GetLightModelColorControl-   | GetBlendColor-   | GetBlendEquation-   | GetBlendEquationAlpha-   | GetColorTable-   | GetPostConvolutionColorTable-   | GetPostColorMatrixColorTable-   | GetConvolution1D-   | GetConvolution2D-   | GetSeparable2D-   | GetMaxConvolutionWidth-   | GetMaxConvolutionHeight-   | GetPostConvolutionRedScale-   | GetPostConvolutionGreenScale-   | GetPostConvolutionBlueScale-   | GetPostConvolutionAlphaScale-   | GetPostConvolutionRedBias-   | GetPostConvolutionGreenBias-   | GetPostConvolutionBlueBias-   | GetPostConvolutionAlphaBias-   | GetHistogram-   | GetMinmax-   | GetColorSum-   | GetCurrentSecondaryColor-   | GetRescaleNormal-   | GetSharedTexturePalette-   | GetTexture3DBinding-   | GetPackSkipImages-   | GetPackImageHeight-   | GetUnpackSkipImages-   | GetUnpackImageHeight-   | GetTexture3D-   | GetMax3DTextureSize-   | GetMaxTextureLODBias-   | GetMaxTextureMaxAnisotropy-   | GetMultisample-   | GetSampleAlphaToCoverage-   | GetSampleAlphaToOne-   | GetSampleCoverage-   | GetSampleBuffers-   | GetSamples-   | GetSampleCoverageValue-   | GetSampleCoverageInvert-   | GetPointSizeMin-   | GetPointSizeMax-   | GetPointFadeThresholdSize-   | GetPointDistanceAttenuation-   | GetColorMatrix-   | GetColorMatrixStackDepth-   | GetMaxColorMatrixStackDepth-   | GetPostColorMatrixRedScale-   | GetPostColorMatrixGreenScale-   | GetPostColorMatrixBlueScale-   | GetPostColorMatrixAlphaScale-   | GetPostColorMatrixRedBias-   | GetPostColorMatrixGreenBias-   | GetPostColorMatrixBlueBias-   | GetPostColorMatrixAlphaBias-   | GetMaxElementsVertices-   | GetMaxElementsIndices-   | GetActiveTexture-   | GetClientActiveTexture-   | GetMaxTextureUnits-   | GetTextureCubeMap-   | GetMaxCubeMapTextureSize-   | GetMaxRectangleTextureSize-   | GetNumCompressedTextureFormats-   | GetCompressedTextureFormats-   | GetMaxVertexUnits-   | GetActiveVertexUnits-   | GetWeightSumUnity-   | GetVertexBlend-   | GetModelview GLsizei-   | GetCurrentWeight-   | GetWeightArrayType-   | GetWeightArrayStride-   | GetWeightArraySize-   | GetWeightArray-   | GetMatrixPalette-   | GetMaxMatrixPaletteStackDepth-   | GetMaxPaletteMatrices-   | GetCurrentPaletteMatrix-   | GetBlendDstRGB-   | GetBlendSrcRGB-   | GetBlendDstAlpha-   | GetBlendSrcAlpha-   | GetPackCMYKHint-   | GetUnpackCMYKHint-   | GetArrayElementLockFirst-   | GetArrayElementLockCount-   | GetMaxShininess-   | GetMaxSpotExponent-   | GetFogDistanceMode-   | GetDepthBounds-   | GetPrimitiveRestartIndex-   | GetPrimitiveRestartNV-   | GetPrimitiveRestartIndexNV-   | GetActiveStencilFace-   | GetArrayBufferBinding-   | GetElementArrayBufferBinding-   | GetVertexArrayBufferBinding-   | GetNormalArrayBufferBinding-   | GetColorArrayBufferBinding-   | GetIndexArrayBufferBinding-   | GetTextureCoordArrayBufferBinding-   | GetEdgeFlagArrayBufferBinding-   | GetSecondaryColorArrayBufferBinding-   | GetFogCoordArrayBufferBinding-   | GetTextureBindingCubeMap-   | GetTextureBindingRectangle-   | GetCurrentMatrix-   | GetCurrentMatrixStackDepth-   | GetMaxCombinedTextureImageUnits-   | GetMaxDrawBuffers-   | GetMaxFragmentUniformComponents-   | GetMaxTextureCoords-   | GetMaxTextureImageUnits-   | GetMaxVaryingFloats-   | GetMaxVertexAttribs-   | GetMaxVertexTextureImageUnits-   | GetMaxVertexUniformComponents-   | GetCurrentProgram-   | GetPixelPackBufferBinding-   | GetPixelUnpackBufferBinding-   | GetDrawBufferN GLsizei-   | GetRGBASignedComponents-   | GetCopyReadBuffer-   | GetCopyWriteBuffer-   -- GetWeightArrayBufferBinding-   | GetContextProfileMask--marshalGetPName :: GetPName -> Maybe GLenum-marshalGetPName x = case x of-   GetCurrentColor -> Just gl_CURRENT_COLOR-   GetCurrentIndex -> Just gl_CURRENT_INDEX-   GetCurrentNormal -> Just gl_CURRENT_NORMAL-   GetCurrentTextureCoords -> Just gl_CURRENT_TEXTURE_COORDS-   GetCurrentRasterColor -> Just gl_CURRENT_RASTER_COLOR-   GetCurrentRasterSecondaryColor -> Just gl_CURRENT_RASTER_SECONDARY_COLOR-   GetCurrentRasterIndex -> Just gl_CURRENT_RASTER_INDEX-   GetCurrentRasterTextureCoords -> Just gl_CURRENT_RASTER_TEXTURE_COORDS-   GetCurrentRasterPosition -> Just gl_CURRENT_RASTER_POSITION-   GetCurrentRasterPositionValid -> Just gl_CURRENT_RASTER_POSITION_VALID-   GetCurrentRasterDistance -> Just gl_CURRENT_RASTER_DISTANCE-   GetCurrentMatrixIndex -> Just gl_CURRENT_MATRIX_INDEX-   GetPointSmooth -> Just gl_POINT_SMOOTH-   GetPointSize -> Just gl_POINT_SIZE-   GetPointSizeRange -> Just gl_POINT_SIZE_RANGE-   GetPointSizeGranularity -> Just gl_POINT_SIZE_GRANULARITY-   GetLineSmooth -> Just gl_LINE_SMOOTH-   GetLineWidth -> Just gl_LINE_WIDTH-   GetLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE-   GetLineWidthGranularity -> Just gl_SMOOTH_LINE_WIDTH_GRANULARITY-   GetLineStipple -> Just gl_LINE_STIPPLE-   GetLineStipplePattern -> Just gl_LINE_STIPPLE_PATTERN-   GetLineStippleRepeat -> Just gl_LINE_STIPPLE_REPEAT-   GetSmoothPointSizeRange -> Just gl_POINT_SIZE_RANGE-   GetSmoothPointSizeGranularity -> Just gl_POINT_SIZE_GRANULARITY-   GetSmoothLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE-   GetSmoothLineWidthGranularity -> Just gl_SMOOTH_LINE_WIDTH_GRANULARITY-   GetAliasedPointSizeRange -> Just gl_ALIASED_POINT_SIZE_RANGE-   GetAliasedLineWidthRange -> Just gl_ALIASED_LINE_WIDTH_RANGE-   GetListMode -> Just gl_LIST_MODE-   GetMaxListNesting -> Just gl_MAX_LIST_NESTING-   GetListBase -> Just gl_LIST_BASE-   GetListIndex -> Just gl_LIST_INDEX-   GetPolygonMode -> Just gl_POLYGON_MODE-   GetPolygonSmooth -> Just gl_POLYGON_SMOOTH-   GetPolygonStipple -> Just gl_POLYGON_STIPPLE-   GetEdgeFlag -> Just gl_EDGE_FLAG-   GetCullFace -> Just gl_CULL_FACE-   GetCullFaceMode -> Just gl_CULL_FACE_MODE-   GetFrontFace -> Just gl_FRONT_FACE-   GetLighting -> Just gl_LIGHTING-   GetLightModelLocalViewer -> Just gl_LIGHT_MODEL_LOCAL_VIEWER-   GetLightModelTwoSide -> Just gl_LIGHT_MODEL_TWO_SIDE-   GetLightModelAmbient -> Just gl_LIGHT_MODEL_AMBIENT-   GetShadeModel -> Just gl_SHADE_MODEL-   GetColorMaterialFace -> Just gl_COLOR_MATERIAL_FACE-   GetColorMaterialParameter -> Just gl_COLOR_MATERIAL_PARAMETER-   GetColorMaterial -> Just gl_COLOR_MATERIAL-   GetFog -> Just gl_FOG-   GetFogIndex -> Just gl_FOG_INDEX-   GetFogDensity -> Just gl_FOG_DENSITY-   GetFogStart -> Just gl_FOG_START-   GetFogEnd -> Just gl_FOG_END-   GetFogMode -> Just gl_FOG_MODE-   GetFogColor -> Just gl_FOG_COLOR-   GetFogCoordSrc -> Just gl_FOG_COORD_SRC-   GetCurrentFogCoord -> Just gl_CURRENT_FOG_COORD-   GetDepthRange -> Just gl_DEPTH_RANGE-   GetDepthTest -> Just gl_DEPTH_TEST-   GetDepthWritemask -> Just gl_DEPTH_WRITEMASK-   GetDepthClearValue -> Just gl_DEPTH_CLEAR_VALUE-   GetDepthFunc -> Just gl_DEPTH_FUNC-   GetAccumClearValue -> Just gl_ACCUM_CLEAR_VALUE-   GetStencilTest -> Just gl_STENCIL_TEST-   GetStencilClearValue -> Just gl_STENCIL_CLEAR_VALUE-   GetStencilFunc -> Just gl_STENCIL_FUNC-   GetStencilValueMask -> Just gl_STENCIL_VALUE_MASK-   GetStencilFail -> Just gl_STENCIL_FAIL-   GetStencilPassDepthFail -> Just gl_STENCIL_PASS_DEPTH_FAIL-   GetStencilPassDepthPass -> Just gl_STENCIL_PASS_DEPTH_PASS-   GetStencilRef -> Just gl_STENCIL_REF-   GetStencilWritemask -> Just gl_STENCIL_WRITEMASK-   GetMatrixMode -> Just gl_MATRIX_MODE-   GetNormalize -> Just gl_NORMALIZE-   GetViewport -> Just gl_VIEWPORT-   GetModelviewStackDepth -> Just gl_MODELVIEW_STACK_DEPTH-   GetProjectionStackDepth -> Just gl_PROJECTION_STACK_DEPTH-   GetTextureStackDepth -> Just gl_TEXTURE_STACK_DEPTH-   GetModelviewMatrix -> Just gl_MODELVIEW_MATRIX-   GetProjectionMatrix -> Just gl_PROJECTION_MATRIX-   GetTextureMatrix -> Just gl_TEXTURE_MATRIX-   GetAttribStackDepth -> Just gl_ATTRIB_STACK_DEPTH-   GetClientAttribStackDepth -> Just gl_CLIENT_ATTRIB_STACK_DEPTH-   GetAlphaTest -> Just gl_ALPHA_TEST-   GetAlphaTestFunc -> Just gl_ALPHA_TEST_FUNC-   GetAlphaTestRef -> Just gl_ALPHA_TEST_REF-   GetDither -> Just gl_DITHER-   GetBlendDst -> Just gl_BLEND_DST-   GetBlendSrc -> Just gl_BLEND_SRC-   GetBlend -> Just gl_BLEND-   GetLogicOpMode -> Just gl_LOGIC_OP_MODE-   GetIndexLogicOp -> Just gl_INDEX_LOGIC_OP-   GetLogicOp -> Just gl_INDEX_LOGIC_OP-   GetColorLogicOp -> Just gl_COLOR_LOGIC_OP-   GetAuxBuffers -> Just gl_AUX_BUFFERS-   GetDrawBuffer -> Just gl_DRAW_BUFFER-   GetReadBuffer -> Just gl_READ_BUFFER-   GetScissorBox -> Just gl_SCISSOR_BOX-   GetScissorTest -> Just gl_SCISSOR_TEST-   GetIndexClearValue -> Just gl_INDEX_CLEAR_VALUE-   GetIndexWritemask -> Just gl_INDEX_WRITEMASK-   GetColorClearValue -> Just gl_COLOR_CLEAR_VALUE-   GetColorWritemask -> Just gl_COLOR_WRITEMASK-   GetIndexMode -> Just gl_INDEX_MODE-   GetRGBAMode -> Just gl_RGBA_MODE-   GetDoublebuffer -> Just gl_DOUBLEBUFFER-   GetStereo -> Just gl_STEREO-   GetRenderMode -> Just gl_RENDER_MODE-   GetPerspectiveCorrectionHint -> Just gl_PERSPECTIVE_CORRECTION_HINT-   GetPointSmoothHint -> Just gl_POINT_SMOOTH_HINT-   GetLineSmoothHint -> Just gl_LINE_SMOOTH_HINT-   GetPolygonSmoothHint -> Just gl_POLYGON_SMOOTH_HINT-   GetFogHint -> Just gl_FOG_HINT-   GetGenerateMipmapHint -> Just gl_GENERATE_MIPMAP_HINT-   GetTextureCompressionHint -> Just gl_TEXTURE_COMPRESSION_HINT-   GetTextureGenS -> Just gl_TEXTURE_GEN_S-   GetTextureGenT -> Just gl_TEXTURE_GEN_T-   GetTextureGenR -> Just gl_TEXTURE_GEN_R-   GetTextureGenQ -> Just gl_TEXTURE_GEN_Q-   GetPixelMapIToISize -> Just gl_PIXEL_MAP_I_TO_I_SIZE-   GetPixelMapSToSSize -> Just gl_PIXEL_MAP_S_TO_S_SIZE-   GetPixelMapIToRSize -> Just gl_PIXEL_MAP_I_TO_R_SIZE-   GetPixelMapIToGSize -> Just gl_PIXEL_MAP_I_TO_G_SIZE-   GetPixelMapIToBSize -> Just gl_PIXEL_MAP_I_TO_B_SIZE-   GetPixelMapIToASize -> Just gl_PIXEL_MAP_I_TO_A_SIZE-   GetPixelMapRToRSize -> Just gl_PIXEL_MAP_R_TO_R_SIZE-   GetPixelMapGToGSize -> Just gl_PIXEL_MAP_G_TO_G_SIZE-   GetPixelMapBToBSize -> Just gl_PIXEL_MAP_B_TO_B_SIZE-   GetPixelMapAToASize -> Just gl_PIXEL_MAP_A_TO_A_SIZE-   GetUnpackSwapBytes -> Just gl_UNPACK_SWAP_BYTES-   GetUnpackLSBFirst -> Just gl_UNPACK_LSB_FIRST-   GetUnpackRowLength -> Just gl_UNPACK_ROW_LENGTH-   GetUnpackSkipRows -> Just gl_UNPACK_SKIP_ROWS-   GetUnpackSkipPixels -> Just gl_UNPACK_SKIP_PIXELS-   GetUnpackAlignment -> Just gl_UNPACK_ALIGNMENT-   GetPackSwapBytes -> Just gl_PACK_SWAP_BYTES-   GetPackLSBFirst -> Just gl_PACK_LSB_FIRST-   GetPackRowLength -> Just gl_PACK_ROW_LENGTH-   GetPackSkipRows -> Just gl_PACK_SKIP_ROWS-   GetPackSkipPixels -> Just gl_PACK_SKIP_PIXELS-   GetPackAlignment -> Just gl_PACK_ALIGNMENT-   GetMapColor -> Just gl_MAP_COLOR-   GetMapStencil -> Just gl_MAP_STENCIL-   GetIndexShift -> Just gl_INDEX_SHIFT-   GetIndexOffset -> Just gl_INDEX_OFFSET-   GetRedScale -> Just gl_RED_SCALE-   GetRedBias -> Just gl_RED_BIAS-   GetZoomX -> Just gl_ZOOM_X-   GetZoomY -> Just gl_ZOOM_Y-   GetGreenScale -> Just gl_GREEN_SCALE-   GetGreenBias -> Just gl_GREEN_BIAS-   GetBlueScale -> Just gl_BLUE_SCALE-   GetBlueBias -> Just gl_BLUE_BIAS-   GetAlphaScale -> Just gl_ALPHA_SCALE-   GetAlphaBias -> Just gl_ALPHA_BIAS-   GetDepthScale -> Just gl_DEPTH_SCALE-   GetDepthBias -> Just gl_DEPTH_BIAS-   GetMaxEvalOrder -> Just gl_MAX_EVAL_ORDER-   GetMaxLights -> Just gl_MAX_LIGHTS-   GetMaxClipPlanes -> Just gl_MAX_CLIP_DISTANCES-   GetMaxTextureSize -> Just gl_MAX_TEXTURE_SIZE-   GetMaxPixelMapTable -> Just gl_MAX_PIXEL_MAP_TABLE-   GetMaxAttribStackDepth -> Just gl_MAX_ATTRIB_STACK_DEPTH-   GetMaxModelviewStackDepth -> Just gl_MAX_MODELVIEW_STACK_DEPTH-   GetMaxNameStackDepth -> Just gl_MAX_NAME_STACK_DEPTH-   GetMaxProjectionStackDepth -> Just gl_MAX_PROJECTION_STACK_DEPTH-   GetMaxTextureStackDepth -> Just gl_MAX_TEXTURE_STACK_DEPTH-   GetMaxViewportDims -> Just gl_MAX_VIEWPORT_DIMS-   GetMaxClientAttribStackDepth -> Just gl_MAX_CLIENT_ATTRIB_STACK_DEPTH-   GetSubpixelBits -> Just gl_SUBPIXEL_BITS-   GetIndexBits -> Just gl_INDEX_BITS-   GetRedBits -> Just gl_RED_BITS-   GetGreenBits -> Just gl_GREEN_BITS-   GetBlueBits -> Just gl_BLUE_BITS-   GetAlphaBits -> Just gl_ALPHA_BITS-   GetDepthBits -> Just gl_DEPTH_BITS-   GetStencilBits -> Just gl_STENCIL_BITS-   GetAccumRedBits -> Just gl_ACCUM_RED_BITS-   GetAccumGreenBits -> Just gl_ACCUM_GREEN_BITS-   GetAccumBlueBits -> Just gl_ACCUM_BLUE_BITS-   GetAccumAlphaBits -> Just gl_ACCUM_ALPHA_BITS-   GetNameStackDepth -> Just gl_NAME_STACK_DEPTH-   GetAutoNormal -> Just gl_AUTO_NORMAL-   GetMap1Color4 -> Just gl_MAP1_COLOR_4-   GetMap1Index -> Just gl_MAP1_INDEX-   GetMap1Normal -> Just gl_MAP1_NORMAL-   GetMap1TextureCoord1 -> Just gl_MAP1_TEXTURE_COORD_1-   GetMap1TextureCoord2 -> Just gl_MAP1_TEXTURE_COORD_2-   GetMap1TextureCoord3 -> Just gl_MAP1_TEXTURE_COORD_3-   GetMap1TextureCoord4 -> Just gl_MAP1_TEXTURE_COORD_4-   GetMap1Vertex3 -> Just gl_MAP1_VERTEX_3-   GetMap1Vertex4 -> Just gl_MAP1_VERTEX_4-   GetMap2Color4 -> Just gl_MAP2_COLOR_4-   GetMap2Index -> Just gl_MAP2_INDEX-   GetMap2Normal -> Just gl_MAP2_NORMAL-   GetMap2TextureCoord1 -> Just gl_MAP2_TEXTURE_COORD_1-   GetMap2TextureCoord2 -> Just gl_MAP2_TEXTURE_COORD_2-   GetMap2TextureCoord3 -> Just gl_MAP2_TEXTURE_COORD_3-   GetMap2TextureCoord4 -> Just gl_MAP2_TEXTURE_COORD_4-   GetMap2Vertex3 -> Just gl_MAP2_VERTEX_3-   GetMap2Vertex4 -> Just gl_MAP2_VERTEX_4-   GetMap1GridDomain -> Just gl_MAP1_GRID_DOMAIN-   GetMap1GridSegments -> Just gl_MAP1_GRID_SEGMENTS-   GetMap2GridDomain -> Just gl_MAP2_GRID_DOMAIN-   GetMap2GridSegments -> Just gl_MAP2_GRID_SEGMENTS-   GetTexture1D -> Just gl_TEXTURE_1D-   GetTexture2D -> Just gl_TEXTURE_2D-   GetFeedbackBufferSize -> Just gl_FEEDBACK_BUFFER_SIZE-   GetFeedbackBufferType -> Just gl_FEEDBACK_BUFFER_TYPE-   GetSelectionBufferSize -> Just gl_SELECTION_BUFFER_SIZE-   GetPolygonOffsetUnits -> Just gl_POLYGON_OFFSET_UNITS-   GetPolygonOffsetPoint -> Just gl_POLYGON_OFFSET_POINT-   GetPolygonOffsetLine -> Just gl_POLYGON_OFFSET_LINE-   GetPolygonOffsetFill -> Just gl_POLYGON_OFFSET_FILL-   GetPolygonOffsetFactor -> Just gl_POLYGON_OFFSET_FACTOR-   GetTextureBinding1D -> Just gl_TEXTURE_BINDING_1D-   GetTextureBinding2D -> Just gl_TEXTURE_BINDING_2D-   GetTextureBinding3D -> Just gl_TEXTURE_BINDING_3D-   GetVertexArray -> Just gl_VERTEX_ARRAY-   GetNormalArray -> Just gl_NORMAL_ARRAY-   GetColorArray -> Just gl_COLOR_ARRAY-   GetIndexArray -> Just gl_INDEX_ARRAY-   GetTextureCoordArray -> Just gl_TEXTURE_COORD_ARRAY-   GetEdgeFlagArray -> Just gl_EDGE_FLAG_ARRAY-   GetFogCoordArray -> Just gl_FOG_COORD_ARRAY-   GetSecondaryColorArray -> Just gl_SECONDARY_COLOR_ARRAY-   GetMatrixIndexArray -> Just gl_MATRIX_INDEX_ARRAY-   GetVertexArraySize -> Just gl_VERTEX_ARRAY_SIZE-   GetVertexArrayType -> Just gl_VERTEX_ARRAY_TYPE-   GetVertexArrayStride -> Just gl_VERTEX_ARRAY_STRIDE-   GetNormalArrayType -> Just gl_NORMAL_ARRAY_TYPE-   GetNormalArrayStride -> Just gl_NORMAL_ARRAY_STRIDE-   GetColorArraySize -> Just gl_COLOR_ARRAY_SIZE-   GetColorArrayType -> Just gl_COLOR_ARRAY_TYPE-   GetColorArrayStride -> Just gl_COLOR_ARRAY_STRIDE-   GetIndexArrayType -> Just gl_INDEX_ARRAY_TYPE-   GetIndexArrayStride -> Just gl_INDEX_ARRAY_STRIDE-   GetTextureCoordArraySize -> Just gl_TEXTURE_COORD_ARRAY_SIZE-   GetTextureCoordArrayType -> Just gl_TEXTURE_COORD_ARRAY_TYPE-   GetTextureCoordArrayStride -> Just gl_TEXTURE_COORD_ARRAY_STRIDE-   GetEdgeFlagArrayStride -> Just gl_EDGE_FLAG_ARRAY_STRIDE-   GetFogCoordArrayType -> Just gl_FOG_COORD_ARRAY_TYPE-   GetFogCoordArrayStride -> Just gl_FOG_COORD_ARRAY_STRIDE-   GetSecondaryColorArraySize -> Just gl_SECONDARY_COLOR_ARRAY_SIZE-   GetSecondaryColorArrayType -> Just gl_SECONDARY_COLOR_ARRAY_TYPE-   GetSecondaryColorArrayStride -> Just gl_SECONDARY_COLOR_ARRAY_STRIDE-   GetMatrixIndexArraySize -> Just gl_MATRIX_INDEX_ARRAY_SIZE-   GetMatrixIndexArrayType -> Just gl_MATRIX_INDEX_ARRAY_TYPE-   GetMatrixIndexArrayStride -> Just gl_MATRIX_INDEX_ARRAY_STRIDE-   GetClipPlane i -> clipPlaneIndexToEnum i-   GetLight i -> lightIndexToEnum i-   GetTransposeModelviewMatrix -> Just gl_TRANSPOSE_MODELVIEW_MATRIX-   GetTransposeProjectionMatrix -> Just gl_TRANSPOSE_PROJECTION_MATRIX-   GetTransposeTextureMatrix -> Just gl_TRANSPOSE_TEXTURE_MATRIX-   GetTransposeColorMatrix -> Just gl_TRANSPOSE_COLOR_MATRIX-   GetLightModelColorControl -> Just gl_LIGHT_MODEL_COLOR_CONTROL-   GetBlendColor -> Just gl_BLEND_COLOR-   GetBlendEquation -> Just gl_BLEND_EQUATION_RGB-   GetBlendEquationAlpha -> Just gl_BLEND_EQUATION_ALPHA-   GetColorTable -> Just gl_COLOR_TABLE-   GetPostConvolutionColorTable -> Just gl_POST_CONVOLUTION_COLOR_TABLE-   GetPostColorMatrixColorTable -> Just gl_POST_COLOR_MATRIX_COLOR_TABLE-   GetConvolution1D -> Just gl_CONVOLUTION_1D-   GetConvolution2D -> Just gl_CONVOLUTION_2D-   GetSeparable2D -> Just gl_SEPARABLE_2D-   GetMaxConvolutionWidth -> Just gl_MAX_CONVOLUTION_WIDTH-   GetMaxConvolutionHeight -> Just gl_MAX_CONVOLUTION_HEIGHT-   GetPostConvolutionRedScale -> Just gl_POST_CONVOLUTION_RED_SCALE-   GetPostConvolutionGreenScale -> Just gl_POST_CONVOLUTION_GREEN_SCALE-   GetPostConvolutionBlueScale -> Just gl_POST_CONVOLUTION_BLUE_SCALE-   GetPostConvolutionAlphaScale -> Just gl_POST_CONVOLUTION_ALPHA_SCALE-   GetPostConvolutionRedBias -> Just gl_POST_CONVOLUTION_RED_BIAS-   GetPostConvolutionGreenBias -> Just gl_POST_CONVOLUTION_GREEN_BIAS-   GetPostConvolutionBlueBias -> Just gl_POST_CONVOLUTION_BLUE_BIAS-   GetPostConvolutionAlphaBias -> Just gl_POST_CONVOLUTION_ALPHA_BIAS-   GetHistogram -> Just gl_HISTOGRAM-   GetMinmax -> Just gl_MINMAX-   GetColorSum -> Just gl_COLOR_SUM-   GetCurrentSecondaryColor -> Just gl_CURRENT_SECONDARY_COLOR-   GetRescaleNormal -> Just gl_RESCALE_NORMAL-   GetSharedTexturePalette -> Just gl_SHARED_TEXTURE_PALETTE-   GetTexture3DBinding -> Just gl_TEXTURE_BINDING_3D-   GetPackSkipImages -> Just gl_PACK_SKIP_IMAGES-   GetPackImageHeight -> Just gl_PACK_IMAGE_HEIGHT-   GetUnpackSkipImages -> Just gl_UNPACK_SKIP_IMAGES-   GetUnpackImageHeight -> Just gl_UNPACK_IMAGE_HEIGHT-   GetTexture3D -> Just gl_TEXTURE_3D-   GetMax3DTextureSize -> Just gl_MAX_3D_TEXTURE_SIZE-   GetMaxTextureLODBias -> Just gl_MAX_TEXTURE_LOD_BIAS-   GetMaxTextureMaxAnisotropy -> Just gl_MAX_TEXTURE_MAX_ANISOTROPY-   GetMultisample -> Just gl_MULTISAMPLE-   GetSampleAlphaToCoverage -> Just gl_SAMPLE_ALPHA_TO_COVERAGE-   GetSampleAlphaToOne -> Just gl_SAMPLE_ALPHA_TO_ONE-   GetSampleCoverage -> Just gl_SAMPLE_COVERAGE-   GetSampleBuffers -> Just gl_SAMPLE_BUFFERS-   GetSamples -> Just gl_SAMPLES-   GetSampleCoverageValue -> Just gl_SAMPLE_COVERAGE_VALUE-   GetSampleCoverageInvert -> Just gl_SAMPLE_COVERAGE_INVERT-   GetPointSizeMin -> Just gl_POINT_SIZE_MIN-   GetPointSizeMax -> Just gl_POINT_SIZE_MAX-   GetPointFadeThresholdSize -> Just gl_POINT_FADE_THRESHOLD_SIZE-   GetPointDistanceAttenuation -> Just gl_POINT_DISTANCE_ATTENUATION-   GetColorMatrix -> Just gl_COLOR_MATRIX-   GetColorMatrixStackDepth -> Just gl_COLOR_MATRIX_STACK_DEPTH-   GetMaxColorMatrixStackDepth -> Just gl_MAX_COLOR_MATRIX_STACK_DEPTH-   GetPostColorMatrixRedScale -> Just gl_POST_COLOR_MATRIX_RED_SCALE-   GetPostColorMatrixGreenScale -> Just gl_POST_COLOR_MATRIX_GREEN_SCALE-   GetPostColorMatrixBlueScale -> Just gl_POST_COLOR_MATRIX_BLUE_SCALE-   GetPostColorMatrixAlphaScale -> Just gl_POST_COLOR_MATRIX_ALPHA_SCALE-   GetPostColorMatrixRedBias -> Just gl_POST_COLOR_MATRIX_RED_BIAS-   GetPostColorMatrixGreenBias -> Just gl_POST_COLOR_MATRIX_GREEN_BIAS-   GetPostColorMatrixBlueBias -> Just gl_POST_COLOR_MATRIX_BLUE_BIAS-   GetPostColorMatrixAlphaBias -> Just gl_POST_COLOR_MATRIX_ALPHA_BIAS-   GetMaxElementsVertices -> Just gl_MAX_ELEMENTS_VERTICES-   GetMaxElementsIndices -> Just gl_MAX_ELEMENTS_INDICES-   GetActiveTexture -> Just gl_ACTIVE_TEXTURE-   GetClientActiveTexture -> Just gl_CLIENT_ACTIVE_TEXTURE-   GetMaxTextureUnits -> Just gl_MAX_TEXTURE_UNITS-   GetTextureCubeMap -> Just gl_TEXTURE_CUBE_MAP-   GetMaxCubeMapTextureSize -> Just gl_MAX_CUBE_MAP_TEXTURE_SIZE-   GetMaxRectangleTextureSize -> Just gl_MAX_RECTANGLE_TEXTURE_SIZE-   GetNumCompressedTextureFormats -> Just gl_NUM_COMPRESSED_TEXTURE_FORMATS-   GetCompressedTextureFormats -> Just gl_COMPRESSED_TEXTURE_FORMATS-   GetMaxVertexUnits -> Just gl_MAX_VERTEX_UNITS-   GetActiveVertexUnits -> Just gl_ACTIVE_VERTEX_UNITS-   GetWeightSumUnity -> Just gl_WEIGHT_SUM_UNITY-   GetVertexBlend -> Just gl_VERTEX_BLEND-   GetModelview i -> modelviewIndexToEnum i-   GetCurrentWeight -> Just gl_CURRENT_WEIGHT-   GetWeightArrayType -> Just gl_WEIGHT_ARRAY_TYPE-   GetWeightArrayStride -> Just gl_WEIGHT_ARRAY_STRIDE-   GetWeightArraySize -> Just gl_WEIGHT_ARRAY_SIZE-   GetWeightArray -> Just gl_WEIGHT_ARRAY-   GetMatrixPalette -> Just gl_MATRIX_PALETTE-   GetMaxMatrixPaletteStackDepth -> Just gl_MAX_MATRIX_PALETTE_STACK_DEPTH-   GetMaxPaletteMatrices -> Just gl_MAX_PALETTE_MATRICES-   GetCurrentPaletteMatrix -> Just gl_CURRENT_PALETTE_MATRIX-   GetBlendDstRGB -> Just gl_BLEND_DST_RGB-   GetBlendSrcRGB -> Just gl_BLEND_SRC_RGB-   GetBlendDstAlpha -> Just gl_BLEND_DST_ALPHA-   GetBlendSrcAlpha -> Just gl_BLEND_SRC_ALPHA-   GetPackCMYKHint -> Just gl_PACK_CMYK_HINT-   GetUnpackCMYKHint -> Just gl_UNPACK_CMYK_HINT-   GetArrayElementLockFirst -> Just gl_ARRAY_ELEMENT_LOCK_FIRST-   GetArrayElementLockCount -> Just gl_ARRAY_ELEMENT_LOCK_COUNT-   GetMaxShininess -> Just gl_MAX_SHININESS-   GetMaxSpotExponent -> Just gl_MAX_SPOT_EXPONENT-   GetFogDistanceMode -> Just gl_FOG_DISTANCE_MODE-   GetDepthBounds -> Just gl_DEPTH_BOUNDS-   GetPrimitiveRestartIndex -> Just gl_PRIMITIVE_RESTART_INDEX-   GetPrimitiveRestartNV -> Just gl_PRIMITIVE_RESTART_NV-   GetPrimitiveRestartIndexNV -> Just gl_PRIMITIVE_RESTART_INDEX_NV-   GetActiveStencilFace -> Just gl_ACTIVE_STENCIL_FACE-   GetArrayBufferBinding -> Just gl_ARRAY_BUFFER_BINDING-   GetElementArrayBufferBinding -> Just gl_ELEMENT_ARRAY_BUFFER_BINDING-   GetVertexArrayBufferBinding -> Just gl_VERTEX_ARRAY_BUFFER_BINDING-   GetNormalArrayBufferBinding -> Just gl_NORMAL_ARRAY_BUFFER_BINDING-   GetColorArrayBufferBinding -> Just gl_COLOR_ARRAY_BUFFER_BINDING-   GetIndexArrayBufferBinding -> Just gl_INDEX_ARRAY_BUFFER_BINDING-   GetTextureCoordArrayBufferBinding -> Just gl_TEXTURE_COORD_ARRAY_BUFFER_BINDING-   GetEdgeFlagArrayBufferBinding -> Just gl_EDGE_FLAG_ARRAY_BUFFER_BINDING-   GetSecondaryColorArrayBufferBinding -> Just gl_SECONDARY_COLOR_ARRAY_BUFFER_BINDING-   GetFogCoordArrayBufferBinding -> Just gl_FOG_COORD_ARRAY_BUFFER_BINDING-   GetTextureBindingCubeMap -> Just gl_TEXTURE_BINDING_CUBE_MAP-   GetTextureBindingRectangle -> Just gl_TEXTURE_BINDING_RECTANGLE-   GetCurrentMatrix -> Just gl_CURRENT_MATRIX-   GetCurrentMatrixStackDepth -> Just gl_CURRENT_MATRIX_STACK_DEPTH-   GetMaxCombinedTextureImageUnits -> Just gl_MAX_COMBINED_TEXTURE_IMAGE_UNITS-   GetMaxDrawBuffers -> Just gl_MAX_DRAW_BUFFERS-   GetMaxFragmentUniformComponents -> Just gl_MAX_FRAGMENT_UNIFORM_COMPONENTS-   GetMaxTextureCoords -> Just gl_MAX_TEXTURE_COORDS-   GetMaxTextureImageUnits -> Just gl_MAX_TEXTURE_IMAGE_UNITS-   GetMaxVaryingFloats -> Just gl_MAX_VARYING_COMPONENTS-   GetMaxVertexAttribs -> Just gl_MAX_VERTEX_ATTRIBS-   GetMaxVertexTextureImageUnits -> Just gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS-   GetMaxVertexUniformComponents -> Just gl_MAX_VERTEX_UNIFORM_COMPONENTS-   GetCurrentProgram -> Just gl_CURRENT_PROGRAM-   GetPixelPackBufferBinding -> Just gl_PIXEL_PACK_BUFFER_BINDING-   GetPixelUnpackBufferBinding -> Just gl_PIXEL_UNPACK_BUFFER_BINDING-   GetDrawBufferN i -> drawBufferIndexToEnum i-   GetRGBASignedComponents -> Just gl_RGBA_SIGNED_COMPONENTS-   GetCopyReadBuffer -> Just gl_COPY_READ_BUFFER-   GetCopyWriteBuffer -> Just gl_COPY_WRITE_BUFFER-   -- GetWeightArrayBufferBinding -> Just gl_WEIGHT_ARRAY_BUFFER_BINDING-   GetContextProfileMask -> Just gl_CONTEXT_PROFILE_MASK-------------------------------------------------------------------------------------- 0x3000 through 0x3FFF are reserved for clip planes--clipPlaneIndexToEnum :: GLsizei -> Maybe GLenum-clipPlaneIndexToEnum i-   | 0 <= i && i <= maxClipPlaneIndex = Just (gl_CLIP_DISTANCE0 + fromIntegral i)-   | otherwise = Nothing--maxClipPlaneIndex :: GLsizei-maxClipPlaneIndex = 0xFFF-------------------------------------------------------------------------------------- 0x4000 through 0x4FFF are reserved for light numbers--lightIndexToEnum :: GLsizei -> Maybe GLenum-lightIndexToEnum i-   | 0 <= i && i <= maxLightIndex = Just (gl_LIGHT0 + fromIntegral i)-   | otherwise = Nothing--maxLightIndex :: GLsizei-maxLightIndex = 0xFFF-------------------------------------------------------------------------------------- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices--modelviewIndexToEnum :: GLsizei -> Maybe GLenum-modelviewIndexToEnum 0 = Just gl_MODELVIEW-modelviewIndexToEnum 1 = Just gl_MODELVIEW1-modelviewIndexToEnum i-   | 2 <= i && i <= 31 = Just (gl_MODELVIEW2 - 2 + fromIntegral i)-   | otherwise = Nothing--modelviewEnumToIndex :: GLenum -> Maybe GLsizei-modelviewEnumToIndex x-   | x == gl_MODELVIEW = Just 0-   | x == gl_MODELVIEW1 = Just 1-   | gl_MODELVIEW2 <= x && x <= gl_MODELVIEW31 = Just (fromIntegral (x - (gl_MODELVIEW2 - 2)))-   | otherwise = Nothing-------------------------------------------------------------------------------------- 0x8825 through 0x8834 are reserved for draw buffers--drawBufferIndexToEnum :: GLsizei -> Maybe GLenum-drawBufferIndexToEnum i-   | 0 <= i && i <= maxDrawBufferIndex = Just (gl_DRAW_BUFFER0 + fromIntegral i)-   | otherwise = Nothing--maxDrawBufferIndex :: GLsizei-maxDrawBufferIndex = fromIntegral (gl_DRAW_BUFFER15 - gl_DRAW_BUFFER0)------------------------------------------------------------------------------------getBoolean1 :: (GLboolean -> a) -> GetPName -> IO a-getBoolean1 f n = alloca $ \buf -> do-   getBooleanv n buf-   peek1 f buf--getBoolean4 :: (GLboolean -> GLboolean -> GLboolean -> GLboolean -> a)-            -> GetPName -> IO a-getBoolean4 f n = allocaArray 4 $ \buf -> do-   getBooleanv n buf-   peek4 f buf--getBooleanv :: GetPName -> Ptr GLboolean -> IO ()-getBooleanv = makeGetter glGetBooleanv--{-# INLINE makeGetter #-}-makeGetter :: (GLenum -> Ptr a -> IO ()) -> GetPName -> Ptr a -> IO ()-makeGetter f = maybe (const recordInvalidEnum) f . marshalGetPName------------------------------------------------------------------------------------getInteger1 :: (GLint -> a) -> GetPName -> IO a-getInteger1 f n = alloca $ \buf -> do-   getIntegerv n buf-   peek1 f buf--getInteger2 :: (GLint -> GLint -> a) -> GetPName -> IO a-getInteger2 f n = allocaArray 2 $ \buf -> do-   getIntegerv n buf-   peek2 f buf--getInteger4 :: (GLint -> GLint -> GLint -> GLint -> a) -> GetPName -> IO a-getInteger4 f n = allocaArray 4 $ \buf -> do-   getIntegerv n buf-   peek4 f buf--getIntegerv :: GetPName -> Ptr GLint -> IO ()-getIntegerv = maybe (const recordInvalidEnum) glGetIntegerv . marshalGetPName------------------------------------------------------------------------------------getEnum1 :: (GLenum -> a) -> GetPName -> IO a-getEnum1 f n = alloca $ \buf -> do-   getIntegerv n buf-   peek1 f (castPtr buf)------------------------------------------------------------------------------------getSizei1 :: (GLsizei -> a) -> GetPName -> IO a-getSizei1 f n = alloca $ \buf -> do-   getIntegerv n buf-   peek1 f (castPtr buf)--getSizei2 :: (GLsizei -> GLsizei -> a) -> GetPName -> IO a-getSizei2 f n = allocaArray 2 $ \buf -> do-   getIntegerv n buf-   peek2 f (castPtr buf)------------------------------------------------------------------------------------getFloat1 :: (GLfloat -> a) -> GetPName -> IO a-getFloat1 f n = alloca $ \buf -> do-   getFloatv n buf-   peek1 f buf--getFloat2 :: (GLfloat -> GLfloat -> a) -> GetPName -> IO a-getFloat2 f n = allocaArray 2 $ \buf -> do-   getFloatv n buf-   peek2 f buf--getFloat3 :: (GLfloat -> GLfloat -> GLfloat -> a) -> GetPName -> IO a-getFloat3 f n = allocaArray 3 $ \buf -> do-   getFloatv n buf-   peek3 f buf--getFloat4 ::-   (GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> GetPName -> IO a-getFloat4 f n = allocaArray 4 $ \buf -> do-   getFloatv n buf-   peek4 f buf--getFloatv :: GetPName -> Ptr GLfloat -> IO ()-getFloatv = maybe (const recordInvalidEnum) glGetFloatv . marshalGetPName------------------------------------------------------------------------------------getClampf1 :: (GLclampf -> a) -> GetPName -> IO a-getClampf1 f n = alloca $ \buf -> do-   getFloatv n buf-   peek1 f (castPtr buf)--getClampf4 ::-   (GLclampf -> GLclampf -> GLclampf -> GLclampf -> a) -> GetPName -> IO a-getClampf4 f n = allocaArray 4 $ \buf -> do-   getFloatv n buf-   peek4 f (castPtr buf)------------------------------------------------------------------------------------getDouble1 :: (GLdouble -> a) -> GetPName -> IO a-getDouble1 f n = alloca $ \buf -> do-   getDoublev n buf-   peek1 f buf--getDouble2 :: (GLdouble -> GLdouble -> a) -> GetPName -> IO a-getDouble2 f n = allocaArray 2 $ \buf -> do-   getDoublev n buf-   peek2 f buf--getDouble4 ::-   (GLdouble -> GLdouble -> GLdouble -> GLdouble -> a) -> GetPName -> IO a-getDouble4 f n = allocaArray 4 $ \buf -> do-   getDoublev n buf-   peek4 f buf--getDoublev :: GetPName -> Ptr GLdouble -> IO ()-getDoublev = maybe (const recordInvalidEnum) glGetDoublev . marshalGetPName------------------------------------------------------------------------------------getClampd1 :: (GLclampd -> a) -> GetPName -> IO a-getClampd1 f n = alloca $ \buf -> do-   getDoublev n buf-   peek1 f (castPtr buf)--getClampd2 :: (GLclampd -> GLclampd -> a) -> GetPName -> IO a-getClampd2 f n = allocaArray 2 $ \buf -> do-   getDoublev n buf-   peek2 f (castPtr buf)------------------------------------------------------------------------------------maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b-maybeNullPtr n f ptr | ptr == nullPtr = n-                     | otherwise      = f ptr-----------------------------------------------------------------------------------newtype AttribLocation = AttribLocation GLuint-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------data GetVertexAttribPName =-     GetVertexAttribArrayEnabled-   | GetVertexAttribArraySize-   | GetVertexAttribArrayStride-   | GetVertexAttribArrayType-   | GetVertexAttribArrayNormalized-   | GetCurrentVertexAttrib-   | GetVertexAttribArrayBufferBinding-   | GetVertexAttribArrayInteger--marshalGetVertexAttribPName :: GetVertexAttribPName -> GLenum-marshalGetVertexAttribPName x = case x of-   GetVertexAttribArrayEnabled -> gl_VERTEX_ATTRIB_ARRAY_ENABLED-   GetVertexAttribArraySize -> gl_VERTEX_ATTRIB_ARRAY_SIZE-   GetVertexAttribArrayStride -> gl_VERTEX_ATTRIB_ARRAY_STRIDE-   GetVertexAttribArrayType -> gl_VERTEX_ATTRIB_ARRAY_TYPE-   GetVertexAttribArrayNormalized -> gl_VERTEX_ATTRIB_ARRAY_NORMALIZED-   GetCurrentVertexAttrib -> gl_CURRENT_VERTEX_ATTRIB-   GetVertexAttribArrayBufferBinding -> gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING-   GetVertexAttribArrayInteger -> gl_VERTEX_ATTRIB_ARRAY_INTEGER------------------------------------------------------------------------------------getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribInteger1 f (AttribLocation location) n = alloca $ \buf -> do-   glGetVertexAttribiv location (marshalGetVertexAttribPName n) buf-   peek1 f buf--getVertexAttribEnum1 :: (GLenum -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribEnum1 f = getVertexAttribInteger1 (f . fromIntegral)--getVertexAttribBoolean1 :: (GLboolean -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribBoolean1 f = getVertexAttribInteger1 (f . fromIntegral)--getVertexAttribFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribFloat4 f (AttribLocation location) n = alloca $ \buf -> do-   glGetVertexAttribfv location (marshalGetVertexAttribPName n) buf-   peek4 f buf--getVertexAttribIInteger4 :: (GLint -> GLint -> GLint -> GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribIInteger4 f (AttribLocation location) n = alloca $ \buf -> do-   glGetVertexAttribIiv location (marshalGetVertexAttribPName n) buf-   peek4 f buf--getVertexAttribIuInteger4 :: (GLuint -> GLuint -> GLuint -> GLuint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribIuInteger4 f (AttribLocation location) n = alloca $ \buf -> do-   glGetVertexAttribIuiv location (marshalGetVertexAttribPName n) buf-   peek4 f buf------------------------------------------------------------------------------------data GetVertexAttribPointerPName =-   VertexAttribArrayPointer--marshalGetVertexAttribPointerPName :: GetVertexAttribPointerPName -> GLenum-marshalGetVertexAttribPointerPName x = case x of-   VertexAttribArrayPointer -> gl_VERTEX_ATTRIB_ARRAY_POINTER------------------------------------------------------------------------------------getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a)-getVertexAttribPointer (AttribLocation location) n = alloca $ \buf -> do-   glGetVertexAttribPointerv location (marshalGetVertexAttribPointerPName n) buf-   peek buf
− Graphics/Rendering/OpenGL/GL/RasterPos.hs 
@@ -1,194 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.RasterPos--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.13 (Current Raster Position) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.RasterPos (-   currentRasterPosition, RasterPosComponent, RasterPos(..),-   WindowPosComponent, WindowPos(..),-   currentRasterDistance, currentRasterColor, currentRasterSecondaryColor,-   currentRasterIndex, currentRasterTexCoords, currentRasterPositionValid,-   rasterPositionUnclipped-) where--import Data.StateVar-import Data.Tensor-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glRasterPos2d, glRasterPos2dv, glRasterPos2f, glRasterPos2fv, glRasterPos2i,-   glRasterPos2iv, glRasterPos2s, glRasterPos2sv, glRasterPos3d, glRasterPos3dv,-   glRasterPos3f, glRasterPos3fv, glRasterPos3i, glRasterPos3iv, glRasterPos3s,-   glRasterPos3sv, glRasterPos4d, glRasterPos4dv, glRasterPos4f, glRasterPos4fv,-   glRasterPos4i, glRasterPos4iv, glRasterPos4s, glRasterPos4sv, glWindowPos2d,-   glWindowPos2dv, glWindowPos2f, glWindowPos2fv, glWindowPos2i, glWindowPos2iv,-   glWindowPos2s, glWindowPos2sv, glWindowPos3d, glWindowPos3dv, glWindowPos3f,-   glWindowPos3fv, glWindowPos3i, glWindowPos3iv, glWindowPos3s, glWindowPos3sv )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------currentRasterPosition :: StateVar (Vertex4 GLfloat)-currentRasterPosition =-   makeStateVar (getFloat4 Vertex4 GetCurrentRasterPosition) rasterPos------------------------------------------------------------------------------------class RasterPosComponent a where-   rasterPos2 :: a -> a -> IO ()-   rasterPos3 :: a -> a -> a -> IO ()-   rasterPos4 :: a -> a -> a -> a -> IO ()--   rasterPos2v :: Ptr a -> IO ()-   rasterPos3v :: Ptr a -> IO ()-   rasterPos4v :: Ptr a -> IO ()--instance RasterPosComponent GLshort where-   rasterPos2 = glRasterPos2s-   rasterPos3 = glRasterPos3s-   rasterPos4 = glRasterPos4s--   rasterPos2v = glRasterPos2sv-   rasterPos3v = glRasterPos3sv-   rasterPos4v = glRasterPos4sv--instance RasterPosComponent GLint where-   rasterPos2 = glRasterPos2i-   rasterPos3 = glRasterPos3i-   rasterPos4 = glRasterPos4i--   rasterPos2v = glRasterPos2iv-   rasterPos3v = glRasterPos3iv-   rasterPos4v = glRasterPos4iv--instance RasterPosComponent GLfloat where-   rasterPos2 = glRasterPos2f-   rasterPos3 = glRasterPos3f-   rasterPos4 = glRasterPos4f--   rasterPos2v = glRasterPos2fv-   rasterPos3v = glRasterPos3fv-   rasterPos4v = glRasterPos4fv--instance RasterPosComponent GLdouble where-   rasterPos2 = glRasterPos2d-   rasterPos3 = glRasterPos3d-   rasterPos4 = glRasterPos4d--   rasterPos2v = glRasterPos2dv-   rasterPos3v = glRasterPos3dv-   rasterPos4v = glRasterPos4dv------------------------------------------------------------------------------------class RasterPos a where-   rasterPos  ::     a -> IO ()-   rasterPosv :: Ptr a -> IO ()--instance RasterPosComponent a => RasterPos (Vertex2 a) where-   rasterPos (Vertex2 x y) = rasterPos2 x y-   rasterPosv = rasterPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)--instance RasterPosComponent a => RasterPos (Vertex3 a) where-   rasterPos (Vertex3 x y z) = rasterPos3 x y z-   rasterPosv = rasterPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)--instance RasterPosComponent a => RasterPos (Vertex4 a) where-   rasterPos (Vertex4 x y z w) = rasterPos4 x y z w-   rasterPosv = rasterPos4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)------------------------------------------------------------------------------------class WindowPosComponent a where-   windowPos2 :: a -> a -> IO ()-   windowPos3 :: a -> a -> a -> IO ()--   windowPos2v :: Ptr a -> IO ()-   windowPos3v :: Ptr a -> IO ()--instance WindowPosComponent GLshort where-   windowPos2 = glWindowPos2s-   windowPos3 = glWindowPos3s--   windowPos2v = glWindowPos2sv-   windowPos3v = glWindowPos3sv--instance WindowPosComponent GLint where-   windowPos2 = glWindowPos2i-   windowPos3 = glWindowPos3i--   windowPos2v = glWindowPos2iv-   windowPos3v = glWindowPos3iv--instance WindowPosComponent GLfloat where-   windowPos2 = glWindowPos2f-   windowPos3 = glWindowPos3f--   windowPos2v = glWindowPos2fv-   windowPos3v = glWindowPos3fv--instance WindowPosComponent GLdouble where-   windowPos2 = glWindowPos2d-   windowPos3 = glWindowPos3d--   windowPos2v = glWindowPos2dv-   windowPos3v = glWindowPos3dv------------------------------------------------------------------------------------class WindowPos a where-   windowPos  ::     a -> IO ()-   windowPosv :: Ptr a -> IO ()--instance WindowPosComponent a => WindowPos (Vertex2 a) where-   windowPos (Vertex2 x y) = windowPos2 x y-   windowPosv = windowPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)--instance WindowPosComponent a => WindowPos (Vertex3 a) where-   windowPos (Vertex3 x y z) = windowPos3 x y z-   windowPosv = windowPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)------------------------------------------------------------------------------------currentRasterDistance :: GettableStateVar GLfloat-currentRasterDistance =-   makeGettableStateVar (getFloat1 id GetCurrentRasterDistance)--currentRasterColor :: GettableStateVar (Color4 GLfloat)-currentRasterColor =-   makeGettableStateVar (getFloat4 Color4 GetCurrentRasterColor)--currentRasterSecondaryColor :: GettableStateVar (Color4 GLfloat)-currentRasterSecondaryColor =-   makeGettableStateVar (getFloat4 Color4 GetCurrentRasterSecondaryColor)--currentRasterIndex :: GettableStateVar (Index1 GLint)-currentRasterIndex =-   makeGettableStateVar (getInteger1 Index1 GetCurrentRasterIndex)--currentRasterTexCoords :: GettableStateVar (TexCoord4 GLfloat)-currentRasterTexCoords =-   makeGettableStateVar (getFloat4 TexCoord4 GetCurrentRasterTextureCoords)--currentRasterPositionValid :: GettableStateVar Bool-currentRasterPositionValid =-   makeGettableStateVar-      (getBoolean1 unmarshalGLboolean GetCurrentRasterPositionValid)------------------------------------------------------------------------------------rasterPositionUnclipped :: StateVar Capability-rasterPositionUnclipped = makeCapability CapRasterPositionUnclipped
− Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs 
@@ -1,65 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.ReadCopyPixels--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 4.3 (Drawing, Reading, and Copying Pixels)--- of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.ReadCopyPixels (-   -- * Reading Pixels-   readPixels, readBuffer,--   -- * Copying Pixels-   PixelCopyType(..), copyPixels-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.BufferMode-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.PixelData-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glCopyPixels )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------readPixels :: Position -> Size -> PixelData a -> IO ()-readPixels (Position x y) (Size w h) pd =-   withPixelData pd $ glReadPixels x y w h------------------------------------------------------------------------------------readBuffer :: StateVar BufferMode-readBuffer =-   makeStateVar-      (getEnum1 unmarshalBufferMode GetReadBuffer)-      (maybe recordInvalidValue glReadBuffer . marshalBufferMode)------------------------------------------------------------------------------------data PixelCopyType =-     CopyColor-   | CopyDepth-   | CopyStencil-   deriving ( Eq, Ord, Show )--marshalPixelCopyType :: PixelCopyType -> GLenum-marshalPixelCopyType x = case x of-   CopyColor -> gl_COLOR-   CopyDepth -> gl_DEPTH-   CopyStencil -> gl_STENCIL------------------------------------------------------------------------------------copyPixels :: Position -> Size -> PixelCopyType -> IO ()-copyPixels (Position x y) (Size w h) t =-   glCopyPixels x y w h (marshalPixelCopyType t)
− Graphics/Rendering/OpenGL/GL/Rectangles.hs 
@@ -1,65 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Rectangles--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.10 (Rectangles) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Rectangles (-   Rect(..)-) where--import Data.Tensor-import Foreign.Ptr-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glRectd, glRectdv, glRectf, glRectfv, glRecti, glRectiv, glRects, glRectsv )-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | 'rect' and 'rectv' support efficient specification of rectangles as two--- corner points. Each rectangle command takes four arguments, organized either--- as two consecutive pairs of (/x/, /y/) coordinates, or as two pointers to--- arrays, each containing an (/x/, /y/) pair. The resulting rectangle is--- defined in the /z/ = 0 plane.------ @'rect' ('Vertex2' x1 y1) ('Vertex2' x2, y2)@ is exactly equivalent to the--- following sequence:------ @---    'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' 'Graphics.Rendering.OpenGL.GL.BeginEnd.Polygon' $ do---        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y1)---        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y1)---        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y2)---        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y2)--- @------ Note that if the second vertex is above and to the right of the first vertex,--- the rectangle is constructed with a counterclockwise winding.--class Rect a where-   rect  :: Vertex2 a -> Vertex2 a -> IO ()-   rectv :: Ptr     a -> Ptr     a -> IO ()--instance Rect GLshort where-   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRects x1 y1 x2 y2-   rectv ptr1 ptr2 = glRectsv ptr1 ptr2--instance Rect GLint where-   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRecti x1 y1 x2 y2-   rectv ptr1 ptr2 = glRectiv ptr1 ptr2--instance Rect GLfloat where-   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectf x1 y1 x2 y2-   rectv ptr1 ptr2 = glRectfv ptr1 ptr2--instance Rect GLdouble where-   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectd x1 y1 x2 y2-   rectv ptr1 ptr2 = glRectdv ptr1 ptr2
− Graphics/Rendering/OpenGL/GL/RenderMode.hs 
@@ -1,62 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.RenderMode--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module related to the current render mode.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.RenderMode (-   RenderMode(..), withRenderMode, renderMode-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glRenderMode, gl_FEEDBACK, gl_RENDER, gl_SELECT )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data RenderMode =-     Render-   | Feedback-   | Select-   deriving ( Eq, Ord, Show )--marshalRenderMode :: RenderMode -> GLenum-marshalRenderMode x = case x of-   Render -> gl_RENDER-   Feedback -> gl_FEEDBACK-   Select -> gl_SELECT--unmarshalRenderMode :: GLenum -> RenderMode-unmarshalRenderMode x-   | x == gl_RENDER = Render-   | x == gl_FEEDBACK = Feedback-   | x == gl_SELECT = Select-   | otherwise = error ("unmarshalRenderMode: illegal value " ++ show x)------------------------------------------------------------------------------------withRenderMode :: RenderMode -> IO a -> IO (a, GLint)-withRenderMode newMode action = do-   oldMode <- get renderMode-   _ <- setRenderMode newMode-   action `finallyRet` setRenderMode oldMode--setRenderMode :: RenderMode -> IO GLint-setRenderMode = glRenderMode . marshalRenderMode------------------------------------------------------------------------------------renderMode :: GettableStateVar RenderMode-renderMode = makeGettableStateVar $ getEnum1 unmarshalRenderMode GetRenderMode
− Graphics/Rendering/OpenGL/GL/SavingState.hs 
@@ -1,114 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.SavingState--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 6.1.14 (Saving and Restoring State) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.SavingState (-   ServerAttributeGroup(..), preservingAttrib,-   ClientAttributeGroup(..), preservingClientAttrib-) where--import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glPopAttrib, glPopClientAttrib, glPushAttrib, glPushClientAttrib,-   gl_ACCUM_BUFFER_BIT, gl_ALL_ATTRIB_BITS, gl_CLIENT_ALL_ATTRIB_BITS,-   gl_CLIENT_PIXEL_STORE_BIT, gl_CLIENT_VERTEX_ARRAY_BIT,-   gl_CURRENT_BIT, gl_ENABLE_BIT, gl_EVAL_BIT, gl_FOG_BIT,-   gl_HINT_BIT, gl_LIGHTING_BIT, gl_LINE_BIT, gl_LIST_BIT,-   gl_MULTISAMPLE_BIT, gl_PIXEL_MODE_BIT, gl_POINT_BIT,-   gl_POLYGON_BIT, gl_POLYGON_STIPPLE_BIT, gl_SCISSOR_BIT,-   gl_TEXTURE_BIT, gl_TRANSFORM_BIT, gl_VIEWPORT_BIT )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data ServerAttributeGroup =-     CurrentAttributes-   | PointAttributes-   | LineAttributes-   | PolygonAttributes-   | PolygonStippleAttributes-   | PixelModeAttributes-   | LightingAttributes-   | FogAttributes-   | DepthBufferAttributes-   | AccumBufferAttributes-   | StencilBufferAttributes-   | ViewportAttributes-   | TransformAttributes-   | EnableAttributes-   | ColorBufferAttributes-   | HintAttributes-   | EvalAttributes-   | ListAttributes-   | TextureAttributes-   | ScissorAttributes-   | MultisampleAttributes-   | AllServerAttributes-   deriving ( Eq, Ord, Show )--marshalServerAttributeGroup :: ServerAttributeGroup -> GLbitfield-marshalServerAttributeGroup x = fromIntegral $ case x of-   CurrentAttributes -> gl_CURRENT_BIT-   PointAttributes -> gl_POINT_BIT-   LineAttributes -> gl_LINE_BIT-   PolygonAttributes -> gl_POLYGON_BIT-   PolygonStippleAttributes -> gl_POLYGON_STIPPLE_BIT-   PixelModeAttributes -> gl_PIXEL_MODE_BIT-   LightingAttributes -> gl_LIGHTING_BIT-   FogAttributes -> gl_FOG_BIT-   DepthBufferAttributes -> gl_DEPTH_BUFFER_BIT-   AccumBufferAttributes -> gl_ACCUM_BUFFER_BIT-   StencilBufferAttributes -> gl_STENCIL_BUFFER_BIT-   ViewportAttributes -> gl_VIEWPORT_BIT-   TransformAttributes -> gl_TRANSFORM_BIT-   EnableAttributes -> gl_ENABLE_BIT-   ColorBufferAttributes -> gl_COLOR_BUFFER_BIT-   HintAttributes -> gl_HINT_BIT-   EvalAttributes -> gl_EVAL_BIT-   ListAttributes -> gl_LIST_BIT-   TextureAttributes -> gl_TEXTURE_BIT-   ScissorAttributes -> gl_SCISSOR_BIT-   MultisampleAttributes -> gl_MULTISAMPLE_BIT-   AllServerAttributes -> gl_ALL_ATTRIB_BITS------------------------------------------------------------------------------------preservingAttrib :: [ServerAttributeGroup] -> IO a -> IO a-preservingAttrib groups = bracket_ (pushAttrib groups) glPopAttrib--pushAttrib :: [ServerAttributeGroup] -> IO ()-pushAttrib = glPushAttrib . sum . map marshalServerAttributeGroup------------------------------------------------------------------------------------data ClientAttributeGroup =-     PixelStoreAttributes-   | VertexArrayAttributes-   | AllClientAttributes-   deriving ( Eq, Ord, Show )--marshalClientAttributeGroup :: ClientAttributeGroup -> GLbitfield-marshalClientAttributeGroup x = fromIntegral $ case x of-   PixelStoreAttributes -> gl_CLIENT_PIXEL_STORE_BIT-   VertexArrayAttributes -> gl_CLIENT_VERTEX_ARRAY_BIT-   AllClientAttributes -> gl_CLIENT_ALL_ATTRIB_BITS------------------------------------------------------------------------------------preservingClientAttrib :: [ClientAttributeGroup] -> IO a -> IO a-preservingClientAttrib groups =-   bracket_ (pushClientAttrib groups) glPopClientAttrib--pushClientAttrib :: [ClientAttributeGroup] -> IO ()-pushClientAttrib = glPushClientAttrib . sum . map marshalClientAttributeGroup
− Graphics/Rendering/OpenGL/GL/Selection.hs 
@@ -1,90 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Selection--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 5.2 (Selection) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Selection (-   HitRecord(..), getHitRecords,-   Name(..), withName, loadName, maxNameStackDepth, nameStackDepth,-   RenderMode(..), renderMode-) where--import Data.StateVar-import Foreign.Marshal.Array-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.IOState-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.RenderMode-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glSelectBuffer, glInitNames, glPushName, glPopName, glLoadName )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data HitRecord = HitRecord GLfloat GLfloat [Name]-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------getHitRecords :: GLsizei -> IO a -> IO (a, Maybe [HitRecord])-getHitRecords bufSize action =-   allocaArray (fromIntegral bufSize) $ \buf -> do-      glSelectBuffer bufSize buf-      (value, numHits) <- withRenderMode Select $ do-         glInitNames-         action-      hits <- parseSelectionBuffer numHits buf-      return (value, hits)------------------------------------------------------------------------------------parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])-parseSelectionBuffer numHits buf-   | numHits < 0 = return Nothing-   | otherwise = fmap Just $ evalIOState (nTimes numHits parseSelectionHit) buf--type Parser a = IOState GLuint a--parseSelectionHit :: Parser HitRecord-parseSelectionHit = do-   numNames <- parseGLuint-   minZ <- parseGLfloat-   maxZ <- parseGLfloat-   nameStack <- nTimes numNames parseName-   return $ HitRecord minZ maxZ nameStack--parseGLuint :: Parser GLuint-parseGLuint = peekIOState--parseGLfloat :: Parser GLfloat-parseGLfloat = fmap (\x -> fromIntegral x / 0xffffffff) parseGLuint--parseName :: Parser Name-parseName = fmap Name parseGLuint------------------------------------------------------------------------------------newtype Name = Name GLuint-   deriving ( Eq, Ord, Show )--withName :: Name -> IO a -> IO a-withName (Name name) = bracket_ (glPushName name) glPopName--loadName :: Name -> IO ()-loadName (Name n) = glLoadName n--maxNameStackDepth :: GettableStateVar GLsizei-maxNameStackDepth = makeGettableStateVar (getSizei1 id GetMaxNameStackDepth)--nameStackDepth :: GettableStateVar GLsizei-nameStackDepth = makeGettableStateVar (getSizei1 id GetNameStackDepth)
− Graphics/Rendering/OpenGL/GL/Shaders.hs 
@@ -1,703 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to sections 2.15 (Vertex Shaders) and section 3.11--- (Fragment Shaders) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Shaders (-   -- * Shader Objects-   Shader, VertexShader, FragmentShader, shaderDeleteStatus, shaderSource,-   compileShader, compileStatus, shaderInfoLog,--   -- * Program Objects-   Program, programDeleteStatus, attachedShaders, linkProgram, linkStatus,-   programInfoLog, validateProgram, validateStatus, currentProgram,--   -- * Vertex attributes-   attribLocation, VariableType(..), activeAttribs,--   -- * Uniform variables-   UniformLocation, uniformLocation, activeUniforms, Uniform(..),-   UniformComponent,--   -- * Implementation limits related to GLSL-   maxVertexTextureImageUnits, maxTextureImageUnits,-   maxCombinedTextureImageUnits, maxTextureCoords, maxVertexUniformComponents,-   maxFragmentUniformComponents, maxVertexAttribs, maxVaryingFloats-) where--import Control.Monad-import Control.Monad.Fix-import Data.List-import Data.ObjectName-import Data.StateVar-import Data.Tensor-import Foreign.C.String-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------type GLStringLen = (Ptr GLchar, GLsizei)--peekGLstringLen :: GLStringLen -> IO String-peekGLstringLen (p,l) = peekCAStringLen (castPtr p, fromIntegral l)--withGLStringLen :: String -> (GLStringLen -> IO a) -> IO a-withGLStringLen s act =-   withCAStringLen s $ \(p,len) ->-      act (castPtr p, fromIntegral len)--withGLString :: String -> (Ptr GLchar -> IO a) -> IO a-withGLString s act = withCAString s $ act . castPtr------------------------------------------------------------------------------------newtype VertexShader = VertexShader { vertexShaderID :: GLuint }-   deriving ( Eq, Ord, Show )--newtype FragmentShader = FragmentShader { fragmentShaderID :: GLuint }-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------class (Eq s, Ord s, Show s, ObjectName s) => Shader s where-   shaderID :: s -> GLuint-   makeShader :: GLuint -> s-   shaderType :: s -> GLenum--instance Shader VertexShader where-   makeShader = VertexShader-   shaderID = vertexShaderID-   shaderType = const gl_VERTEX_SHADER--instance Shader FragmentShader where-   makeShader = FragmentShader-   shaderID = fragmentShaderID-   shaderType = const gl_FRAGMENT_SHADER------------------------------------------------------------------------------------instance ObjectName VertexShader where-   genObjectNames = genShaderNames-   deleteObjectNames = deleteShaderNames-   isObjectName = isShaderName--instance ObjectName FragmentShader where-   genObjectNames = genShaderNames-   deleteObjectNames = deleteShaderNames-   isObjectName = isShaderName--genShaderNames :: Shader s => Int -> IO [s]-genShaderNames n = replicateM n createShader--createShader :: Shader s => IO s-createShader = mfix (fmap makeShader . glCreateShader . shaderType)--deleteShaderNames :: Shader s => [s] -> IO ()-deleteShaderNames = mapM_ (glDeleteShader . shaderID)--isShaderName :: Shader s => s -> IO Bool-isShaderName = fmap unmarshalGLboolean . glIsShader . shaderID------------------------------------------------------------------------------------compileShader :: Shader s => s -> IO ()-compileShader = glCompileShader . shaderID------------------------------------------------------------------------------------shaderSource :: Shader s => s -> StateVar [String]-shaderSource shader =-   makeStateVar (getShaderSource shader) (setShaderSource shader)--setShaderSource :: Shader s => s -> [String] -> IO ()-setShaderSource shader srcs = do-   let len = genericLength srcs-   withMany withGLStringLen srcs $ \charBufsAndLengths -> do-      let (charBufs, lengths) = unzip charBufsAndLengths-      withArray charBufs $ \charBufsBuf ->-         withArray (map fromIntegral lengths) $ \lengthsBuf ->-            glShaderSource (shaderID shader) len charBufsBuf lengthsBuf--getShaderSource :: Shader s => s -> IO [String]-getShaderSource shader = do-   src <- get (stringQuery (shaderSourceLength shader)-                           (glGetShaderSource (shaderID shader)))-   return [src]--stringQuery :: GettableStateVar GLsizei -> (GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()) -> GettableStateVar String-stringQuery lengthVar getStr =-   makeGettableStateVar $ do-      len <- get lengthVar -- Note: This includes the NUL character!-      if len == 0-        then return ""-        else allocaArray (fromIntegral len) $ \buf -> do-                getStr len nullPtr buf-                peekGLstringLen (buf, len-1)------------------------------------------------------------------------------------shaderInfoLog :: Shader s => s -> GettableStateVar String-shaderInfoLog shader =-   stringQuery (shaderInfoLogLength shader) (glGetShaderInfoLog (shaderID shader))------------------------------------------------------------------------------------shaderDeleteStatus :: Shader s => s -> GettableStateVar Bool-shaderDeleteStatus = shaderVar unmarshalGLboolean ShaderDeleteStatus--compileStatus :: Shader s => s -> GettableStateVar Bool-compileStatus = shaderVar unmarshalGLboolean CompileStatus--shaderInfoLogLength :: Shader s => s -> GettableStateVar GLsizei-shaderInfoLogLength = shaderVar fromIntegral ShaderInfoLogLength--shaderSourceLength :: Shader s => s -> GettableStateVar GLsizei-shaderSourceLength = shaderVar fromIntegral ShaderSourceLength--shaderTypeEnum :: Shader s => s -> GettableStateVar GLenum-shaderTypeEnum = shaderVar fromIntegral ShaderType------------------------------------------------------------------------------------data GetShaderPName =-     ShaderDeleteStatus-   | CompileStatus-   | ShaderInfoLogLength-   | ShaderSourceLength-   | ShaderType--marshalGetShaderPName :: GetShaderPName -> GLenum-marshalGetShaderPName x = case x of-   ShaderDeleteStatus -> gl_DELETE_STATUS-   CompileStatus -> gl_COMPILE_STATUS-   ShaderInfoLogLength -> gl_INFO_LOG_LENGTH-   ShaderSourceLength -> gl_SHADER_SOURCE_LENGTH-   ShaderType -> gl_SHADER_TYPE--shaderVar :: Shader s => (GLint -> a) -> GetShaderPName -> s -> GettableStateVar a-shaderVar f p shader =-   makeGettableStateVar $-      alloca $ \buf -> do-         glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf-         peek1 f buf------------------------------------------------------------------------------------newtype Program = Program { programID :: GLuint }-   deriving ( Eq, Ord, Show )--instance ObjectName Program where-   genObjectNames n = replicateM n $ fmap Program glCreateProgram-   deleteObjectNames = mapM_ (glDeleteProgram . programID)-   isObjectName = fmap unmarshalGLboolean . glIsProgram . programID------------------------------------------------------------------------------------attachedShaders :: Program -> StateVar ([VertexShader],[FragmentShader])-attachedShaders program =-   makeStateVar (getAttachedShaders program) (setAttachedShaders program)--getAttachedShaders :: Program -> IO ([VertexShader],[FragmentShader])-getAttachedShaders program = getAttachedShaderIDs program >>= splitShaderIDs--getAttachedShaderIDs :: Program -> IO [GLuint]-getAttachedShaderIDs program = do-   numShaders <- get (numAttachedShaders program)-   allocaArray (fromIntegral numShaders) $ \buf -> do-      glGetAttachedShaders (programID program) numShaders nullPtr buf-      peekArray (fromIntegral numShaders) buf--splitShaderIDs :: [GLuint] -> IO ([VertexShader],[FragmentShader])-splitShaderIDs ids = do-   (vs, fs) <- partitionM isVertexShaderID ids-   return (map VertexShader vs, map FragmentShader fs)--isVertexShaderID :: GLuint -> IO Bool-isVertexShaderID x = do-   t <- get (shaderTypeEnum (VertexShader x))-   return $ t == shaderType (undefined :: VertexShader)--partitionM :: (a -> IO Bool) -> [a] -> IO ([a],[a])-partitionM p = foldM select ([],[])-   where select (ts, fs) x = do-            b <- p x-            return $ if b then (x:ts, fs) else (ts, x:fs)--setAttachedShaders :: Program -> ([VertexShader],[FragmentShader]) -> IO ()-setAttachedShaders p@(Program program) (vs, fs) = do-   currentIDs <- getAttachedShaderIDs p-   let newIDs = map shaderID vs ++ map shaderID fs-   mapM_ (glAttachShader program) (newIDs \\ currentIDs)-   mapM_ (glDetachShader program) (currentIDs \\ newIDs)------------------------------------------------------------------------------------linkProgram :: Program -> IO ()-linkProgram (Program program) = glLinkProgram program--currentProgram :: StateVar (Maybe Program)-currentProgram =-   makeStateVar-      (do p <- getCurrentProgram-          return $ if p == noProgram then Nothing else Just p)-      ((\(Program p) -> glUseProgram p) . maybe noProgram id)--getCurrentProgram :: IO Program-getCurrentProgram = fmap Program $ getInteger1 fromIntegral GetCurrentProgram--noProgram :: Program-noProgram = Program 0--validateProgram :: Program -> IO ()-validateProgram (Program program) = glValidateProgram program--programInfoLog :: Program -> GettableStateVar String-programInfoLog p =-   stringQuery (programInfoLogLength p) (glGetProgramInfoLog (programID p))------------------------------------------------------------------------------------programDeleteStatus :: Program -> GettableStateVar Bool-programDeleteStatus = programVar unmarshalGLboolean ProgramDeleteStatus--linkStatus :: Program -> GettableStateVar Bool-linkStatus = programVar unmarshalGLboolean LinkStatus--validateStatus :: Program -> GettableStateVar Bool-validateStatus = programVar unmarshalGLboolean ValidateStatus--programInfoLogLength :: Program -> GettableStateVar GLsizei-programInfoLogLength = programVar fromIntegral ProgramInfoLogLength--numAttachedShaders :: Program -> GettableStateVar GLsizei-numAttachedShaders = programVar fromIntegral AttachedShaders--activeAttributes :: Program -> GettableStateVar GLuint-activeAttributes = programVar fromIntegral ActiveAttributes--activeAttributeMaxLength :: Program -> GettableStateVar GLsizei-activeAttributeMaxLength = programVar fromIntegral ActiveAttributeMaxLength--numActiveUniforms :: Program -> GettableStateVar GLuint-numActiveUniforms = programVar fromIntegral ActiveUniforms--activeUniformMaxLength :: Program -> GettableStateVar GLsizei-activeUniformMaxLength = programVar fromIntegral ActiveUniformMaxLength------------------------------------------------------------------------------------data GetProgramPName =-     ProgramDeleteStatus-   | LinkStatus-   | ValidateStatus-   | ProgramInfoLogLength-   | AttachedShaders-   | ActiveAttributes-   | ActiveAttributeMaxLength-   | ActiveUniforms-   | ActiveUniformMaxLength--marshalGetProgramPName :: GetProgramPName -> GLenum-marshalGetProgramPName x = case x of-   ProgramDeleteStatus -> gl_DELETE_STATUS-   LinkStatus -> gl_LINK_STATUS-   ValidateStatus -> gl_VALIDATE_STATUS-   ProgramInfoLogLength -> gl_INFO_LOG_LENGTH-   AttachedShaders -> gl_ATTACHED_SHADERS-   ActiveAttributes -> gl_ACTIVE_ATTRIBUTES-   ActiveAttributeMaxLength -> gl_ACTIVE_ATTRIBUTE_MAX_LENGTH-   ActiveUniforms -> gl_ACTIVE_UNIFORMS-   ActiveUniformMaxLength -> gl_ACTIVE_UNIFORM_MAX_LENGTH--programVar :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a-programVar f p program =-   makeGettableStateVar $-      alloca $ \buf -> do-         glGetProgramiv (programID program) (marshalGetProgramPName p) buf-         peek1 f buf------------------------------------------------------------------------------------attribLocation :: Program -> String -> StateVar AttribLocation-attribLocation program name =-   makeStateVar (getAttribLocation program name)-                (\location -> bindAttribLocation program location name)--getAttribLocation :: Program -> String -> IO AttribLocation-getAttribLocation (Program program) name =-   fmap (AttribLocation . fromIntegral) $-      withGLString name $-         glGetAttribLocation program--bindAttribLocation :: Program -> AttribLocation -> String -> IO ()-bindAttribLocation (Program program) (AttribLocation location) name =-   withGLString name $-      glBindAttribLocation program location-------------------------------------------------------------------------------------- Table 2.9 of the OpenGL 3.1 spec: OpenGL Shading Language type tokens-data VariableType =-     Float'-   | FloatVec2-   | FloatVec3-   | FloatVec4-   | Int'-   | IntVec2-   | IntVec3-   | IntVec4-   | UnsignedInt'-   | UnsignedIntVec2-   | UnsignedIntVec3-   | UnsignedIntVec4-   | Bool-   | BoolVec2-   | BoolVec3-   | BoolVec4-   | FloatMat2-   | FloatMat3-   | FloatMat4-   | FloatMat2x3-   | FloatMat2x4-   | FloatMat3x2-   | FloatMat3x4-   | FloatMat4x2-   | FloatMat4x3-   | Sampler1D-   | Sampler2D-   | Sampler3D-   | SamplerCube-   | Sampler1DShadow-   | Sampler2DShadow-   | Sampler1DArray-   | Sampler2DArray-   | Sampler1DArrayShadow-   | Sampler2DArrayShadow-   | SamplerCubeShadow-   | Sampler2DRect-   | Sampler2DRectShadow-   | IntSampler1D-   | IntSampler2D-   | IntSampler3D-   | IntSamplerCube-   | IntSampler1DArray-   | IntSampler2DArray-   | UnsignedIntSampler1D-   | UnsignedIntSampler2D-   | UnsignedIntSampler3D-   | UnsignedIntSamplerCube-   | UnsignedIntSampler1DArray-   | UnsignedIntSampler2DArray-   deriving ( Eq, Ord, Show )--unmarshalVariableType :: GLenum -> VariableType-unmarshalVariableType x-   | x == gl_FLOAT = Float'-   | x == gl_FLOAT_VEC2 = FloatVec2-   | x == gl_FLOAT_VEC3 = FloatVec3-   | x == gl_FLOAT_VEC4 = FloatVec4-   | x == gl_INT = Int'-   | x == gl_INT_VEC2 = IntVec2-   | x == gl_INT_VEC3 = IntVec3-   | x == gl_INT_VEC4 = IntVec4-   | x == gl_UNSIGNED_INT = UnsignedInt'-   | x == gl_UNSIGNED_INT_VEC2 = UnsignedIntVec2-   | x == gl_UNSIGNED_INT_VEC3 = UnsignedIntVec3-   | x == gl_UNSIGNED_INT_VEC4 = UnsignedIntVec4-   | x == gl_BOOL = Bool-   | x == gl_BOOL_VEC2 = BoolVec2-   | x == gl_BOOL_VEC3 = BoolVec3-   | x == gl_BOOL_VEC4 = BoolVec4-   | x == gl_FLOAT_MAT2 = FloatMat2-   | x == gl_FLOAT_MAT3 = FloatMat3-   | x == gl_FLOAT_MAT4 = FloatMat4-   | x == gl_FLOAT_MAT2x3 = FloatMat2x3-   | x == gl_FLOAT_MAT2x4 = FloatMat2x4-   | x == gl_FLOAT_MAT3x2 = FloatMat3x2-   | x == gl_FLOAT_MAT3x4 = FloatMat3x4-   | x == gl_FLOAT_MAT4x2 = FloatMat4x2-   | x == gl_FLOAT_MAT4x3 = FloatMat4x3-   | x == gl_SAMPLER_1D = Sampler1D-   | x == gl_SAMPLER_2D = Sampler2D-   | x == gl_SAMPLER_3D = Sampler3D-   | x == gl_SAMPLER_CUBE = SamplerCube-   | x == gl_SAMPLER_1D_SHADOW = Sampler1DShadow-   | x == gl_SAMPLER_2D_SHADOW = Sampler2DShadow-   | x == gl_SAMPLER_1D_ARRAY = Sampler1DArray-   | x == gl_SAMPLER_2D_ARRAY = Sampler2DArray-   | x == gl_SAMPLER_1D_ARRAY_SHADOW = Sampler1DArrayShadow-   | x == gl_SAMPLER_2D_ARRAY_SHADOW = Sampler2DArrayShadow-   | x == gl_SAMPLER_CUBE_SHADOW = SamplerCubeShadow-   | x == gl_SAMPLER_2D_RECT = Sampler2DRect-   | x == gl_SAMPLER_2D_RECT_SHADOW = Sampler2DRectShadow-   | x == gl_INT_SAMPLER_1D = IntSampler1D-   | x == gl_INT_SAMPLER_2D = IntSampler2D-   | x == gl_INT_SAMPLER_3D = IntSampler3D-   | x == gl_INT_SAMPLER_CUBE = IntSamplerCube-   | x == gl_INT_SAMPLER_1D_ARRAY = IntSampler1DArray-   | x == gl_INT_SAMPLER_2D_ARRAY = IntSampler2DArray-   | x == gl_UNSIGNED_INT_SAMPLER_1D = UnsignedIntSampler1D-   | x == gl_UNSIGNED_INT_SAMPLER_2D = UnsignedIntSampler2D-   | x == gl_UNSIGNED_INT_SAMPLER_3D = UnsignedIntSampler3D-   | x == gl_UNSIGNED_INT_SAMPLER_CUBE = UnsignedIntSamplerCube-   | x == gl_UNSIGNED_INT_SAMPLER_1D_ARRAY = UnsignedIntSampler1DArray-   | x == gl_UNSIGNED_INT_SAMPLER_2D_ARRAY = UnsignedIntSampler2DArray-   | otherwise = error ("unmarshalVariableType: illegal value " ++ show x)------------------------------------------------------------------------------------activeVars :: (Program -> GettableStateVar GLuint)-           -> (Program -> GettableStateVar GLsizei)-           -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())-           -> Program -> GettableStateVar [(GLint,VariableType,String)]-activeVars numVars maxLength getter p@(Program program) =-   makeGettableStateVar $ do-      numActiveVars <- get (numVars p)-      maxLen <- get (maxLength p)-      allocaArray (fromIntegral maxLen) $ \nameBuf ->-         alloca $ \nameLengthBuf ->-            alloca $ \sizeBuf ->-               alloca $ \typeBuf ->-                  flip mapM [0 .. numActiveVars - 1] $ \i -> do-                    getter program i maxLen nameLengthBuf sizeBuf typeBuf nameBuf-                    l <- peek nameLengthBuf-                    s <- peek sizeBuf-                    t <- peek typeBuf-                    n <- peekGLstringLen (nameBuf, l)-                    return (s, unmarshalVariableType t, n)--activeAttribs :: Program -> GettableStateVar [(GLint,VariableType,String)]-activeAttribs = activeVars activeAttributes activeAttributeMaxLength glGetActiveAttrib------------------------------------------------------------------------------------newtype UniformLocation = UniformLocation GLint-   deriving ( Eq, Ord, Show )--uniformLocation :: Program -> String -> GettableStateVar UniformLocation-uniformLocation (Program program) name =-   makeGettableStateVar $-      fmap UniformLocation $-         withGLString name $-            glGetUniformLocation program------------------------------------------------------------------------------------activeUniforms :: Program -> GettableStateVar [(GLint,VariableType,String)]-activeUniforms = activeVars numActiveUniforms activeUniformMaxLength glGetActiveUniform------------------------------------------------------------------------------------class Storable a => UniformComponent a where-   uniform1 :: UniformLocation -> a -> IO ()-   uniform2 :: UniformLocation -> a -> a -> IO ()-   uniform3 :: UniformLocation -> a -> a -> a -> IO ()-   uniform4 :: UniformLocation -> a -> a -> a -> a -> IO ()--   getUniform :: Storable (b a) => Program -> UniformLocation -> Ptr (b a) -> IO ()--   uniform1v :: UniformLocation -> GLsizei -> Ptr a -> IO ()-   uniform2v :: UniformLocation -> GLsizei -> Ptr a -> IO ()-   uniform3v :: UniformLocation -> GLsizei -> Ptr a -> IO ()-   uniform4v :: UniformLocation -> GLsizei -> Ptr a -> IO ()--instance UniformComponent GLint where-   uniform1 (UniformLocation ul) = glUniform1i ul-   uniform2 (UniformLocation ul) = glUniform2i ul-   uniform3 (UniformLocation ul) = glUniform3i ul-   uniform4 (UniformLocation ul) = glUniform4i ul--   getUniform (Program p) (UniformLocation ul) = glGetUniformiv p ul . castPtr--   uniform1v (UniformLocation ul) = glUniform1iv ul-   uniform2v (UniformLocation ul) = glUniform2iv ul-   uniform3v (UniformLocation ul) = glUniform3iv ul-   uniform4v (UniformLocation ul) = glUniform4iv ul--instance UniformComponent GLuint where-   uniform1 (UniformLocation ul) = glUniform1ui ul-   uniform2 (UniformLocation ul) = glUniform2ui ul-   uniform3 (UniformLocation ul) = glUniform3ui ul-   uniform4 (UniformLocation ul) = glUniform4ui ul--   getUniform (Program p) (UniformLocation ul) = glGetUniformuiv p ul . castPtr--   uniform1v (UniformLocation ul) = glUniform1uiv ul-   uniform2v (UniformLocation ul) = glUniform2uiv ul-   uniform3v (UniformLocation ul) = glUniform3uiv ul-   uniform4v (UniformLocation ul) = glUniform4uiv ul--instance UniformComponent GLfloat where-   uniform1 (UniformLocation ul) = glUniform1f ul-   uniform2 (UniformLocation ul) = glUniform2f ul-   uniform3 (UniformLocation ul) = glUniform3f ul-   uniform4 (UniformLocation ul) = glUniform4f ul--   getUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr--   uniform1v (UniformLocation ul) = glUniform1fv ul-   uniform2v (UniformLocation ul) = glUniform2fv ul-   uniform3v (UniformLocation ul) = glUniform3fv ul-   uniform4v (UniformLocation ul) = glUniform4fv ul--instance UniformComponent GLclampf where-   uniform1 (UniformLocation ul) x = glUniform1f ul (realToFrac x)-   uniform2 (UniformLocation ul) x y = glUniform2f ul (realToFrac x) (realToFrac y)-   uniform3 (UniformLocation ul) x y z = glUniform3f ul (realToFrac x) (realToFrac y) (realToFrac z)-   uniform4 (UniformLocation ul) x y z w = glUniform4f ul (realToFrac x) (realToFrac y) (realToFrac z) (realToFrac w)--   getUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr--   uniform1v (UniformLocation ul) n = glUniform1fv ul n . castPtr-   uniform2v (UniformLocation ul) n = glUniform2fv ul n . castPtr-   uniform3v (UniformLocation ul) n = glUniform3fv ul n . castPtr-   uniform4v (UniformLocation ul) n = glUniform4fv ul n . castPtr------------------------------------------------------------------------------------class Uniform a where-   uniform :: UniformLocation -> StateVar a-   uniformv :: UniformLocation -> GLsizei -> Ptr a -> IO ()--maxComponentSize :: Int-maxComponentSize = sizeOf (undefined :: GLint) `max` sizeOf (undefined :: GLfloat)--maxNumComponents :: Int-maxNumComponents = 16--maxUniformBufferSize :: Int-maxUniformBufferSize = maxComponentSize * maxNumComponents--makeUniformVar :: (UniformComponent a, Storable (b a))-               => (UniformLocation -> b a -> IO ())-               -> UniformLocation -> StateVar (b a)-makeUniformVar setter location = makeStateVar getter (setter location)-   where getter = do-            program <- getCurrentProgram-            allocaBytes maxUniformBufferSize  $ \buf -> do-            getUniform program location buf-            peek buf--instance UniformComponent a => Uniform (Vertex2 a) where-   uniform = makeUniformVar $ \location (Vertex2 x y) -> uniform2 location x y-   uniformv location count = uniform2v location count . (castPtr :: Ptr (Vertex2 b) -> Ptr b)--instance UniformComponent a => Uniform (Vertex3 a) where-   uniform = makeUniformVar $ \location (Vertex3 x y z) -> uniform3 location x y z-   uniformv location count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b)--instance UniformComponent a => Uniform (Vertex4 a) where-   uniform = makeUniformVar $ \location (Vertex4 x y z w) -> uniform4 location x y z w-   uniformv location count = uniform4v location count . (castPtr :: Ptr (Vertex4 b) -> Ptr b)--instance UniformComponent a => Uniform (TexCoord1 a) where-   uniform = makeUniformVar $ \location (TexCoord1 s) -> uniform1 location s-   uniformv location count = uniform1v location count . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)--instance UniformComponent a => Uniform (TexCoord2 a) where-   uniform = makeUniformVar $ \location (TexCoord2 s t) -> uniform2 location s t-   uniformv location count = uniform2v location count . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)--instance UniformComponent a => Uniform (TexCoord3 a) where-   uniform = makeUniformVar $ \location (TexCoord3 s t r) -> uniform3 location s t  r-   uniformv location count = uniform3v location count . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)--instance UniformComponent a => Uniform (TexCoord4 a) where-   uniform = makeUniformVar $ \location (TexCoord4 s t r q) -> uniform4 location s t  r q-   uniformv location count = uniform4v location count . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)--instance UniformComponent a => Uniform (Normal3 a) where-   uniform = makeUniformVar $ \location (Normal3 x y z) -> uniform3 location x y z-   uniformv location count = uniform3v location count . (castPtr :: Ptr (Normal3 b) -> Ptr b)--instance UniformComponent a => Uniform (FogCoord1 a) where-   uniform = makeUniformVar $ \location (FogCoord1 c) -> uniform1 location c-   uniformv location count = uniform1v location count . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)--instance UniformComponent a => Uniform (Color3 a) where-   uniform = makeUniformVar $ \location (Color3 r g b) -> uniform3 location r g b-   uniformv location count = uniform3v location count . (castPtr :: Ptr (Color3 b) -> Ptr b)--instance UniformComponent a => Uniform (Color4 a) where-   uniform = makeUniformVar $ \location (Color4 r g b a) -> uniform4 location r g b a-   uniformv location count = uniform4v location count . (castPtr :: Ptr (Color4 b) -> Ptr b)--instance UniformComponent a => Uniform (Index1 a) where-   uniform = makeUniformVar $ \location (Index1 i) -> uniform1 location i-   uniformv location count = uniform1v location count . (castPtr :: Ptr (Index1 b) -> Ptr b)-------------------------------------------------------------------------------------- | Contains the number of hardware units that can be used to access texture--- maps from the vertex processor. The minimum legal value is 0.--maxVertexTextureImageUnits :: GettableStateVar GLsizei-maxVertexTextureImageUnits = getLimit GetMaxVertexTextureImageUnits---- | Contains the total number of hardware units that can be used to access--- texture maps from the fragment processor. The minimum legal value is 2.--maxTextureImageUnits :: GettableStateVar GLsizei-maxTextureImageUnits = getLimit GetMaxTextureImageUnits---- | Contains the total number of hardware units that can be used to access--- texture maps from the vertex processor and the fragment processor combined.--- Note: If the vertex shader and the fragment processing stage access the same--- texture image unit, then that counts as using two texture image units. The--- minimum legal value is 2.--maxCombinedTextureImageUnits :: GettableStateVar GLsizei-maxCombinedTextureImageUnits = getLimit GetMaxCombinedTextureImageUnits---- | Contains the number of texture coordinate sets that are available. The--- minimum legal value is 2.--maxTextureCoords :: GettableStateVar GLsizei-maxTextureCoords = getLimit GetMaxTextureCoords---- | Contains the number of individual components (i.e., floating-point, integer--- or boolean values) that are available for vertex shader uniform variables.--- The minimum legal value is 512.-maxVertexUniformComponents :: GettableStateVar GLsizei-maxVertexUniformComponents = getLimit GetMaxVertexUniformComponents---- | Contains the number of individual components (i.e., floating-point, integer--- or boolean values) that are available for fragment shader uniform variables.--- The minimum legal value is 64.--maxFragmentUniformComponents :: GettableStateVar GLsizei-maxFragmentUniformComponents = getLimit GetMaxFragmentUniformComponents---- | Contains the number of active vertex attributes that are available. The--- minimum legal value is 16.--maxVertexAttribs :: GettableStateVar GLsizei-maxVertexAttribs = getLimit GetMaxVertexAttribs---- | Contains the number of individual floating-point values available for--- varying variables. The minimum legal value is 32.--maxVaryingFloats :: GettableStateVar GLsizei-maxVaryingFloats = getLimit GetMaxVaryingFloats--getLimit :: GetPName -> GettableStateVar GLsizei-getLimit = makeGettableStateVar . getSizei1 id
− Graphics/Rendering/OpenGL/GL/StringQueries.hs 
@@ -1,88 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.StringQueries--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to parts of section 6.1.5 (String Queries) of the--- OpenGL 3.2 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.StringQueries (-   vendor, renderer, glVersion, glExtensions, shadingLanguageVersion,-   majorMinor, contextProfile-) where--import Data.Bits-import Data.Char-import Data.StateVar-import Foreign.C.String-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.Core32------------------------------------------------------------------------------------vendor :: GettableStateVar String-vendor = makeGettableStateVar (getString gl_VENDOR)--renderer :: GettableStateVar String-renderer = makeGettableStateVar (getString gl_RENDERER)--glVersion :: GettableStateVar String-glVersion = makeGettableStateVar (getString gl_VERSION)--glExtensions :: GettableStateVar [String]-glExtensions = makeGettableStateVar (fmap words $ getString gl_EXTENSIONS)--shadingLanguageVersion :: GettableStateVar String-shadingLanguageVersion = makeGettableStateVar (getString gl_SHADING_LANGUAGE_VERSION)------------------------------------------------------------------------------------data ContextProfile'-   = CoreProfile'-   | CompatibilityProfile'-   deriving ( Eq, Ord, Show )--marshalContextProfile' :: ContextProfile' -> GLenum-marshalContextProfile' x = case x of-   CoreProfile' -> gl_CONTEXT_CORE_PROFILE_BIT-   CompatibilityProfile' -> gl_CONTEXT_COMPATIBILITY_PROFILE_BIT--contextProfile :: GettableStateVar [ContextProfile']-contextProfile = makeGettableStateVar (getEnum1 i2cps GetContextProfileMask)--i2cps :: GLenum -> [ContextProfile']-i2cps bitfield =-   [ c | c <- [ CoreProfile', CompatibilityProfile' ]-       , (bitfield .&. marshalContextProfile' c) /= 0 ]------------------------------------------------------------------------------------getString :: GLenum -> IO String-getString n = glGetString n >>= maybeNullPtr (return "") (peekCString . castPtr)-------------------------------------------------------------------------------------- | A utility function to be used with e.g. 'glVersion' or--- 'shadingLanguageVersion', transforming a variable containing a string of the--- form /major.minor[optional rest]/ into a variable containing a numeric--- major\/minor version. If the string is malformed, which should never happen--- with a sane OpenGL implementation, it is transformed to @(-1,-1)@.--majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)-majorMinor = makeGettableStateVar . fmap parse . get-   where defaultVersion = (-1, -1)-         parse str =-            case span isDigit str of-               (major@(_:_), '.':rest) ->-                  case span isDigit rest of-                     (minor@(_:_), _) -> (read major, read minor)-                     _ -> defaultVersion-               _ -> defaultVersion
− Graphics/Rendering/OpenGL/GL/Texturing.hs 
@@ -1,29 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.8 (Texturing) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing (-   module Graphics.Rendering.OpenGL.GL.Texturing.Specification,-   module Graphics.Rendering.OpenGL.GL.Texturing.Parameters,-   module Graphics.Rendering.OpenGL.GL.Texturing.Objects,-   module Graphics.Rendering.OpenGL.GL.Texturing.Environments,-   module Graphics.Rendering.OpenGL.GL.Texturing.Application,-   module Graphics.Rendering.OpenGL.GL.Texturing.Queries-) where--import Graphics.Rendering.OpenGL.GL.Texturing.Specification-import Graphics.Rendering.OpenGL.GL.Texturing.Parameters-import Graphics.Rendering.OpenGL.GL.Texturing.Objects-import Graphics.Rendering.OpenGL.GL.Texturing.Environments-import Graphics.Rendering.OpenGL.GL.Texturing.Application-import Graphics.Rendering.OpenGL.GL.Texturing.Queries
− Graphics/Rendering/OpenGL/GL/Texturing/Application.hs 
@@ -1,36 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Application--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.8.15 (Texture Application) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.Application (-   texture-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.Texturing.Specification-------------------------------------------------------------------------------------- ToDo: cube maps-texture :: TextureTarget -> StateVar Capability-texture = makeCapability . textureTargetToEnableCap--textureTargetToEnableCap :: TextureTarget -> EnableCap-textureTargetToEnableCap x = case x of-    Texture1D -> CapTexture1D-    Texture2D -> CapTexture2D-    Texture3D -> CapTexture3D-    TextureCubeMap -> CapTextureCubeMap-    TextureRectangle -> CapTextureRectangle
− Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs 
@@ -1,366 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Environments--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.8.13 (Texture Environments and Texture--- Functions) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.Environments (-   TextureFunction(..), textureFunction,-   TextureCombineFunction(..), combineRGB, combineAlpha,-   ArgNum(..), Arg(..), Src(..), argRGB, argAlpha,-   rgbScale, alphaScale,-   constantColor, textureUnitLODBias-) where--import Control.Monad-import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.BlendingFactor-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.Texturing.Parameters-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glGetTexEnvfv, glGetTexEnviv, glTexEnvf, glTexEnvfv, glTexEnvi, gl_ADD,-   gl_ADD_SIGNED, gl_ALPHA_SCALE, gl_COMBINE, gl_COMBINE_ALPHA, gl_COMBINE_RGB,-   gl_CONSTANT, gl_DECAL, gl_DOT3_RGB, gl_DOT3_RGBA, gl_INTERPOLATE,-   gl_MODULATE, gl_OPERAND0_ALPHA, gl_OPERAND0_RGB, gl_OPERAND1_ALPHA,-   gl_OPERAND1_RGB, gl_OPERAND2_ALPHA, gl_OPERAND2_RGB, gl_POINT_SPRITE,-   gl_PREVIOUS, gl_PRIMARY_COLOR, gl_RGB_SCALE, gl_SRC0_ALPHA, gl_SRC0_RGB,-   gl_SRC1_ALPHA, gl_SRC1_RGB, gl_SRC2_ALPHA, gl_SRC2_RGB, gl_SUBTRACT,-   gl_TEXTURE_ENV, gl_TEXTURE_ENV_COLOR, gl_TEXTURE_ENV_MODE,-   gl_TEXTURE_FILTER_CONTROL )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.NV.TextureEnvCombine4 (-   gl_COMBINE4, gl_OPERAND3_ALPHA, gl_OPERAND3_RGB, gl_SOURCE3_ALPHA,-   gl_SOURCE3_RGB )------------------------------------------------------------------------------------data TextureEnvTarget =-     TextureEnv-   | TextureFilterControl   -- GL_TEXTURE_LOD_BIAS_EXT-   | PointSprite            -- GL_COORD_REPLACE_NV--marshalTextureEnvTarget :: TextureEnvTarget -> GLenum-marshalTextureEnvTarget x = case x of-   TextureEnv -> gl_TEXTURE_ENV-   TextureFilterControl -> gl_TEXTURE_FILTER_CONTROL-   PointSprite -> gl_POINT_SPRITE------------------------------------------------------------------------------------data TextureEnvParameter =-     TexEnvParamTextureEnvMode-   | TexEnvParamTextureEnvColor-   | TexEnvParamCombineRGB-   | TexEnvParamCombineAlpha-   | TexEnvParamSrc0RGB-   | TexEnvParamSrc1RGB-   | TexEnvParamSrc2RGB-   | TexEnvParamSrc3RGB-   | TexEnvParamSrc0Alpha-   | TexEnvParamSrc1Alpha-   | TexEnvParamSrc2Alpha-   | TexEnvParamSrc3Alpha-   | TexEnvParamOperand0RGB-   | TexEnvParamOperand1RGB-   | TexEnvParamOperand2RGB-   | TexEnvParamOperand3RGB-   | TexEnvParamOperand0Alpha-   | TexEnvParamOperand1Alpha-   | TexEnvParamOperand2Alpha-   | TexEnvParamOperand3Alpha-   | TexEnvParamRGBScale-   | TexEnvParamAlphaScale-   | TexEnvParamLODBias--marshalTextureEnvParameter :: TextureEnvParameter -> GLenum-marshalTextureEnvParameter x = case x of-   TexEnvParamTextureEnvMode -> gl_TEXTURE_ENV_MODE-   TexEnvParamTextureEnvColor -> gl_TEXTURE_ENV_COLOR-   TexEnvParamCombineRGB -> gl_COMBINE_RGB-   TexEnvParamCombineAlpha -> gl_COMBINE_ALPHA-   TexEnvParamSrc0RGB -> gl_SRC0_RGB-   TexEnvParamSrc1RGB -> gl_SRC1_RGB-   TexEnvParamSrc2RGB -> gl_SRC2_RGB-   TexEnvParamSrc3RGB -> gl_SOURCE3_RGB-   TexEnvParamSrc0Alpha -> gl_SRC0_ALPHA-   TexEnvParamSrc1Alpha -> gl_SRC1_ALPHA-   TexEnvParamSrc2Alpha -> gl_SRC2_ALPHA-   TexEnvParamSrc3Alpha -> gl_SOURCE3_ALPHA-   TexEnvParamOperand0RGB -> gl_OPERAND0_RGB-   TexEnvParamOperand1RGB -> gl_OPERAND1_RGB-   TexEnvParamOperand2RGB -> gl_OPERAND2_RGB-   TexEnvParamOperand3RGB -> gl_OPERAND3_RGB-   TexEnvParamOperand0Alpha -> gl_OPERAND0_ALPHA-   TexEnvParamOperand1Alpha -> gl_OPERAND1_ALPHA-   TexEnvParamOperand2Alpha -> gl_OPERAND2_ALPHA-   TexEnvParamOperand3Alpha -> gl_OPERAND3_ALPHA-   TexEnvParamRGBScale -> gl_RGB_SCALE-   TexEnvParamAlphaScale -> gl_ALPHA_SCALE-   TexEnvParamLODBias -> gl_TEXTURE_LOD_BIAS------------------------------------------------------------------------------------texEnv :: (GLenum -> GLenum -> b -> IO ())-       -> (a -> (b -> IO ()) -> IO ())-       -> TextureEnvTarget -> TextureEnvParameter -> a -> IO ()-texEnv glTexEnv marshalAct t p x =-   marshalAct x $-      glTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p)--glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glTexEnvC4f t p ptr = glTexEnvfv t p (castPtr ptr)-------------------------------------------------------------------------------------getTexEnv :: Storable b-          => (GLenum -> GLenum -> Ptr b -> IO ())-          -> (b -> a)-          -> TextureEnvTarget -> TextureEnvParameter -> IO a-getTexEnv glGetTexEnv unmarshal t p =-   alloca $ \buf -> do-     glGetTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p) buf-     peek1 unmarshal buf--glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glGetTexEnvC4f t p ptr = glGetTexEnvfv t p (castPtr ptr)------------------------------------------------------------------------------------m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()-m2a marshal x act = act (marshal x)--texEnvi ::-   (GLint -> a) -> (a -> GLint) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a-texEnvi unmarshal marshal t p =-   makeStateVar-      (getTexEnv glGetTexEnviv unmarshal     t p)-      (texEnv    glTexEnvi     (m2a marshal) t p)--texEnvf ::-   (GLfloat -> a) -> (a -> GLfloat) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a-texEnvf unmarshal marshal t p =-   makeStateVar-      (getTexEnv glGetTexEnvfv unmarshal     t p)-      (texEnv    glTexEnvf     (m2a marshal) t p)--texEnvC4f :: TextureEnvTarget -> TextureEnvParameter -> StateVar (Color4 GLfloat)-texEnvC4f t p =-   makeStateVar-      (getTexEnv glGetTexEnvC4f id   t p)-      (texEnv    glTexEnvC4f    with t p)------------------------------------------------------------------------------------data TextureFunction =-     Modulate-   | Decal-   | Blend-   | Replace-   | AddUnsigned-   | Combine-   | Combine4-   deriving ( Eq, Ord, Show )--marshalTextureFunction :: TextureFunction -> GLint-marshalTextureFunction x = fromIntegral $ case x of-   Modulate -> gl_MODULATE-   Decal -> gl_DECAL-   Blend -> gl_BLEND-   Replace -> gl_REPLACE-   AddUnsigned -> gl_ADD-   Combine -> gl_COMBINE-   Combine4 -> gl_COMBINE4--unmarshalTextureFunction :: GLint -> TextureFunction-unmarshalTextureFunction x-   | y == gl_MODULATE = Modulate-   | y == gl_DECAL = Decal-   | y == gl_BLEND = Blend-   | y == gl_REPLACE = Replace-   | y == gl_ADD = AddUnsigned-   | y == gl_COMBINE = Combine-   | y == gl_COMBINE4 = Combine4-   | otherwise = error ("unmarshalTextureFunction: illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------textureFunction :: StateVar TextureFunction-textureFunction =-   texEnvi unmarshalTextureFunction marshalTextureFunction TextureEnv TexEnvParamTextureEnvMode------------------------------------------------------------------------------------data TextureCombineFunction =-     Replace'-   | Modulate'-   | AddUnsigned'-   | AddSigned-   | Interpolate-   | Subtract-   | Dot3RGB-   | Dot3RGBA-   deriving ( Eq, Ord, Show )--marshalTextureCombineFunction :: TextureCombineFunction -> GLint-marshalTextureCombineFunction x = fromIntegral $ case x of-   Replace' -> gl_REPLACE-   Modulate' -> gl_MODULATE-   AddUnsigned' -> gl_ADD-   AddSigned -> gl_ADD_SIGNED-   Interpolate -> gl_INTERPOLATE-   Subtract -> gl_SUBTRACT-   Dot3RGB -> gl_DOT3_RGB-   Dot3RGBA -> gl_DOT3_RGBA--unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction-unmarshalTextureCombineFunction x-   | y == gl_REPLACE = Replace'-   | y == gl_MODULATE = Modulate'-   | y == gl_ADD = AddUnsigned'-   | y == gl_ADD_SIGNED = AddSigned-   | y == gl_INTERPOLATE = Interpolate-   | y == gl_SUBTRACT = Subtract-   | y == gl_DOT3_RGB = Dot3RGB-   | y == gl_DOT3_RGBA = Dot3RGBA-   | otherwise = error ("unmarshalTextureCombineFunction: illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------combineRGB :: StateVar TextureCombineFunction-combineRGB = combine TexEnvParamCombineRGB--combineAlpha :: StateVar TextureCombineFunction-combineAlpha = combine TexEnvParamCombineAlpha--combine :: TextureEnvParameter -> StateVar TextureCombineFunction-combine =-   texEnvi unmarshalTextureCombineFunction marshalTextureCombineFunction TextureEnv------------------------------------------------------------------------------------data ArgNum =-     Arg0-   | Arg1-   | Arg2-   | Arg3-   deriving ( Eq, Ord, Show )--argNumToOperandRGB :: ArgNum -> TextureEnvParameter-argNumToOperandRGB x = case x of-   Arg0 -> TexEnvParamOperand0RGB-   Arg1 -> TexEnvParamOperand1RGB-   Arg2 -> TexEnvParamOperand2RGB-   Arg3 -> TexEnvParamOperand3RGB--argNumToOperandAlpha :: ArgNum -> TextureEnvParameter-argNumToOperandAlpha x = case x of-   Arg0 -> TexEnvParamOperand0Alpha-   Arg1 -> TexEnvParamOperand1Alpha-   Arg2 -> TexEnvParamOperand2Alpha-   Arg3 -> TexEnvParamOperand3Alpha--argNumToSrcRGB :: ArgNum -> TextureEnvParameter-argNumToSrcRGB x = case x of-   Arg0 -> TexEnvParamSrc0RGB-   Arg1 -> TexEnvParamSrc1RGB-   Arg2 -> TexEnvParamSrc2RGB-   Arg3 -> TexEnvParamSrc3RGB--argNumToSrcAlpha :: ArgNum -> TextureEnvParameter-argNumToSrcAlpha x = case x of-   Arg0 -> TexEnvParamSrc0Alpha-   Arg1 -> TexEnvParamSrc1Alpha-   Arg2 -> TexEnvParamSrc2Alpha-   Arg3 -> TexEnvParamSrc3Alpha------------------------------------------------------------------------------------data Arg = Arg BlendingFactor Src-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------data Src =-     CurrentUnit-   | Previous-   | Crossbar TextureUnit-   | Constant-   | PrimaryColor-   deriving ( Eq, Ord, Show )--marshalSrc :: Src -> GLint-marshalSrc x = fromIntegral $ case x of-   CurrentUnit -> gl_TEXTURE-   Previous -> gl_PREVIOUS-   Crossbar u -> fromIntegral (marshalTextureUnit u)-   Constant -> gl_CONSTANT-   PrimaryColor -> gl_PRIMARY_COLOR--unmarshalSrc :: GLint -> Src-unmarshalSrc x-   | y == gl_TEXTURE = CurrentUnit-   | y == gl_PREVIOUS = Previous-   | y == gl_CONSTANT = Constant-   | y == gl_PRIMARY_COLOR = PrimaryColor-   | otherwise = Crossbar (unmarshalTextureUnit (fromIntegral x))-   where y = fromIntegral x------------------------------------------------------------------------------------argRGB :: ArgNum -> StateVar Arg-argRGB n = arg (argNumToOperandRGB n) (argNumToSrcRGB n)--argAlpha :: ArgNum -> StateVar Arg-argAlpha n = arg (argNumToOperandAlpha n) (argNumToSrcAlpha n)--arg :: TextureEnvParameter -> TextureEnvParameter -> StateVar Arg-arg op src = combineArg (textureEnvOperand op) (textureEnvSrc src)-   where combineArg v w = makeStateVar-                             (liftM2 Arg (get v) (get w))-                             (\(Arg x y) -> do v $= x; w $= y)--textureEnvOperand :: TextureEnvParameter -> StateVar BlendingFactor-textureEnvOperand =-   texEnvi (unmarshalBlendingFactor . fromIntegral) (fromIntegral . marshalBlendingFactor) TextureEnv--textureEnvSrc :: TextureEnvParameter -> StateVar Src-textureEnvSrc = texEnvi unmarshalSrc marshalSrc TextureEnv------------------------------------------------------------------------------------rgbScale :: StateVar GLfloat-rgbScale = scale TexEnvParamRGBScale--alphaScale :: StateVar GLfloat-alphaScale = scale TexEnvParamAlphaScale--scale :: TextureEnvParameter -> StateVar GLfloat-scale = texEnvf id id TextureEnv------------------------------------------------------------------------------------constantColor :: StateVar (Color4 GLfloat)-constantColor = texEnvC4f TextureEnv TexEnvParamTextureEnvColor------------------------------------------------------------------------------------textureUnitLODBias :: StateVar LOD-textureUnitLODBias = texEnvf id id TextureFilterControl TexEnvParamLODBias
− Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs 
@@ -1,104 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Objects--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.8.12 (Texture Objects) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.Objects (-   TextureObject(TextureObject), textureBinding,-   textureResident, areTexturesResident,-   TexturePriority, texturePriority, prioritizeTextures-) where--import Data.List-import Data.ObjectName-import Data.StateVar-import Foreign.Marshal.Array-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (- glAreTexturesResident, glPrioritizeTextures )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------newtype TextureObject = TextureObject { textureID :: GLuint }-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------instance ObjectName TextureObject where-   genObjectNames n =-      allocaArray n $ \buf -> do-        glGenTextures (fromIntegral n) buf-        fmap (map TextureObject) $ peekArray n buf--   deleteObjectNames textureObjects =-      withArrayLen (map textureID textureObjects) $-         glDeleteTextures . fromIntegral--   isObjectName = fmap unmarshalGLboolean . glIsTexture . textureID------------------------------------------------------------------------------------textureBinding :: TextureTarget -> StateVar (Maybe TextureObject)-textureBinding t =-   makeStateVar-      (do o <- getEnum1 (TextureObject . fromIntegral) (textureTargetToGetPName t)-          return $ if o == defaultTextureObject then Nothing else Just o)-      (glBindTexture (marshalTextureTarget t) . textureID . (maybe defaultTextureObject id))--defaultTextureObject :: TextureObject-defaultTextureObject = TextureObject 0--textureTargetToGetPName :: TextureTarget -> GetPName-textureTargetToGetPName x = case x of-    Texture1D -> GetTextureBinding1D-    Texture2D -> GetTextureBinding2D-    Texture3D -> GetTextureBinding3D-    TextureCubeMap -> GetTextureBindingCubeMap-    TextureRectangle -> GetTextureBindingRectangle------------------------------------------------------------------------------------textureResident :: TextureTarget -> GettableStateVar Bool-textureResident t =-   makeGettableStateVar $-      getTexParameteri unmarshalGLboolean t TextureResident--areTexturesResident :: [TextureObject] -> IO ([TextureObject],[TextureObject])-areTexturesResident texObjs = do-   withArrayLen (map textureID texObjs) $ \len texObjsBuf ->-      allocaArray len $ \residentBuf -> do-         allResident <--            glAreTexturesResident (fromIntegral len) texObjsBuf residentBuf-         if unmarshalGLboolean allResident-            then return (texObjs, [])-            else do-               tr <- fmap (zip texObjs) $ peekArray len residentBuf-               let (resident, nonResident) = partition (unmarshalGLboolean . snd) tr-               return (map fst resident, map fst nonResident)------------------------------------------------------------------------------------type TexturePriority = GLclampf--texturePriority :: TextureTarget -> StateVar TexturePriority-texturePriority = texParamf realToFrac realToFrac TexturePriority--prioritizeTextures :: [(TextureObject,TexturePriority)] -> IO ()-prioritizeTextures tps =-   withArrayLen (map (textureID . fst) tps) $ \len texObjsBuf ->-      withArray (map snd tps) $-         glPrioritizeTextures (fromIntegral len) texObjsBuf
− Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs 
@@ -1,254 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Parameters--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.8.4 (Texture Parameters), section 3.8.7--- (Texture Wrap Mode), section 3.8.8 (Texture Minification), and section 3.8.9--- (Texture Magnification) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.Parameters (-   TextureFilter(..), MinificationFilter, MagnificationFilter, textureFilter,-   Repetition(..), Clamping(..), textureWrapMode,-   textureBorderColor, LOD, textureObjectLODBias, maxTextureLODBias,-   textureLODRange, textureMaxAnisotropy, maxTextureMaxAnisotropy,-   textureLevelRange, generateMipmap, depthTextureMode, textureCompareMode,-   textureCompareFailValue, TextureCompareOperator(..), textureCompareOperator-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.ComparisonFunction-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat-import Graphics.Rendering.OpenGL.GL.Texturing.Specification-import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( gl_CLAMP )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.TextureMirrorClamp (-   gl_MIRROR_CLAMP, gl_MIRROR_CLAMP_TO_BORDER, gl_MIRROR_CLAMP_TO_EDGE )------------------------------------------------------------------------------------data TextureFilter =-     Nearest-   | Linear'-   deriving ( Eq, Ord, Show )--type MinificationFilter = (TextureFilter, Maybe TextureFilter)--type MagnificationFilter = TextureFilter---- We treat MagnificationFilter as a degenerated case of MinificationFilter-magToMin :: MagnificationFilter -> MinificationFilter-magToMin magFilter = (magFilter, Nothing)--minToMag :: MinificationFilter -> MagnificationFilter-minToMag (magFilter, Nothing) = magFilter-minToMag minFilter = error ("minToMag: illegal value " ++ show minFilter)--marshalMinificationFilter :: MinificationFilter -> GLint-marshalMinificationFilter x = fromIntegral $ case x of-   (Nearest, Nothing     ) -> gl_NEAREST-   (Linear', Nothing     ) -> gl_LINEAR-   (Nearest, Just Nearest) -> gl_NEAREST_MIPMAP_NEAREST-   (Linear', Just Nearest) -> gl_LINEAR_MIPMAP_NEAREST-   (Nearest, Just Linear') -> gl_NEAREST_MIPMAP_LINEAR-   (Linear', Just Linear') -> gl_LINEAR_MIPMAP_LINEAR--marshalMagnificationFilter :: MagnificationFilter -> GLint-marshalMagnificationFilter = marshalMinificationFilter . magToMin--unmarshalMinificationFilter :: GLint -> MinificationFilter-unmarshalMinificationFilter x-   | y ==  gl_NEAREST = (Nearest, Nothing)-   | y ==  gl_LINEAR = (Linear', Nothing)-   | y ==  gl_NEAREST_MIPMAP_NEAREST = (Nearest, Just Nearest)-   | y ==  gl_LINEAR_MIPMAP_NEAREST = (Linear', Just Nearest)-   | y ==  gl_NEAREST_MIPMAP_LINEAR = (Nearest, Just Linear')-   | y ==  gl_LINEAR_MIPMAP_LINEAR = (Linear', Just Linear')-   | otherwise = error ("unmarshalMinificationFilter: illegal value " ++ show x)-   where y = fromIntegral x--unmarshalMagnificationFilter :: GLint -> MagnificationFilter-unmarshalMagnificationFilter = minToMag . unmarshalMinificationFilter------------------------------------------------------------------------------------textureFilter :: TextureTarget -> StateVar (MinificationFilter, MagnificationFilter)-textureFilter =-   combineTexParams-      (texParami unmarshalMinificationFilter  marshalMinificationFilter  TextureMinFilter)-      (texParami unmarshalMagnificationFilter marshalMagnificationFilter TextureMagFilter)------------------------------------------------------------------------------------data Repetition =-     Repeated-   | Mirrored-   deriving ( Eq, Ord, Show )--data Clamping =-     Clamp-   | Repeat-   | ClampToEdge-   | ClampToBorder-   deriving ( Eq, Ord, Show )--marshalTextureWrapMode :: (Repetition, Clamping) -> GLint-marshalTextureWrapMode x = fromIntegral $ case x of-   (Repeated, Clamp) -> gl_CLAMP-   (Repeated, Repeat) -> gl_REPEAT-   (Repeated, ClampToEdge) -> gl_CLAMP_TO_EDGE-   (Repeated, ClampToBorder) -> gl_CLAMP_TO_BORDER-   (Mirrored, Clamp) -> gl_MIRROR_CLAMP-   (Mirrored, Repeat) -> gl_MIRRORED_REPEAT-   (Mirrored, ClampToEdge) -> gl_MIRROR_CLAMP_TO_EDGE-   (Mirrored, ClampToBorder) -> gl_MIRROR_CLAMP_TO_BORDER--unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)-unmarshalTextureWrapMode x-   | y == gl_CLAMP = (Repeated, Clamp)-   | y == gl_REPEAT = (Repeated, Repeat)-   | y == gl_CLAMP_TO_EDGE = (Repeated, ClampToEdge)-   | y == gl_CLAMP_TO_BORDER = (Repeated, ClampToBorder)-   | y == gl_MIRROR_CLAMP = (Mirrored, Clamp)-   | y == gl_MIRRORED_REPEAT = (Mirrored, Repeat)-   | y == gl_MIRROR_CLAMP_TO_EDGE = (Mirrored, ClampToEdge)-   | y == gl_MIRROR_CLAMP_TO_BORDER = (Mirrored, ClampToBorder)-   | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------textureWrapMode :: TextureTarget -> TextureCoordName -> StateVar (Repetition,Clamping)-textureWrapMode t coord = case coord of-   S -> wrap TextureWrapS-   T -> wrap TextureWrapT-   R -> wrap TextureWrapR-   Q -> invalidTextureCoord-   where wrap c = texParami unmarshalTextureWrapMode marshalTextureWrapMode c t--invalidTextureCoord :: StateVar (Repetition,Clamping)-invalidTextureCoord =-   makeStateVar-      (do recordInvalidEnum; return (Repeated, Repeat))-      (const recordInvalidEnum)------------------------------------------------------------------------------------textureBorderColor :: TextureTarget -> StateVar (Color4 GLfloat)-textureBorderColor = texParamC4f TextureBorderColor------------------------------------------------------------------------------------type LOD = GLfloat--textureObjectLODBias :: TextureTarget -> StateVar LOD-textureObjectLODBias = texParamf id id TextureLODBias--maxTextureLODBias :: GettableStateVar LOD-maxTextureLODBias =-   makeGettableStateVar (getFloat1 id GetMaxTextureLODBias)--textureLODRange :: TextureTarget -> StateVar (LOD,LOD)-textureLODRange =-   combineTexParams-      (texParamf id id TextureMinLOD)-      (texParamf id id TextureMaxLOD)------------------------------------------------------------------------------------textureMaxAnisotropy :: TextureTarget -> StateVar GLfloat-textureMaxAnisotropy = texParamf id id TextureMaxAnisotropy--maxTextureMaxAnisotropy :: GettableStateVar GLfloat-maxTextureMaxAnisotropy =-   makeGettableStateVar (getFloat1 id GetMaxTextureMaxAnisotropy)------------------------------------------------------------------------------------textureLevelRange :: TextureTarget -> StateVar (Level,Level)-textureLevelRange =-   combineTexParams-      (texParami id id TextureBaseLevel)-      (texParami id id TextureMaxLevel)------------------------------------------------------------------------------------generateMipmap :: TextureTarget -> StateVar Capability-generateMipmap = texParami unmarshal marshal GenerateMipmap-   where unmarshal = unmarshalCapability . fromIntegral-         marshal = fromIntegral . marshalCapability-------------------------------------------------------------------------------------- Only Luminance', Intensity, and Alpha' allowed-depthTextureMode :: TextureTarget -> StateVar PixelInternalFormat-depthTextureMode =-   texParami unmarshalPixelInternalFormat marshalPixelInternalFormat DepthTextureMode------------------------------------------------------------------------------------marshalTextureCompareMode :: Capability -> GLint-marshalTextureCompareMode x = fromIntegral $ case x of-   Disabled -> gl_NONE-   Enabled -> gl_COMPARE_REF_TO_TEXTURE--unmarshalTextureCompareMode :: GLint -> Capability-unmarshalTextureCompareMode x-   | y == gl_NONE = Disabled-   | y == gl_COMPARE_REF_TO_TEXTURE = Enabled-   | otherwise = error ("unmarshalTextureCompareMode: illegal value " ++ show x)-   where y = fromIntegral x------------------------------------------------------------------------------------textureCompareMode :: TextureTarget -> StateVar (Maybe ComparisonFunction)-textureCompareMode =-   combineTexParamsMaybe-      (texParami unmarshalTextureCompareMode marshalTextureCompareMode TextureCompareMode)-      (texParami unmarshal marshal TextureCompareFunc)-   where unmarshal = unmarshalComparisonFunction . fromIntegral-         marshal = fromIntegral . marshalComparisonFunction------------------------------------------------------------------------------------textureCompareFailValue :: TextureTarget -> StateVar GLclampf-textureCompareFailValue = texParamf realToFrac realToFrac TextureCompareFailValue------------------------------------------------------------------------------------data TextureCompareOperator =-     LequalR-   | GequalR-   deriving ( Eq, Ord, Show )--marshalTextureCompareOperator :: TextureCompareOperator -> GLint-marshalTextureCompareOperator x = case x of-   LequalR -> 0x819c-   GequalR -> 0x819d--unmarshalTextureCompareOperator :: GLint -> TextureCompareOperator-unmarshalTextureCompareOperator x-   | x == 0x819c = LequalR-   | x == 0x819d = GequalR-   | otherwise = error ("unmarshalTextureCompareOperator: illegal value " ++ show x)------------------------------------------------------------------------------------textureCompareOperator :: TextureTarget -> StateVar (Maybe TextureCompareOperator)-textureCompareOperator =-   combineTexParamsMaybe-      (texParami (unmarshalCapability . fromIntegral) (fromIntegral. marshalCapability) TextureCompare)-      (texParami unmarshalTextureCompareOperator marshalTextureCompareOperator TextureCompareOperator)
− Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs 
@@ -1,257 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling PixelInternalFormat.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   PixelInternalFormat(..), marshalPixelInternalFormat,-   marshalPixelInternalFormat', unmarshalPixelInternalFormat,-) where--import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_ALPHA12, gl_ALPHA16, gl_ALPHA4, gl_ALPHA8, gl_COMPRESSED_ALPHA,-   gl_COMPRESSED_INTENSITY, gl_COMPRESSED_LUMINANCE,-   gl_COMPRESSED_LUMINANCE_ALPHA, gl_COMPRESSED_SLUMINANCE,-   gl_COMPRESSED_SLUMINANCE_ALPHA, gl_INTENSITY, gl_INTENSITY12, gl_INTENSITY16,-   gl_INTENSITY4, gl_INTENSITY8, gl_LUMINANCE, gl_LUMINANCE12,-   gl_LUMINANCE12_ALPHA12, gl_LUMINANCE12_ALPHA4, gl_LUMINANCE16,-   gl_LUMINANCE16_ALPHA16, gl_LUMINANCE4, gl_LUMINANCE4_ALPHA4,-   gl_LUMINANCE6_ALPHA2, gl_LUMINANCE8, gl_LUMINANCE8_ALPHA8,-   gl_LUMINANCE_ALPHA, gl_SLUMINANCE, gl_SLUMINANCE8, gl_SLUMINANCE8_ALPHA8,-   gl_SLUMINANCE_ALPHA )-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data PixelInternalFormat =-     Alpha'-   | DepthComponent'-   | Luminance'-   | LuminanceAlpha'-   | Intensity-   | RGB'-   | RGBA'-   | SRGB-   | SRGBAlpha-   | SLuminance-   | SLuminanceAlpha-   | Alpha4-   | Alpha8-   | Alpha12-   | Alpha16-   | DepthComponent16-   | DepthComponent24-   | DepthComponent32-   | Luminance4-   | Luminance8-   | Luminance12-   | Luminance16-   | Luminance4Alpha4-   | Luminance6Alpha2-   | Luminance8Alpha8-   | Luminance12Alpha4-   | Luminance12Alpha12-   | Luminance16Alpha16-   | Intensity4-   | Intensity8-   | Intensity12-   | Intensity16-   | R3G3B2-   | RGB4-   | RGB5-   | RGB8-   | RGB10-   | RGB12-   | RGB16-   | RGBA2-   | RGBA4-   | RGB5A1-   | RGBA8-   | RGB10A2-   | RGBA12-   | RGBA16-   | SRGB8-   | SRGB8Alpha8-   | SLuminance8-   | SLuminance8Alpha8-   | CompressedAlpha-   | CompressedLuminance-   | CompressedLuminanceAlpha-   | CompressedIntensity-   | CompressedRGB-   | CompressedRGBA-   | CompressedSRGB-   | CompressedSRGBAlpha-   | CompressedSLuminance-   | CompressedSLuminanceAlpha-   | DepthComponent32f-   | Depth32fStencil8-   | RGB9E5-   | R11fG11fB10f-   deriving ( Eq, Ord, Show )--marshalPixelInternalFormat :: PixelInternalFormat -> GLint-marshalPixelInternalFormat x = fromIntegral $ case x of-   Alpha' -> gl_ALPHA-   DepthComponent' -> gl_DEPTH_COMPONENT-   Luminance' -> gl_LUMINANCE-   LuminanceAlpha' -> gl_LUMINANCE_ALPHA-   RGB' -> gl_RGB-   RGBA' -> gl_RGBA-   SRGB -> gl_SRGB-   SRGBAlpha -> gl_SRGB_ALPHA-   SLuminance -> gl_SLUMINANCE-   SLuminanceAlpha -> gl_SLUMINANCE_ALPHA-   Alpha4 -> gl_ALPHA4-   Alpha8 -> gl_ALPHA8-   Alpha12 -> gl_ALPHA12-   Alpha16 -> gl_ALPHA16-   DepthComponent16 -> gl_DEPTH_COMPONENT16-   DepthComponent24 -> gl_DEPTH_COMPONENT24-   DepthComponent32 -> gl_DEPTH_COMPONENT32-   Luminance4 -> gl_LUMINANCE4-   Luminance8 -> gl_LUMINANCE8-   Luminance12 -> gl_LUMINANCE12-   Luminance16 -> gl_LUMINANCE16-   Luminance4Alpha4 -> gl_LUMINANCE4_ALPHA4-   Luminance6Alpha2 -> gl_LUMINANCE6_ALPHA2-   Luminance8Alpha8 -> gl_LUMINANCE8_ALPHA8-   Luminance12Alpha4 -> gl_LUMINANCE12_ALPHA4-   Luminance12Alpha12 -> gl_LUMINANCE12_ALPHA12-   Luminance16Alpha16 -> gl_LUMINANCE16_ALPHA16-   Intensity -> gl_INTENSITY-   Intensity4 -> gl_INTENSITY4-   Intensity8 -> gl_INTENSITY8-   Intensity12 -> gl_INTENSITY12-   Intensity16 -> gl_INTENSITY16-   R3G3B2 -> gl_R3_G3_B2-   RGB4 -> gl_RGB4-   RGB5 -> gl_RGB5-   RGB8 -> gl_RGB8-   RGB10 -> gl_RGB10-   RGB12 -> gl_RGB12-   RGB16 -> gl_RGB16-   RGBA2 -> gl_RGBA2-   RGBA4 -> gl_RGBA4-   RGB5A1 -> gl_RGB5_A1-   RGBA8 -> gl_RGBA8-   RGB10A2 -> gl_RGB10_A2-   RGBA12 -> gl_RGBA12-   RGBA16 -> gl_RGBA16-   SRGB8 -> gl_SRGB8-   SRGB8Alpha8 -> gl_SRGB8_ALPHA8-   SLuminance8 -> gl_SLUMINANCE8-   SLuminance8Alpha8 -> gl_SLUMINANCE8_ALPHA8-   CompressedAlpha -> gl_COMPRESSED_ALPHA-   CompressedLuminance -> gl_COMPRESSED_LUMINANCE-   CompressedLuminanceAlpha -> gl_COMPRESSED_LUMINANCE_ALPHA-   CompressedIntensity -> gl_COMPRESSED_INTENSITY-   CompressedRGB -> gl_COMPRESSED_RGB-   CompressedRGBA -> gl_COMPRESSED_RGBA-   CompressedSRGB -> gl_COMPRESSED_SRGB-   CompressedSRGBAlpha -> gl_COMPRESSED_SRGB_ALPHA-   CompressedSLuminance -> gl_COMPRESSED_SLUMINANCE-   CompressedSLuminanceAlpha -> gl_COMPRESSED_SLUMINANCE_ALPHA-   DepthComponent32f -> gl_DEPTH_COMPONENT32F-   Depth32fStencil8 -> gl_DEPTH32F_STENCIL8-   RGB9E5 -> gl_RGB9_E5-   R11fG11fB10f -> gl_R11F_G11F_B10F---- *sigh* The OpenGL API is sometimes a bit creative in its usage of types...-marshalPixelInternalFormat' :: PixelInternalFormat -> GLenum-marshalPixelInternalFormat' = fromIntegral . marshalPixelInternalFormat--unmarshalPixelInternalFormat :: GLint -> PixelInternalFormat-unmarshalPixelInternalFormat x-   | y == gl_ALPHA = Alpha'-   | y == gl_DEPTH_COMPONENT = DepthComponent'-   | y == gl_LUMINANCE = Luminance'-   | y == gl_LUMINANCE_ALPHA = LuminanceAlpha'-   | y == gl_RGB = RGB'-   | y == gl_RGBA = RGBA'-   | y == gl_SRGB = SRGB-   | y == gl_SRGB_ALPHA = SRGBAlpha-   | y == gl_SLUMINANCE = SLuminance-   | y == gl_SLUMINANCE_ALPHA = SLuminanceAlpha-   | y == gl_ALPHA4 = Alpha4-   | y == gl_ALPHA8 = Alpha8-   | y == gl_ALPHA12 = Alpha12-   | y == gl_ALPHA16 = Alpha16-   | y == gl_DEPTH_COMPONENT16 = DepthComponent16-   | y == gl_DEPTH_COMPONENT24 = DepthComponent24-   | y == gl_DEPTH_COMPONENT32 = DepthComponent32-   | y == gl_LUMINANCE4 = Luminance4-   | y == gl_LUMINANCE8 = Luminance8-   | y == gl_LUMINANCE12 = Luminance12-   | y == gl_LUMINANCE16 = Luminance16-   | y == gl_LUMINANCE4_ALPHA4 = Luminance4Alpha4-   | y == gl_LUMINANCE6_ALPHA2 = Luminance6Alpha2-   | y == gl_LUMINANCE8_ALPHA8 = Luminance8Alpha8-   | y == gl_LUMINANCE12_ALPHA4 = Luminance12Alpha4-   | y == gl_LUMINANCE12_ALPHA12 = Luminance12Alpha12-   | y == gl_LUMINANCE16_ALPHA16 = Luminance16Alpha16-   | y == gl_INTENSITY = Intensity-   | y == gl_INTENSITY4 = Intensity4-   | y == gl_INTENSITY8 = Intensity8-   | y == gl_INTENSITY12 = Intensity12-   | y == gl_INTENSITY16 = Intensity16-   | y == gl_R3_G3_B2 = R3G3B2-   | y == gl_RGB4 = RGB4-   | y == gl_RGB5 = RGB5-   | y == gl_RGB8 = RGB8-   | y == gl_RGB10 = RGB10-   | y == gl_RGB12 = RGB12-   | y == gl_RGB16 = RGB16-   | y == gl_RGBA2 = RGBA2-   | y == gl_RGBA4 = RGBA4-   | y == gl_RGB5_A1 = RGB5A1-   | y == gl_RGBA8 = RGBA8-   | y == gl_RGB10_A2 = RGB10A2-   | y == gl_RGBA12 = RGBA12-   | y == gl_RGBA16 = RGBA16-   | y == gl_SRGB8 = SRGB8-   | y == gl_SRGB8_ALPHA8 = SRGB8Alpha8-   | y == gl_SLUMINANCE8 = SLuminance8-   | y == gl_SLUMINANCE8_ALPHA8 = SLuminance8Alpha8-   | y == gl_COMPRESSED_ALPHA = CompressedAlpha-   | y == gl_COMPRESSED_LUMINANCE = CompressedLuminance-   | y == gl_COMPRESSED_LUMINANCE_ALPHA = CompressedLuminanceAlpha-   | y == gl_COMPRESSED_INTENSITY = CompressedIntensity-   | y == gl_COMPRESSED_RGB = CompressedRGB-   | y == gl_COMPRESSED_RGBA = CompressedRGBA-   | y == gl_COMPRESSED_SRGB = CompressedSRGB-   | y == gl_COMPRESSED_SRGB_ALPHA = CompressedSRGBAlpha-   | y == gl_COMPRESSED_SLUMINANCE = CompressedSLuminance-   | y == gl_COMPRESSED_SLUMINANCE_ALPHA = CompressedSLuminanceAlpha-   | y == gl_DEPTH_COMPONENT32F = DepthComponent32f-   | y == gl_DEPTH32F_STENCIL8 = Depth32fStencil8-   | y == gl_RGB9_E5 = RGB9E5-   -- legacy values-   | y == 1 = Luminance'-   | y == 2 = LuminanceAlpha'-   | y == 3 = RGB'-   | y == 4 = RGBA'-   | otherwise = error ("unmarshalPixelInternalFormat: illegal value " ++ show x)-   where y = fromIntegral x---- Note: The following formats are still missing, it's a bit unclear how to--- handle these nicely. From the EXT_texture_sRGB spec:------    Accepted by the <internalformat> parameter of TexImage2D, CopyTexImage2D,---    and CompressedTexImage2DARB and the <format> parameter of---    CompressedTexSubImage2DARB:------       COMPRESSED_SRGB_S3TC_DXT1_EXT                  0x8C4C---       COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT            0x8C4D---       COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT            0x8C4E---       COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT            0x8C4F
− Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs 
@@ -1,162 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Queries--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module offers various texture queries.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.Queries (-   TextureQuery, textureInternalFormat, textureSize1D, textureSize2D,-   textureSize3D, textureBorder, textureRGBASizes, textureSharedSize,-   textureIntensitySize, textureLuminanceSize, textureIndexSize,-   textureDepthBits, textureCompressedImageSize, textureProxyOK-) where--import Control.Monad-import Data.StateVar-import Foreign.Marshal.Alloc-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.PixelRectangles-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat-import Graphics.Rendering.OpenGL.GL.Texturing.Specification-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_TEXTURE_INTENSITY_SIZE, gl_TEXTURE_LUMINANCE_SIZE, gl_DEPTH_BITS )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.PalettedTexture (-   gl_TEXTURE_INDEX_SIZE )------------------------------------------------------------------------------------data TexLevelParameter =-     TextureInternalFormat-   | TextureWidth-   | TextureHeight-   | TextureDepth-   | TextureBorder-   | TextureRedSize-   | TextureGreenSize-   | TextureBlueSize-   | TextureAlphaSize-   | TextureIntensitySize-   | TextureLuminanceSize-   | TextureIndexSize-   | DepthBits-   | TextureCompressedImageSize-   | TextureCompressed-   | TextureSharedSize--marshalTexLevelParameter :: TexLevelParameter -> GLenum-marshalTexLevelParameter x = case x of-   TextureInternalFormat -> gl_TEXTURE_INTERNAL_FORMAT-   TextureWidth -> gl_TEXTURE_WIDTH-   TextureHeight -> gl_TEXTURE_HEIGHT-   TextureDepth -> gl_TEXTURE_DEPTH-   TextureBorder -> gl_TEXTURE_BORDER-   TextureRedSize -> gl_TEXTURE_RED_SIZE-   TextureGreenSize -> gl_TEXTURE_GREEN_SIZE-   TextureBlueSize -> gl_TEXTURE_BLUE_SIZE-   TextureAlphaSize -> gl_TEXTURE_ALPHA_SIZE-   TextureIntensitySize -> gl_TEXTURE_INTENSITY_SIZE-   TextureLuminanceSize -> gl_TEXTURE_LUMINANCE_SIZE-   TextureIndexSize -> gl_TEXTURE_INDEX_SIZE-   DepthBits -> gl_DEPTH_BITS-   TextureCompressedImageSize -> gl_TEXTURE_COMPRESSED_IMAGE_SIZE-   TextureCompressed -> gl_TEXTURE_COMPRESSED-   TextureSharedSize -> gl_TEXTURE_SHARED_SIZE------------------------------------------------------------------------------------type TextureQuery a = Either TextureTarget CubeMapTarget -> Level -> GettableStateVar a--textureInternalFormat :: TextureQuery PixelInternalFormat-textureInternalFormat t level =-   makeGettableStateVar $-      getTexLevelParameteri unmarshalPixelInternalFormat NoProxy t level TextureInternalFormat--textureSize1D :: TextureQuery TextureSize1D-textureSize1D t level =-   makeGettableStateVar $-      getTexLevelParameteri (TextureSize1D . fromIntegral) NoProxy t level TextureWidth--textureSize2D :: TextureQuery TextureSize2D-textureSize2D t level =-   makeGettableStateVar $-      liftM2 TextureSize2D-             (getTexLevelParameteri fromIntegral NoProxy t level TextureWidth )-             (getTexLevelParameteri fromIntegral NoProxy t level TextureHeight)--textureSize3D :: TextureQuery TextureSize3D-textureSize3D t level =-   makeGettableStateVar $-      liftM3 TextureSize3D-             (getTexLevelParameteri fromIntegral NoProxy t level TextureWidth )-             (getTexLevelParameteri fromIntegral NoProxy t level TextureHeight)-             (getTexLevelParameteri fromIntegral NoProxy t level TextureDepth )--textureBorder :: TextureQuery Border-textureBorder t level =-   makeGettableStateVar $-      getTexLevelParameteri fromIntegral NoProxy t level TextureBorder--textureRGBASizes :: TextureQuery (Color4 GLsizei)-textureRGBASizes t level =-   makeGettableStateVar $-      liftM4 Color4-             (getTexLevelParameteri fromIntegral NoProxy t level TextureRedSize  )-             (getTexLevelParameteri fromIntegral NoProxy t level TextureGreenSize)-             (getTexLevelParameteri fromIntegral NoProxy t level TextureBlueSize )-             (getTexLevelParameteri fromIntegral NoProxy t level TextureAlphaSize)--textureSharedSize :: TextureQuery GLsizei-textureSharedSize t level =-   makeGettableStateVar $-      getTexLevelParameteri fromIntegral NoProxy t level TextureSharedSize--textureIntensitySize :: TextureQuery GLsizei-textureIntensitySize t level =-   makeGettableStateVar $-      getTexLevelParameteri fromIntegral NoProxy t level TextureIntensitySize--textureLuminanceSize :: TextureQuery GLsizei-textureLuminanceSize t level =-   makeGettableStateVar $-      getTexLevelParameteri fromIntegral NoProxy t level TextureLuminanceSize--textureIndexSize :: TextureQuery GLsizei-textureIndexSize t level =-   makeGettableStateVar $-      getTexLevelParameteri fromIntegral NoProxy t level TextureIndexSize--textureDepthBits :: TextureQuery GLsizei-textureDepthBits t level =-   makeGettableStateVar $-      getTexLevelParameteri fromIntegral NoProxy t level DepthBits--textureCompressedImageSize :: TextureQuery (Maybe GLsizei)-textureCompressedImageSize t level =-   makeGettableStateVar $ do-      isCompressed <- getTexLevelParameteri unmarshalGLboolean NoProxy t level TextureCompressed-      if isCompressed-         then getTexLevelParameteri (Just . fromIntegral) NoProxy t level TextureCompressedImageSize-         else return Nothing--textureProxyOK :: TextureQuery Bool-textureProxyOK t level =-   makeGettableStateVar $-      getTexLevelParameteri unmarshalGLboolean Proxy t level TextureWidth--getTexLevelParameteri :: (GLint -> a) -> Proxy -> Either TextureTarget CubeMapTarget -> Level -> TexLevelParameter -> IO a-getTexLevelParameteri f proxy t level p =-   alloca $ \buf -> do-      glGetTexLevelParameteriv (either (marshalProxyTextureTarget proxy) (\c -> if proxy == Proxy then marshalProxyTextureTarget Proxy TextureCubeMap else marshalCubeMapTarget c) t) level (marshalTexLevelParameter p) buf-      peek1 f buf
− Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs 
@@ -1,258 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Specification--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 3.8.1 (Texture Image Specification),--- section 3.8.2 (Alternate Texture Image Specification Commands), and section--- 3.8.3 (Compressed Texture Images) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.Specification (-   -- * Texture-related Data Types-   TextureTarget(..), CubeMapTarget(..), Level, Border,-   TexturePosition1D(..), TexturePosition2D(..), TexturePosition3D(..),-   TextureSize1D(..), TextureSize2D(..), TextureSize3D(..),--   -- * Texture Image Specification-   texImage1D, texImage2D, texImage3D,-   copyTexImage1D, copyTexImage2D,-   texSubImage1D, texSubImage2D, texSubImage3D,-   getTexImage,--   -- * Alternate Texture Image Specification Commands-   copyTexSubImage1D, copyTexSubImage2D, copyTexSubImage3D,--   -- * Compressed Texture Images-   CompressedTextureFormat(..), compressedTextureFormats,-   CompressedPixelData(..),-   compressedTexImage1D, compressedTexImage2D, compressedTexImage3D,-   compressedTexSubImage1D, compressedTexSubImage2D, compressedTexSubImage3D,-   getCompressedTexImage,--  -- * Implementation-Dependent Limits-  maxTextureSize-) where--import Data.StateVar-import Foreign.Marshal.Array-import Foreign.Ptr-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.PixelData-import Graphics.Rendering.OpenGL.GL.PixelRectangles-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------type Level = GLint--type Border = GLint--newtype TexturePosition1D = TexturePosition1D GLint-   deriving ( Eq, Ord, Show )--data TexturePosition2D = TexturePosition2D !GLint !GLint-   deriving ( Eq, Ord, Show )--data TexturePosition3D = TexturePosition3D !GLint !GLint !GLint-   deriving ( Eq, Ord, Show )--newtype TextureSize1D = TextureSize1D GLsizei-   deriving ( Eq, Ord, Show )--data TextureSize2D = TextureSize2D !GLsizei !GLsizei-   deriving ( Eq, Ord, Show )--data TextureSize3D = TextureSize3D !GLsizei !GLsizei !GLsizei-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------texImage1D :: Proxy -> Level -> PixelInternalFormat -> TextureSize1D -> Border -> PixelData a -> IO ()-texImage1D proxy level int (TextureSize1D w) border pd =-   withPixelData pd $-      glTexImage1D-         (marshalProxyTextureTarget proxy Texture1D)-         level (marshalPixelInternalFormat int) w border------------------------------------------------------------------------------------texImage2D :: Maybe CubeMapTarget -> Proxy -> Level -> PixelInternalFormat -> TextureSize2D -> Border -> PixelData a -> IO ()-texImage2D mbCubeMap proxy level int (TextureSize2D w h) border pd =-   withPixelData pd $-      glTexImage2D-         (maybe (marshalProxyTextureTarget proxy Texture2D)-                (\c -> if proxy == Proxy then marshalProxyTextureTarget Proxy TextureCubeMap else marshalCubeMapTarget c)-                mbCubeMap)-         level (marshalPixelInternalFormat int) w h border------------------------------------------------------------------------------------texImage3D :: Proxy -> Level -> PixelInternalFormat -> TextureSize3D -> Border -> PixelData a -> IO ()-texImage3D proxy level int (TextureSize3D w h d) border pd =-   withPixelData pd $-      glTexImage3D-         (marshalProxyTextureTarget proxy Texture3D)-         level (marshalPixelInternalFormat int) w h d border------------------------------------------------------------------------------------getTexImage :: Either TextureTarget CubeMapTarget -> Level -> PixelData a -> IO ()-getTexImage t level pd =-   withPixelData pd $-      glGetTexImage (either marshalTextureTarget marshalCubeMapTarget t) level------------------------------------------------------------------------------------copyTexImage1D :: Level -> PixelInternalFormat -> Position -> TextureSize1D -> Border -> IO ()-copyTexImage1D level int (Position x y) (TextureSize1D w) border =-   glCopyTexImage1D-      (marshalTextureTarget Texture1D) level-      (marshalPixelInternalFormat' int) x y w border------------------------------------------------------------------------------------copyTexImage2D :: Maybe CubeMapTarget -> Level -> PixelInternalFormat -> Position -> TextureSize2D -> Border -> IO ()-copyTexImage2D mbCubeMap level int (Position x y) (TextureSize2D w h) border =-   glCopyTexImage2D-      (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level-      (marshalPixelInternalFormat' int) x y w h border------------------------------------------------------------------------------------texSubImage1D :: Level -> TexturePosition1D -> TextureSize1D -> PixelData a -> IO ()-texSubImage1D level (TexturePosition1D xOff) (TextureSize1D w) pd =-   withPixelData pd $-      glTexSubImage1D (marshalTextureTarget Texture1D) level xOff w------------------------------------------------------------------------------------texSubImage2D :: Maybe CubeMapTarget -> Level -> TexturePosition2D -> TextureSize2D -> PixelData a -> IO ()-texSubImage2D mbCubeMap level (TexturePosition2D xOff yOff) (TextureSize2D w h) pd =-   withPixelData pd $-      glTexSubImage2D (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level xOff yOff w h------------------------------------------------------------------------------------texSubImage3D :: Level -> TexturePosition3D -> TextureSize3D -> PixelData a -> IO ()-texSubImage3D level (TexturePosition3D xOff yOff zOff) (TextureSize3D w h d) pd =-   withPixelData pd $-      glTexSubImage3D (marshalTextureTarget Texture3D) level xOff yOff zOff w h d------------------------------------------------------------------------------------copyTexSubImage1D :: Level -> TexturePosition1D -> Position -> TextureSize1D -> IO ()-copyTexSubImage1D level (TexturePosition1D xOff) (Position x y) (TextureSize1D w) =-   glCopyTexSubImage1D (marshalTextureTarget Texture1D) level xOff x y w------------------------------------------------------------------------------------copyTexSubImage2D :: Maybe CubeMapTarget -> Level -> TexturePosition2D -> Position -> TextureSize2D -> IO ()-copyTexSubImage2D mbCubeMap level (TexturePosition2D xOff yOff) (Position x y) (TextureSize2D w h) =-   glCopyTexSubImage2D (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level xOff yOff x y w h------------------------------------------------------------------------------------copyTexSubImage3D :: Level -> TexturePosition3D -> Position -> TextureSize2D -> IO ()-copyTexSubImage3D level (TexturePosition3D xOff yOff zOff) (Position x y) (TextureSize2D w h) =-   glCopyTexSubImage3D (marshalTextureTarget Texture3D) level xOff yOff zOff x y w h------------------------------------------------------------------------------------newtype CompressedTextureFormat = CompressedTextureFormat GLenum-   deriving ( Eq, Ord, Show )--compressedTextureFormats :: GettableStateVar [CompressedTextureFormat]-compressedTextureFormats =-   makeGettableStateVar $ do-      n <- getInteger1 fromIntegral GetNumCompressedTextureFormats-      allocaArray n $ \buf -> do-         getIntegerv GetCompressedTextureFormats buf-         fmap (map (CompressedTextureFormat . fromIntegral)) $ peekArray n buf------------------------------------------------------------------------------------data CompressedPixelData a =-     CompressedPixelData !CompressedTextureFormat GLsizei (Ptr a)-   deriving ( Eq, Ord, Show )--withCompressedPixelData ::-   CompressedPixelData a -> (GLenum -> GLsizei -> Ptr a -> b) -> b-withCompressedPixelData-   (CompressedPixelData (CompressedTextureFormat fmt) size ptr) f =-   f fmt size ptr------------------------------------------------------------------------------------compressedTexImage1D :: Proxy -> Level -> TextureSize1D -> Border -> CompressedPixelData a -> IO ()-compressedTexImage1D proxy level (TextureSize1D w) border cpd =-   withCompressedPixelData cpd $ \fmt ->-      glCompressedTexImage1D-         (marshalProxyTextureTarget proxy Texture1D) level fmt w border------------------------------------------------------------------------------------compressedTexImage2D :: Maybe CubeMapTarget -> Proxy -> Level -> TextureSize2D -> Border -> CompressedPixelData a -> IO ()-compressedTexImage2D mbCubeMap proxy level (TextureSize2D w h) border cpd =-   withCompressedPixelData cpd $ \fmt ->-      glCompressedTexImage2D-         (maybe (marshalProxyTextureTarget proxy Texture2D)-                (\c -> if proxy == Proxy then marshalProxyTextureTarget Proxy TextureCubeMap else marshalCubeMapTarget c)-                mbCubeMap)-         level fmt w h border------------------------------------------------------------------------------------compressedTexImage3D :: Proxy -> Level -> TextureSize3D -> Border -> CompressedPixelData a -> IO ()-compressedTexImage3D proxy level (TextureSize3D w h d) border cpd =-   withCompressedPixelData cpd $ \fmt ->-      glCompressedTexImage3D-         (marshalProxyTextureTarget proxy Texture3D) level fmt w h d border------------------------------------------------------------------------------------getCompressedTexImage :: Either TextureTarget CubeMapTarget -> Level -> Ptr a -> IO ()-getCompressedTexImage = glGetCompressedTexImage . either marshalTextureTarget marshalCubeMapTarget------------------------------------------------------------------------------------compressedTexSubImage1D :: Level -> TexturePosition1D -> TextureSize1D -> CompressedPixelData a -> IO ()-compressedTexSubImage1D level (TexturePosition1D xOff) (TextureSize1D w) cpd =-   withCompressedPixelData cpd $-      glCompressedTexSubImage1D (marshalTextureTarget Texture1D) level xOff w------------------------------------------------------------------------------------compressedTexSubImage2D :: Maybe CubeMapTarget -> Level -> TexturePosition2D -> TextureSize2D -> CompressedPixelData a -> IO ()-compressedTexSubImage2D mbCubeMap level (TexturePosition2D xOff yOff) (TextureSize2D w h) cpd =-   withCompressedPixelData cpd $-      glCompressedTexSubImage2D (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level xOff yOff w h------------------------------------------------------------------------------------compressedTexSubImage3D :: Level -> TexturePosition3D -> TextureSize3D -> CompressedPixelData a -> IO ()-compressedTexSubImage3D level (TexturePosition3D xOff yOff zOff) (TextureSize3D w h d) cpd =-   withCompressedPixelData cpd $-      glCompressedTexSubImage3D (marshalTextureTarget Texture3D) level xOff yOff zOff w h d------------------------------------------------------------------------------------maxTextureSize :: TextureTarget -> GettableStateVar GLsizei-maxTextureSize = makeGettableStateVar . getInteger1 fromIntegral . textureTargetToMaxQuery--textureTargetToMaxQuery :: TextureTarget -> GetPName-textureTargetToMaxQuery x = case x of-   Texture1D -> GetMaxTextureSize-   Texture2D -> GetMaxTextureSize-   Texture3D -> GetMax3DTextureSize-   TextureCubeMap -> GetMaxCubeMapTextureSize-   TextureRectangle -> GetMaxRectangleTextureSize
− Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs 
@@ -1,164 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TexParameter--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for getting\/setting texture parameters.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.TexParameter (-   TexParameter(..), texParami, texParamf, texParamC4f, getTexParameteri,-   combineTexParams, combineTexParamsMaybe-) where--import Control.Monad-import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Marshal.Utils-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   gl_DEPTH_TEXTURE_MODE, gl_GENERATE_MIPMAP, gl_TEXTURE_PRIORITY,-   gl_TEXTURE_RESIDENT )-import Graphics.Rendering.OpenGL.Raw.ARB.ShadowAmbient (-   gl_TEXTURE_COMPARE_FAIL_VALUE )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.TextureFilterAnisotropic (-   gl_TEXTURE_MAX_ANISOTROPY )------------------------------------------------------------------------------------data TexParameter =-     TextureMinFilter-   | TextureMagFilter-   | TextureWrapS-   | TextureWrapT-   | TextureWrapR-   | TextureBorderColor-   | TextureMinLOD-   | TextureMaxLOD-   | TextureBaseLevel-   | TextureMaxLevel-   | TexturePriority-   | TextureMaxAnisotropy-   | TextureCompare-   | TextureCompareOperator-   | TextureCompareFailValue-   | GenerateMipmap-   | TextureCompareMode-   | TextureCompareFunc-   | DepthTextureMode-   | TextureLODBias-   | TextureResident--marshalTexParameter :: TexParameter -> GLenum-marshalTexParameter x = case x of-   TextureMinFilter -> gl_TEXTURE_MIN_FILTER-   TextureMagFilter -> gl_TEXTURE_MAG_FILTER-   TextureWrapS -> gl_TEXTURE_WRAP_S-   TextureWrapT -> gl_TEXTURE_WRAP_T-   TextureWrapR -> gl_TEXTURE_WRAP_R-   TextureBorderColor -> gl_TEXTURE_BORDER_COLOR-   TextureMinLOD -> gl_TEXTURE_MIN_LOD-   TextureMaxLOD -> gl_TEXTURE_MAX_LOD-   TextureBaseLevel -> gl_TEXTURE_BASE_LEVEL-   TextureMaxLevel -> gl_TEXTURE_MAX_LEVEL-   TexturePriority -> gl_TEXTURE_PRIORITY-   TextureMaxAnisotropy -> gl_TEXTURE_MAX_ANISOTROPY-   TextureCompare -> 0x819A-   TextureCompareOperator -> 0x819B-   TextureCompareFailValue -> gl_TEXTURE_COMPARE_FAIL_VALUE-   GenerateMipmap -> gl_GENERATE_MIPMAP-   TextureCompareMode -> gl_TEXTURE_COMPARE_MODE-   TextureCompareFunc -> gl_TEXTURE_COMPARE_FUNC-   DepthTextureMode -> gl_DEPTH_TEXTURE_MODE-   TextureLODBias -> gl_TEXTURE_LOD_BIAS-   TextureResident -> gl_TEXTURE_RESIDENT------------------------------------------------------------------------------------texParameter :: (GLenum -> GLenum -> b -> IO ())-             -> (a -> (b -> IO ()) -> IO ())-             -> TextureTarget -> TexParameter -> a -> IO ()-texParameter glTexParameter marshalAct t p x =-   marshalAct x $-      glTexParameter (marshalTextureTarget t) (marshalTexParameter p)------------------------------------------------------------------------------------getTexParameter :: Storable b-                => (GLenum -> GLenum -> Ptr b -> IO ())-                -> (b -> a)-                -> TextureTarget -> TexParameter -> IO a-getTexParameter glGetTexParameter unmarshal t p =-   alloca $ \buf -> do-     glGetTexParameter (marshalTextureTarget t) (marshalTexParameter p) buf-     peek1 unmarshal buf------------------------------------------------------------------------------------m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()-m2a marshal x act = act (marshal x)--texParami ::-   (GLint -> a) -> (a -> GLint) -> TexParameter -> TextureTarget -> StateVar a-texParami unmarshal marshal p t =-   makeStateVar-      (getTexParameter glGetTexParameteriv unmarshal     t p)-      (texParameter    glTexParameteri     (m2a marshal) t p)--texParamf ::-   (GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> TextureTarget -> StateVar a-texParamf unmarshal marshal p t =-   makeStateVar-      (getTexParameter glGetTexParameterfv unmarshal     t p)-      (texParameter    glTexParameterf     (m2a marshal) t p)--texParamC4f :: TexParameter -> TextureTarget -> StateVar (Color4 GLfloat)-texParamC4f p t =-   makeStateVar-      (getTexParameter glGetTexParameterC4f id   t p)-      (texParameter    glTexParameterC4f    with t p)--glTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glTexParameterC4f target pname ptr = glTexParameterfv target pname (castPtr ptr)--glGetTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()-glGetTexParameterC4f target pname ptr = glGetTexParameterfv target pname (castPtr ptr)--getTexParameteri :: (GLint -> a) -> TextureTarget -> TexParameter -> IO a-getTexParameteri = getTexParameter glGetTexParameteriv------------------------------------------------------------------------------------combineTexParams :: (TextureTarget -> StateVar a)-                 -> (TextureTarget -> StateVar b)-                 -> (TextureTarget -> StateVar (a,b))-combineTexParams v w t =-   makeStateVar-      (liftM2 (,) (get (v t)) (get (w t)))-      (\(x,y) -> do v t $= x; w t $= y)--combineTexParamsMaybe :: (TextureTarget -> StateVar Capability)-                      -> (TextureTarget -> StateVar a)-                      -> (TextureTarget -> StateVar (Maybe a))-combineTexParamsMaybe enab val t =-   makeStateVar-      (do tcm <- get (enab t)-          case tcm of-             Disabled -> return Nothing-             Enabled -> fmap Just $ get (val t))-      (maybe (enab t $= Disabled)-             (\tcf -> do val t $= tcf-                         enab t $= Enabled))
− Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs 
@@ -1,69 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for marshaling texture targets.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (-   TextureTarget(..), marshalTextureTarget, marshalProxyTextureTarget,-   CubeMapTarget(..), marshalCubeMapTarget-) where--import Graphics.Rendering.OpenGL.GL.PixelRectangles-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------data TextureTarget =-     Texture1D-   | Texture2D-   | Texture3D-   | TextureCubeMap-   | TextureRectangle-   deriving ( Eq, Ord, Show )--marshalTextureTarget :: TextureTarget -> GLenum-marshalTextureTarget x = case x of-   Texture1D -> gl_TEXTURE_1D-   Texture2D -> gl_TEXTURE_2D-   Texture3D -> gl_TEXTURE_3D-   TextureCubeMap -> gl_TEXTURE_CUBE_MAP-   TextureRectangle -> gl_TEXTURE_RECTANGLE--marshalProxyTextureTarget :: Proxy -> TextureTarget -> GLenum-marshalProxyTextureTarget NoProxy x = marshalTextureTarget x-marshalProxyTextureTarget Proxy   x = case x of-   Texture1D -> gl_PROXY_TEXTURE_1D-   Texture2D -> gl_PROXY_TEXTURE_2D-   Texture3D -> gl_PROXY_TEXTURE_3D-   TextureCubeMap -> gl_PROXY_TEXTURE_CUBE_MAP-   TextureRectangle -> gl_PROXY_TEXTURE_RECTANGLE------------------------------------------------------------------------------------data CubeMapTarget =-     TextureCubeMapPositiveX-   | TextureCubeMapNegativeX-   | TextureCubeMapPositiveY-   | TextureCubeMapNegativeY-   | TextureCubeMapPositiveZ-   | TextureCubeMapNegativeZ-   deriving ( Eq, Ord, Show )--marshalCubeMapTarget :: CubeMapTarget -> GLenum-marshalCubeMapTarget x = case x of-   TextureCubeMapPositiveX -> gl_TEXTURE_CUBE_MAP_POSITIVE_X-   TextureCubeMapNegativeX -> gl_TEXTURE_CUBE_MAP_NEGATIVE_X-   TextureCubeMapPositiveY -> gl_TEXTURE_CUBE_MAP_POSITIVE_Y-   TextureCubeMapNegativeY -> gl_TEXTURE_CUBE_MAP_NEGATIVE_Y-   TextureCubeMapPositiveZ -> gl_TEXTURE_CUBE_MAP_POSITIVE_Z-   TextureCubeMapNegativeZ -> gl_TEXTURE_CUBE_MAP_NEGATIVE_Z
− Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs 
@@ -1,34 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for (un-)marshaling TextureUnit.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit (-   TextureUnit(..), marshalTextureUnit, unmarshalTextureUnit-) where--import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | Identifies a texture unit via its number, which must be in the range of--- (0 .. 'maxTextureUnit').--newtype TextureUnit = TextureUnit GLuint-   deriving ( Eq, Ord, Show )--marshalTextureUnit :: TextureUnit -> GLenum-marshalTextureUnit (TextureUnit x) = gl_TEXTURE0 + fromIntegral x--unmarshalTextureUnit :: GLenum -> TextureUnit-unmarshalTextureUnit x = TextureUnit (fromIntegral (x - gl_TEXTURE0))
− Graphics/Rendering/OpenGL/GL/VertexArrays.hs 
@@ -1,502 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrays--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.8 (Vertex Arrays) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.VertexArrays (-   -- * Describing Data for the Arrays-   NumComponents, DataType(..), Stride, VertexArrayDescriptor(..),--   -- * Specifying Data for the Arrays-   Capability(..),-   ClientArrayType(..), arrayPointer,-   InterleavedArrays(..), interleavedArrays,--   -- * Enabling Arrays-   clientState, clientActiveTexture,--   -- * Dereferencing and Rendering-   ArrayIndex, NumArrayIndices, NumIndexBlocks,-   arrayElement, drawArrays, multiDrawArrays, drawElements, multiDrawElements,-   drawRangeElements, maxElementsVertices, maxElementsIndices, lockArrays,-   primitiveRestartIndex, primitiveRestartIndexNV,--   -- * Generic Vertex Attribute Arrays-   vertexAttribPointer, vertexAttribArray-) where--import Data.StateVar-import Foreign.Marshal.Alloc-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.DataType-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.PrimitiveMode-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glArrayElement, glClientActiveTexture, glColorPointer, glDisableClientState,-   glEdgeFlagPointer, glEnableClientState, glFogCoordPointer, glIndexPointer,-   glInterleavedArrays, glNormalPointer, glSecondaryColorPointer,-   glTexCoordPointer, glVertexPointer, gl_C3F_V3F, gl_C4F_N3F_V3F, gl_C4UB_V2F,-   gl_C4UB_V3F, gl_COLOR_ARRAY, gl_COLOR_ARRAY_POINTER, gl_EDGE_FLAG_ARRAY,-   gl_EDGE_FLAG_ARRAY_POINTER, gl_FEEDBACK_BUFFER_POINTER, gl_FOG_COORD_ARRAY,-   gl_FOG_COORD_ARRAY_POINTER, gl_INDEX_ARRAY, gl_INDEX_ARRAY_POINTER,-   gl_N3F_V3F, gl_NORMAL_ARRAY, gl_NORMAL_ARRAY_POINTER,-   gl_SECONDARY_COLOR_ARRAY, gl_SECONDARY_COLOR_ARRAY_POINTER,-   gl_SELECTION_BUFFER_POINTER, gl_T2F_C3F_V3F, gl_T2F_C4F_N3F_V3F,-   gl_T2F_C4UB_V3F, gl_T2F_N3F_V3F, gl_T2F_V3F, gl_T4F_C4F_N3F_V4F, gl_T4F_V4F,-   gl_TEXTURE_COORD_ARRAY, gl_TEXTURE_COORD_ARRAY_POINTER, gl_V2F, gl_V3F,-   gl_VERTEX_ARRAY, gl_VERTEX_ARRAY_POINTER )-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette (-   gl_MATRIX_INDEX_ARRAY, gl_MATRIX_INDEX_ARRAY_POINTER )-import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend ( gl_WEIGHT_ARRAY_POINTER )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.Raw.EXT.CompiledVertexArray-import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart------------------------------------------------------------------------------------type NumComponents = GLint--type Stride = GLsizei--data VertexArrayDescriptor a =-   VertexArrayDescriptor !NumComponents !DataType !Stride !(Ptr a)-   deriving ( Eq, Ord, Show )--noVertexArrayDescriptor :: VertexArrayDescriptor a-noVertexArrayDescriptor = VertexArrayDescriptor 0 Byte 0 nullPtr------------------------------------------------------------------------------------data ClientArrayType =-     VertexArray-   | NormalArray-   | ColorArray-   | IndexArray-   | TextureCoordArray-   | EdgeFlagArray-   | FogCoordArray-   | SecondaryColorArray-   | MatrixIndexArray-   deriving ( Eq, Ord, Show )--marshalClientArrayType :: ClientArrayType -> GLenum-marshalClientArrayType x = case x of-   VertexArray -> gl_VERTEX_ARRAY-   NormalArray -> gl_NORMAL_ARRAY-   ColorArray -> gl_COLOR_ARRAY-   IndexArray -> gl_INDEX_ARRAY-   TextureCoordArray -> gl_TEXTURE_COORD_ARRAY-   EdgeFlagArray -> gl_EDGE_FLAG_ARRAY-   FogCoordArray -> gl_FOG_COORD_ARRAY-   SecondaryColorArray -> gl_SECONDARY_COLOR_ARRAY-   MatrixIndexArray -> gl_MATRIX_INDEX_ARRAY---- Hmmm...-clientArrayTypeToEnableCap :: ClientArrayType -> EnableCap-clientArrayTypeToEnableCap x = case x of-   VertexArray -> CapVertexArray-   NormalArray -> CapNormalArray-   ColorArray -> CapColorArray-   IndexArray -> CapIndexArray-   TextureCoordArray -> CapTextureCoordArray-   EdgeFlagArray -> CapEdgeFlagArray-   FogCoordArray -> CapFogCoordArray-   SecondaryColorArray -> CapSecondaryColorArray-   MatrixIndexArray -> CapMatrixIndexArray------------------------------------------------------------------------------------arrayPointer :: ClientArrayType -> StateVar (VertexArrayDescriptor a)-arrayPointer t = case t of-   VertexArray -> vertexPointer-   NormalArray -> normalPointer-   ColorArray -> colorPointer-   IndexArray -> indexPointer-   TextureCoordArray -> texCoordPointer-   EdgeFlagArray -> edgeFlagPointer-   FogCoordArray -> fogCoordPointer-   SecondaryColorArray -> secondaryColorPointer-   MatrixIndexArray ->-      makeStateVar-        (do recordInvalidEnum ; return noVertexArrayDescriptor)-        (const recordInvalidEnum)--check :: Bool -> IO () -> IO ()-check flag val = if flag then val else recordInvalidValue------------------------------------------------------------------------------------vertexPointer :: StateVar (VertexArrayDescriptor a)-vertexPointer = makeStateVar getVertexPointer setVertexPointer--getVertexPointer :: IO (VertexArrayDescriptor a)-getVertexPointer = do-   n <- getInteger1 id GetVertexArraySize-   d <- getEnum1 unmarshalDataType GetVertexArrayType-   s <- getInteger1 fromIntegral GetVertexArrayStride-   p <- getPointer VertexArrayPointer-   return $ VertexArrayDescriptor n d s p--setVertexPointer :: VertexArrayDescriptor a -> IO ()-setVertexPointer (VertexArrayDescriptor n d s p) =-   glVertexPointer n (marshalDataType d) s p------------------------------------------------------------------------------------normalPointer :: StateVar (VertexArrayDescriptor a)-normalPointer = makeStateVar getNormalPointer setNormalPointer--getNormalPointer :: IO (VertexArrayDescriptor a)-getNormalPointer = do-   d <- getEnum1 unmarshalDataType GetNormalArrayType-   s <- getInteger1 fromIntegral GetNormalArrayStride-   p <- getPointer NormalArrayPointer-   return $ VertexArrayDescriptor 3 d s p--setNormalPointer :: VertexArrayDescriptor a -> IO ()-setNormalPointer (VertexArrayDescriptor n d s p) =-   check (n == 3) $ glNormalPointer (marshalDataType d) s p------------------------------------------------------------------------------------colorPointer :: StateVar (VertexArrayDescriptor a)-colorPointer = makeStateVar getColorPointer setColorPointer--getColorPointer :: IO (VertexArrayDescriptor a)-getColorPointer = do-   n <- getInteger1 id GetColorArraySize-   d <- getEnum1 unmarshalDataType GetColorArrayType-   s <- getInteger1 fromIntegral GetColorArrayStride-   p <- getPointer ColorArrayPointer-   return $ VertexArrayDescriptor n d s p--setColorPointer :: VertexArrayDescriptor a -> IO ()-setColorPointer (VertexArrayDescriptor n d s p) =-   check (n == 3 || n == 4) $ glColorPointer n (marshalDataType d) s p------------------------------------------------------------------------------------indexPointer :: StateVar (VertexArrayDescriptor a)-indexPointer = makeStateVar getIndexPointer setIndexPointer--getIndexPointer :: IO (VertexArrayDescriptor a)-getIndexPointer = do-   d <- getEnum1 unmarshalDataType GetIndexArrayType-   s <- getInteger1 fromIntegral GetIndexArrayStride-   p <- getPointer IndexArrayPointer-   return $ VertexArrayDescriptor 1 d s p--setIndexPointer :: VertexArrayDescriptor a -> IO ()-setIndexPointer (VertexArrayDescriptor n d s p) =-   check (n == 1) $ glIndexPointer (marshalDataType d) s p------------------------------------------------------------------------------------texCoordPointer :: StateVar (VertexArrayDescriptor a)-texCoordPointer = makeStateVar getTexCoordPointer setTexCoordPointer--getTexCoordPointer :: IO (VertexArrayDescriptor a)-getTexCoordPointer = do-   n <- getInteger1 id GetTextureCoordArraySize-   d <- getEnum1 unmarshalDataType GetTextureCoordArrayType-   s <- getInteger1 fromIntegral GetTextureCoordArrayStride-   p <- getPointer TextureCoordArrayPointer-   return $ VertexArrayDescriptor n d s p--setTexCoordPointer :: VertexArrayDescriptor a -> IO ()-setTexCoordPointer (VertexArrayDescriptor n d s p) =-   glTexCoordPointer n (marshalDataType d) s p------------------------------------------------------------------------------------edgeFlagPointer :: StateVar (VertexArrayDescriptor a)-edgeFlagPointer = makeStateVar getEdgeFlagPointer setEdgeFlagPointer--getEdgeFlagPointer :: IO (VertexArrayDescriptor a)-getEdgeFlagPointer = do-   s <- getInteger1 fromIntegral GetEdgeFlagArrayStride-   p <- getPointer EdgeFlagArrayPointer-   return $ VertexArrayDescriptor 1 UnsignedByte s p--setEdgeFlagPointer :: VertexArrayDescriptor a -> IO ()-setEdgeFlagPointer (VertexArrayDescriptor n d s p) =-   check (n == 1 && d == UnsignedByte) $ glEdgeFlagPointer s p------------------------------------------------------------------------------------fogCoordPointer :: StateVar (VertexArrayDescriptor a)-fogCoordPointer = makeStateVar getFogCoordPointer setFogCoordPointer--getFogCoordPointer :: IO (VertexArrayDescriptor a)-getFogCoordPointer = do-   d <- getEnum1 unmarshalDataType GetFogCoordArrayType-   s <- getInteger1 fromIntegral GetFogCoordArrayStride-   p <- getPointer FogCoordArrayPointer-   return $ VertexArrayDescriptor 1 d s p--setFogCoordPointer :: VertexArrayDescriptor a -> IO ()-setFogCoordPointer (VertexArrayDescriptor n d s p) =-   check (n == 1) $ glFogCoordPointer (marshalDataType d) s p------------------------------------------------------------------------------------secondaryColorPointer :: StateVar (VertexArrayDescriptor a)-secondaryColorPointer =-   makeStateVar getSecondaryColorPointer setSecondaryColorPointer--getSecondaryColorPointer :: IO (VertexArrayDescriptor a)-getSecondaryColorPointer = do-   n <- getInteger1 id GetSecondaryColorArraySize-   d <- getEnum1 unmarshalDataType GetSecondaryColorArrayType-   s <- getInteger1 fromIntegral GetSecondaryColorArrayStride-   p <- getPointer SecondaryColorArrayPointer-   return $ VertexArrayDescriptor n d s p--setSecondaryColorPointer :: (VertexArrayDescriptor a) -> IO ()-setSecondaryColorPointer (VertexArrayDescriptor n d s p) =-   glSecondaryColorPointer n (marshalDataType d) s p------------------------------------------------------------------------------------data InterleavedArrays =-     V2f-   | V3f-   | C4ubV2f-   | C4ubV3f-   | C3fV3f-   | N3fV3f-   | C4fN3fV3f-   | T2fV3f-   | T4fV4f-   | T2fC4ubV3f-   | T2fC3fV3f-   | T2fN3fV3f-   | T2fC4fN3fV3f-   | T4fC4fN3fV4f-   deriving ( Eq, Ord, Show )--marshalInterleavedArrays :: InterleavedArrays -> GLenum-marshalInterleavedArrays x = case x of-   V2f -> gl_V2F-   V3f -> gl_V3F-   C4ubV2f -> gl_C4UB_V2F-   C4ubV3f -> gl_C4UB_V3F-   C3fV3f -> gl_C3F_V3F-   N3fV3f -> gl_N3F_V3F-   C4fN3fV3f -> gl_C4F_N3F_V3F-   T2fV3f -> gl_T2F_V3F-   T4fV4f -> gl_T4F_V4F-   T2fC4ubV3f -> gl_T2F_C4UB_V3F-   T2fC3fV3f -> gl_T2F_C3F_V3F-   T2fN3fV3f -> gl_T2F_N3F_V3F-   T2fC4fN3fV3f -> gl_T2F_C4F_N3F_V3F-   T4fC4fN3fV4f -> gl_T4F_C4F_N3F_V4F------------------------------------------------------------------------------------interleavedArrays :: InterleavedArrays -> Stride -> Ptr a -> IO ()-interleavedArrays = glInterleavedArrays . marshalInterleavedArrays------------------------------------------------------------------------------------clientState :: ClientArrayType -> StateVar Capability-clientState arrayType =-   makeStateVar (getClientState arrayType) (setClientState arrayType)--getClientState :: ClientArrayType -> IO Capability-getClientState arrayType = get . makeCapability . clientArrayTypeToEnableCap $ arrayType--setClientState :: ClientArrayType -> Capability -> IO ()-setClientState arrayType val =-   (if val == Enabled then glEnableClientState else glDisableClientState)-      (marshalClientArrayType arrayType)------------------------------------------------------------------------------------clientActiveTexture :: StateVar TextureUnit-clientActiveTexture =-   makeStateVar (getEnum1 unmarshalTextureUnit GetClientActiveTexture)-                (glClientActiveTexture . marshalTextureUnit)------------------------------------------------------------------------------------type ArrayIndex = GLint--type NumArrayIndices = GLsizei--type NumIndexBlocks = GLsizei------------------------------------------------------------------------------------arrayElement :: ArrayIndex -> IO ()-arrayElement = glArrayElement--drawArrays :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> IO ()-drawArrays = glDrawArrays . marshalPrimitiveMode--multiDrawArrays ::-      PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks-   -> IO ()-multiDrawArrays = glMultiDrawArrays . marshalPrimitiveMode--drawElements :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> IO ()-drawElements m c = glDrawElements (marshalPrimitiveMode m) c . marshalDataType--multiDrawElements ::-      PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a)-   -> NumIndexBlocks -> IO ()-multiDrawElements m c =-   glMultiDrawElements (marshalPrimitiveMode m) c . marshalDataType--drawRangeElements ::-      PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType-   -> Ptr a -> IO ()-drawRangeElements m (s, e) c =-   glDrawRangeElements (marshalPrimitiveMode m) (fromIntegral s)-                       (fromIntegral e) c . marshalDataType--maxElementsVertices :: GettableStateVar NumArrayIndices-maxElementsVertices = makeGettableStateVar (getSizei1 id GetMaxElementsVertices)--maxElementsIndices :: GettableStateVar NumArrayIndices-maxElementsIndices = makeGettableStateVar (getSizei1 id GetMaxElementsIndices)------------------------------------------------------------------------------------lockArrays :: StateVar (Maybe (ArrayIndex, NumArrayIndices))-lockArrays = makeStateVar getLockArrays setLockArrays--getLockArrays :: IO (Maybe (ArrayIndex, NumArrayIndices))-getLockArrays = do-   count <- getInteger1 fromIntegral GetArrayElementLockCount-   if count > 0-      then do first <- getInteger1 id GetArrayElementLockFirst-              return $ Just (first, count)-      else return Nothing--setLockArrays :: Maybe (ArrayIndex, NumArrayIndices) -> IO ()-setLockArrays = maybe glUnlockArrays (uncurry glLockArrays)------------------------------------------------------------------------------------primitiveRestartIndex :: StateVar (Maybe ArrayIndex)-primitiveRestartIndex =-   makeStateVarMaybe-      (return CapPrimitiveRestart)-      (getInteger1 id GetPrimitiveRestartIndex)-      (glPrimitiveRestartIndex . fromIntegral)-------------------------------------------------------------------------------------- We almost could use makeStateVarMaybe below, but, alas, this is client state.--primitiveRestartIndexNV :: StateVar (Maybe ArrayIndex)-primitiveRestartIndexNV =-   makeStateVar getPrimitiveRestartIndexNV setPrimitiveRestartIndexNV--getPrimitiveRestartIndexNV :: IO (Maybe ArrayIndex)-getPrimitiveRestartIndexNV = do-   on <- getBoolean1 unmarshalGLboolean GetPrimitiveRestartNV-   if on-      then fmap Just $ getInteger1 fromIntegral GetPrimitiveRestartIndexNV-      else return Nothing--setPrimitiveRestartIndexNV :: Maybe ArrayIndex -> IO ()-setPrimitiveRestartIndexNV maybeIdx = case maybeIdx of-   Nothing  -> glDisableClientState gl_PRIMITIVE_RESTART_NV-   Just idx -> do glEnableClientState gl_PRIMITIVE_RESTART_NV-                  glPrimitiveRestartIndexNV (fromIntegral idx)------------------------------------------------------------------------------------data GetPointervPName =-     VertexArrayPointer-   | NormalArrayPointer-   | ColorArrayPointer-   | IndexArrayPointer-   | TextureCoordArrayPointer-   | EdgeFlagArrayPointer-   | FogCoordArrayPointer-   | SecondaryColorArrayPointer-   | FeedbackBufferPointer-   | SelectionBufferPointer-   | WeightArrayPointer-   | MatrixIndexArrayPointer--marshalGetPointervPName :: GetPointervPName -> GLenum-marshalGetPointervPName x = case x of-   VertexArrayPointer -> gl_VERTEX_ARRAY_POINTER-   NormalArrayPointer -> gl_NORMAL_ARRAY_POINTER-   ColorArrayPointer -> gl_COLOR_ARRAY_POINTER-   IndexArrayPointer -> gl_INDEX_ARRAY_POINTER-   TextureCoordArrayPointer -> gl_TEXTURE_COORD_ARRAY_POINTER-   EdgeFlagArrayPointer -> gl_EDGE_FLAG_ARRAY_POINTER-   FogCoordArrayPointer -> gl_FOG_COORD_ARRAY_POINTER-   SecondaryColorArrayPointer -> gl_SECONDARY_COLOR_ARRAY_POINTER-   FeedbackBufferPointer -> gl_FEEDBACK_BUFFER_POINTER-   SelectionBufferPointer -> gl_SELECTION_BUFFER_POINTER-   WeightArrayPointer -> gl_WEIGHT_ARRAY_POINTER-   MatrixIndexArrayPointer -> gl_MATRIX_INDEX_ARRAY_POINTER------------------------------------------------------------------------------------getPointer :: GetPointervPName -> IO (Ptr a)-getPointer n = alloca $ \buf -> do-   glGetPointerv (marshalGetPointervPName n) buf-   peek buf------------------------------------------------------------------------------------vertexAttribPointer :: AttribLocation -> StateVar (IntegerHandling, VertexArrayDescriptor a)-vertexAttribPointer location =-   makeStateVar (getVertexAttribPointer_ location) (setVertexAttribPointer location)--getVertexAttribPointer_ :: AttribLocation -> IO (IntegerHandling, VertexArrayDescriptor a)-getVertexAttribPointer_ location = do-   i <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayInteger-   h <- if i-           then return KeepIntegral-           else do f <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayNormalized-                   return $ if f then ToNormalizedFloat else ToFloat-   n <- getVertexAttribInteger1 id location GetVertexAttribArraySize-   d <- getVertexAttribEnum1 unmarshalDataType location GetVertexAttribArrayType-   s <- getVertexAttribInteger1 fromIntegral location GetVertexAttribArrayStride-   p <- getVertexAttribPointer location VertexAttribArrayPointer-   return (h, VertexArrayDescriptor n d s p)--setVertexAttribPointer :: AttribLocation -> (IntegerHandling, VertexArrayDescriptor a) -> IO ()-setVertexAttribPointer (AttribLocation location) (h, VertexArrayDescriptor n d s p) = case h of-   ToFloat -> glVertexAttribPointer location n md (marshalGLboolean False) s p-   ToNormalizedFloat -> glVertexAttribPointer location n md (marshalGLboolean True) s p-   KeepIntegral -> glVertexAttribIPointer location n md s p-  where md = marshalDataType d------------------------------------------------------------------------------------vertexAttribArray :: AttribLocation -> StateVar Capability-vertexAttribArray location =-   makeStateVar (getVertexAttribArray location) (flip setVertexAttribArray location)--getVertexAttribArray :: AttribLocation -> IO Capability-getVertexAttribArray location =-   getVertexAttribBoolean1 unmarshalCapability location GetVertexAttribArrayEnabled--setVertexAttribArray :: Capability -> AttribLocation -> IO ()-setVertexAttribArray Disabled (AttribLocation location) = glDisableVertexAttribArray location-setVertexAttribArray Enabled (AttribLocation location) = glEnableVertexAttribArray location
− Graphics/Rendering/OpenGL/GL/VertexAttributes.hs 
@@ -1,332 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.VertexAttributes--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module for auxiliary vertex attributes.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.VertexAttributes (-   TexCoord1(..), TexCoord2(..), TexCoord3(..), TexCoord4(..),-   Normal3(..),-   FogCoord1(..),-   Color3(..), Color4(..),-   Index1(..)-) where--import Control.Applicative-import Control.Monad-import Data.Foldable-import Data.Ix-import Data.Traversable-import Data.Typeable-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-------------------------------------------------------------------------------------- | Texture coordinates with /t/=0, /r/=0, and /q/=1.-newtype TexCoord1 a = TexCoord1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor TexCoord1 where-   fmap f (TexCoord1 x) = TexCoord1 (f x)--instance Applicative TexCoord1 where-   pure a = TexCoord1 a-   TexCoord1 f <*> TexCoord1 x = TexCoord1 (f x)--instance Foldable TexCoord1 where-   foldr f a (TexCoord1 x) = x `f ` a-   foldl f a (TexCoord1 x) = a `f` x-   foldr1 _ (TexCoord1 x) = x-   foldl1 _ (TexCoord1 x) = x--instance Traversable TexCoord1 where-   traverse f (TexCoord1 x) = pure TexCoord1 <*> f x-   sequenceA (TexCoord1 x) =  pure TexCoord1 <*> x-   mapM f (TexCoord1 x) = return TexCoord1 `ap` f x-   sequence (TexCoord1 x) = return TexCoord1 `ap` x--instance Storable a => Storable (TexCoord1 a) where-   sizeOf    ~(TexCoord1 s) = sizeOf s-   alignment ~(TexCoord1 s) = alignment s-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- | Texture coordinates with /r/=0 and /q/=1.-data TexCoord2 a = TexCoord2 !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor TexCoord2 where-   fmap f (TexCoord2 x y) = TexCoord2 (f x) (f y)--instance Applicative TexCoord2 where-   pure a = TexCoord2 a a-   TexCoord2 f g <*> TexCoord2 x y = TexCoord2 (f x) (g y)--instance Foldable TexCoord2 where-   foldr f a (TexCoord2 x y) = x `f ` (y `f` a)-   foldl f a (TexCoord2 x y) = (a `f` x) `f` y-   foldr1 f (TexCoord2 x y) = x `f` y-   foldl1 f (TexCoord2 x y) = x `f` y--instance Traversable TexCoord2 where-   traverse f (TexCoord2 x y) = pure TexCoord2 <*> f x <*> f y-   sequenceA (TexCoord2 x y) =  pure TexCoord2 <*> x <*> y-   mapM f (TexCoord2 x y) = return TexCoord2 `ap` f x `ap` f y-   sequence (TexCoord2 x y) = return TexCoord2 `ap` x `ap` y--instance Storable a => Storable (TexCoord2 a) where-   sizeOf ~(TexCoord2 x _) = 2 * sizeOf x-   alignment ~(TexCoord2 x _) = alignment x-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- | Texture coordinates with /q/=1.-data TexCoord3 a = TexCoord3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor TexCoord3 where-   fmap f (TexCoord3 x y z) = TexCoord3 (f x) (f y) (f z)--instance Applicative TexCoord3 where-   pure a = TexCoord3 a a a-   TexCoord3 f g h <*> TexCoord3 x y z = TexCoord3 (f x) (g y) (h z)--instance Foldable TexCoord3 where-   foldr f a (TexCoord3 x y z) = x `f ` (y `f` (z `f` a))-   foldl f a (TexCoord3 x y z) = ((a `f` x) `f` y) `f` z-   foldr1 f (TexCoord3 x y z) = x `f` (y `f` z)-   foldl1 f (TexCoord3 x y z) = (x `f` y) `f` z--instance Traversable TexCoord3 where-   traverse f (TexCoord3 x y z) = pure TexCoord3 <*> f x <*> f y <*> f z-   sequenceA (TexCoord3 x y z) =  pure TexCoord3 <*> x <*> y <*> z-   mapM f (TexCoord3 x y z) = return TexCoord3 `ap` f x `ap` f y `ap` f z-   sequence (TexCoord3 x y z) = return TexCoord3 `ap` x `ap` y `ap` z--instance Storable a => Storable (TexCoord3 a) where-   sizeOf ~(TexCoord3 x _ _) = 3 * sizeOf x-   alignment ~(TexCoord3 x _ _) = alignment x-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- | Fully-fledged four-dimensional texture coordinates.-data TexCoord4 a = TexCoord4 !a !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor TexCoord4 where-   fmap f (TexCoord4 x y z w) = TexCoord4 (f x) (f y) (f z) (f w)--instance Applicative TexCoord4 where-   pure a = TexCoord4 a a a a-   TexCoord4 f g h i <*> TexCoord4 x y z w = TexCoord4 (f x) (g y) (h z) (i w)--instance Foldable TexCoord4 where-   foldr f a (TexCoord4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))-   foldl f a (TexCoord4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w-   foldr1 f (TexCoord4 x y z w) = x `f` (y `f` (z `f` w))-   foldl1 f (TexCoord4 x y z w) = ((x `f` y) `f` z) `f` w--instance Traversable TexCoord4 where-   traverse f (TexCoord4 x y z w) = pure TexCoord4 <*> f x <*> f y <*> f z <*> f w-   sequenceA (TexCoord4 x y z w) =  pure TexCoord4 <*> x <*> y <*> z <*> w-   mapM f (TexCoord4 x y z w) = return TexCoord4 `ap` f x `ap` f y `ap` f z `ap` f w-   sequence (TexCoord4 x y z w) = return TexCoord4 `ap` x `ap` y `ap` z `ap` w--instance Storable a => Storable (TexCoord4 a) where-   sizeOf ~(TexCoord4 x _ _ _) = 4 * sizeOf x-   alignment ~(TexCoord4 x _ _ _) = alignment x-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- A three-dimensional normal.-data Normal3 a = Normal3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable) -instance Functor Normal3 where-   fmap f (Normal3 x y z) = Normal3 (f x) (f y) (f z)--instance Applicative Normal3 where-   pure a = Normal3 a a a-   Normal3 f g h <*> Normal3 x y z = Normal3 (f x) (g y) (h z)--instance Foldable Normal3 where-   foldr f a (Normal3 x y z) = x `f ` (y `f` (z `f` a))-   foldl f a (Normal3 x y z) = ((a `f` x) `f` y) `f` z-   foldr1 f (Normal3 x y z) = x `f` (y `f` z)-   foldl1 f (Normal3 x y z) = (x `f` y) `f` z--instance Traversable Normal3 where-   traverse f (Normal3 x y z) = pure Normal3 <*> f x <*> f y <*> f z-   sequenceA (Normal3 x y z) =  pure Normal3 <*> x <*> y <*> z-   mapM f (Normal3 x y z) = return Normal3 `ap` f x `ap` f y `ap` f z-   sequence (Normal3 x y z) = return Normal3 `ap` x `ap` y `ap` z--instance Storable a => Storable (Normal3 a) where-   sizeOf ~(Normal3 x _ _) = 3 * sizeOf x-   alignment ~(Normal3 x _ _) = alignment x-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- | A fog coordinate.-newtype FogCoord1 a = FogCoord1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor FogCoord1 where-   fmap f (FogCoord1 x) = FogCoord1 (f x)--instance Applicative FogCoord1 where-   pure a = FogCoord1 a-   FogCoord1 f <*> FogCoord1 x = FogCoord1 (f x)--instance Foldable FogCoord1 where-   foldr f a (FogCoord1 x) = x `f ` a-   foldl f a (FogCoord1 x)  = a `f` x-   foldr1 _ (FogCoord1 x) = x-   foldl1 _ (FogCoord1 x) = x--instance Traversable FogCoord1 where-   traverse f (FogCoord1 x) = pure FogCoord1 <*> f x-   sequenceA (FogCoord1 x) =  pure FogCoord1 <*> x-   mapM f (FogCoord1 x) = return FogCoord1 `ap` f x-   sequence (FogCoord1 x) = return FogCoord1 `ap` x--instance Storable a => Storable (FogCoord1 a) where-   sizeOf    ~(FogCoord1 s) = sizeOf s-   alignment ~(FogCoord1 s) = alignment s-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- An RGBA color with /A/=1.-data Color3 a = Color3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor Color3 where-   fmap f (Color3 x y z) = Color3 (f x) (f y) (f z)--instance Applicative Color3 where-   pure a = Color3 a a a-   Color3 f g h <*> Color3 x y z = Color3 (f x) (g y) (h z)--instance Foldable Color3 where-   foldr f a (Color3 x y z) = x `f ` (y `f` (z `f` a))-   foldl f a (Color3 x y z) = ((a `f` x) `f` y) `f` z-   foldr1 f (Color3 x y z) = x `f` (y `f` z)-   foldl1 f (Color3 x y z) = (x `f` y) `f` z--instance Traversable Color3 where-   traverse f (Color3 x y z) = pure Color3 <*> f x <*> f y <*> f z-   sequenceA (Color3 x y z) =  pure Color3 <*> x <*> y <*> z-   mapM f (Color3 x y z) = return Color3 `ap` f x `ap` f y `ap` f z-   sequence (Color3 x y z) = return Color3 `ap` x `ap` y `ap` z--instance Storable a => Storable (Color3 a) where-   sizeOf ~(Color3 x _ _) = 3 * sizeOf x-   alignment ~(Color3 x _ _) = alignment x-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- | A fully-fledged RGBA color.-data Color4 a = Color4 !a !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor Color4 where-   fmap f (Color4 x y z w) = Color4 (f x) (f y) (f z) (f w)--instance Applicative Color4 where-   pure a = Color4 a a a a-   Color4 f g h i <*> Color4 x y z w = Color4 (f x) (g y) (h z) (i w)--instance Foldable Color4 where-   foldr f a (Color4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))-   foldl f a (Color4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w-   foldr1 f (Color4 x y z w) = x `f` (y `f` (z `f` w))-   foldl1 f (Color4 x y z w) = ((x `f` y) `f` z) `f` w--instance Traversable Color4 where-   traverse f (Color4 x y z w) = pure Color4 <*> f x <*> f y <*> f z <*> f w-   sequenceA (Color4 x y z w) =  pure Color4 <*> x <*> y <*> z <*> w-   mapM f (Color4 x y z w) = return Color4 `ap` f x `ap` f y `ap` f z `ap` f w-   sequence (Color4 x y z w) = return Color4 `ap` x `ap` y `ap` z `ap` w--instance Storable a => Storable (Color4 a) where-   sizeOf ~(Color4 x _ _ _) = 4 * sizeOf x-   alignment ~(Color4 x _ _ _) = alignment x-   peek = peekApplicativeTraversable-   poke = pokeFoldable-------------------------------------------------------------------------------------- | A color index.-newtype Index1 a = Index1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)--instance Functor Index1 where-   fmap f (Index1 x) = Index1 (f x)--instance Applicative Index1 where-   pure a = Index1 a-   Index1 f <*> Index1 x = Index1 (f x)--instance Foldable Index1 where-   foldr f a (Index1 x) = x `f ` a-   foldl f a (Index1 x)  = a `f` x-   foldr1 _ (Index1 x) = x-   foldl1 _ (Index1 x) = x--instance Traversable Index1 where-   traverse f (Index1 x) = pure Index1 <*> f x-   sequenceA (Index1 x) =  pure Index1 <*> x-   mapM f (Index1 x) = return Index1 `ap` f x-   sequence (Index1 x) = return Index1 `ap` x--instance Storable a => Storable (Index1 a) where-   sizeOf    ~(Index1 s) = sizeOf s-   alignment ~(Index1 s) = alignment s-   peek = peekApplicativeTraversable-   poke = pokeFoldable------------------------------------------------------------------------------------peekApplicativeTraversable :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> IO (t a)-peekApplicativeTraversable = Data.Traversable.mapM peek . addresses--addresses :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> t (Ptr a)-addresses = snd . mapAccumL nextPtr 0 . pure . castPtr--nextPtr :: Storable a => Int -> Ptr a -> (Int, Ptr a)-nextPtr offset ptr = (offset + 1, advancePtr ptr offset)------------------------------------------------------------------------------------pokeFoldable :: (Foldable t, Storable a) => Ptr (t a) -> t a -> IO ()-pokeFoldable ptr xs = foldlM pokeAndAdvance (castPtr ptr) xs >> return ()--pokeAndAdvance :: Storable a => Ptr a -> a -> IO (Ptr a)-pokeAndAdvance ptr value = do-   poke ptr value-   return $ ptr `plusPtr` sizeOf value
− Graphics/Rendering/OpenGL/GL/VertexSpec.hs 
@@ -1,1075 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.VertexSpec--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.7 (Vertex Specification) of the--- OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.VertexSpec (-   -- * Vertex Coordinates-   Vertex(..),-   VertexComponent,--   -- * Auxiliary Vertex Attributes-   -- $AuxiliaryVertexAttributes--   -- ** Texture Coordinates-   currentTextureCoords, TexCoord(..),-   TexCoordComponent,-   TexCoord1(..), TexCoord2(..), TexCoord3(..), TexCoord4(..),--   -- ** Normal-   currentNormal, Normal(..),-   NormalComponent,-   Normal3(..),--   -- ** Fog Coordinate-   currentFogCoord, FogCoord(..),-   FogCoordComponent,-   FogCoord1(..),--   -- ** Color and Secondary Color-   rgbaMode,-   currentColor, Color(..),-   currentSecondaryColor, SecondaryColor(..),-   ColorComponent,-   Color3(..), Color4(..),--   currentIndex, Index(..),-   IndexComponent,-   Index1(..),--   -- * Generic Vertex Attributes-   IntegerHandling(..), AttribLocation(..),-   currentVertexAttrib, currentVertexAttribI, currentVertexAttribIu,-   VertexAttrib(..), VertexAttribComponent(..),--   -- * Texture Units-   TextureUnit(..), maxTextureUnit-) where--import Data.StateVar-import Data.Tensor-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.PeekPoke-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit-import Graphics.Rendering.OpenGL.GL.VertexAttributes-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (-   glColor3b, glColor3bv, glColor3d, glColor3dv, glColor3f, glColor3fv,-   glColor3i, glColor3iv, glColor3s, glColor3sv, glColor3ub, glColor3ubv,-   glColor3ui, glColor3uiv, glColor3us, glColor3usv, glColor4b, glColor4bv,-   glColor4d, glColor4dv, glColor4f, glColor4fv, glColor4i, glColor4iv,-   glColor4s, glColor4sv, glColor4ub, glColor4ubv, glColor4ui, glColor4uiv,-   glColor4us, glColor4usv, glFogCoordd, glFogCoorddv, glFogCoordf,-   glFogCoordfv, glIndexd, glIndexdv, glIndexf, glIndexfv, glIndexi, glIndexiv,-   glIndexs, glIndexsv, glIndexub, glIndexubv, glMultiTexCoord1d,-   glMultiTexCoord1dv, glMultiTexCoord1f, glMultiTexCoord1fv, glMultiTexCoord1i,-   glMultiTexCoord1iv, glMultiTexCoord1s, glMultiTexCoord1sv, glMultiTexCoord2d,-   glMultiTexCoord2dv, glMultiTexCoord2f, glMultiTexCoord2fv, glMultiTexCoord2i,-   glMultiTexCoord2iv, glMultiTexCoord2s, glMultiTexCoord2sv, glMultiTexCoord3d,-   glMultiTexCoord3dv, glMultiTexCoord3f, glMultiTexCoord3fv, glMultiTexCoord3i,-   glMultiTexCoord3iv, glMultiTexCoord3s, glMultiTexCoord3sv, glMultiTexCoord4d,-   glMultiTexCoord4dv, glMultiTexCoord4f, glMultiTexCoord4fv, glMultiTexCoord4i,-   glMultiTexCoord4iv, glMultiTexCoord4s, glMultiTexCoord4sv, glNormal3b,-   glNormal3bv, glNormal3d, glNormal3dv, glNormal3f, glNormal3fv, glNormal3i,-   glNormal3iv, glNormal3s, glNormal3sv, glSecondaryColor3b,-   glSecondaryColor3bv, glSecondaryColor3d, glSecondaryColor3dv,-   glSecondaryColor3f, glSecondaryColor3fv, glSecondaryColor3i,-   glSecondaryColor3iv, glSecondaryColor3s, glSecondaryColor3sv,-   glSecondaryColor3ub, glSecondaryColor3ubv, glSecondaryColor3ui,-   glSecondaryColor3uiv, glSecondaryColor3us, glSecondaryColor3usv,-   glTexCoord1d, glTexCoord1dv, glTexCoord1f, glTexCoord1fv, glTexCoord1i,-   glTexCoord1iv, glTexCoord1s, glTexCoord1sv, glTexCoord2d, glTexCoord2dv,-   glTexCoord2f, glTexCoord2fv, glTexCoord2i, glTexCoord2iv, glTexCoord2s,-   glTexCoord2sv, glTexCoord3d, glTexCoord3dv, glTexCoord3f, glTexCoord3fv,-   glTexCoord3i, glTexCoord3iv, glTexCoord3s, glTexCoord3sv, glTexCoord4d,-   glTexCoord4dv, glTexCoord4f, glTexCoord4fv, glTexCoord4i, glTexCoord4iv,-   glTexCoord4s, glTexCoord4sv, glVertex2d, glVertex2dv, glVertex2f,-   glVertex2fv, glVertex2i, glVertex2iv, glVertex2s, glVertex2sv, glVertex3d,-   glVertex3dv, glVertex3f, glVertex3fv, glVertex3i, glVertex3iv, glVertex3s,-   glVertex3sv, glVertex4d, glVertex4dv, glVertex4f, glVertex4fv, glVertex4i,-   glVertex4iv, glVertex4s, glVertex4sv )-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | The class of all types which can be used as a vertex coordinate.--class VertexComponent a where-   vertex2 :: a -> a -> IO ()-   vertex3 :: a -> a -> a -> IO ()-   vertex4 :: a -> a -> a -> a -> IO ()--   vertex2v :: Ptr a -> IO ()-   vertex3v :: Ptr a -> IO ()-   vertex4v :: Ptr a -> IO ()--instance VertexComponent GLshort where-   vertex2 = glVertex2s-   vertex3 = glVertex3s-   vertex4 = glVertex4s--   vertex2v = glVertex2sv-   vertex3v = glVertex3sv-   vertex4v = glVertex4sv--instance VertexComponent GLint where-   vertex2 = glVertex2i-   vertex3 = glVertex3i-   vertex4 = glVertex4i--   vertex2v = glVertex2iv-   vertex3v = glVertex3iv-   vertex4v = glVertex4iv--instance VertexComponent GLfloat where-   vertex2 = glVertex2f-   vertex3 = glVertex3f-   vertex4 = glVertex4f--   vertex2v = glVertex2fv-   vertex3v = glVertex3fv-   vertex4v = glVertex4fv--instance VertexComponent GLdouble where-   vertex2 = glVertex2d-   vertex3 = glVertex3d-   vertex4 = glVertex4d--   vertex2v = glVertex2dv-   vertex3v = glVertex3dv-   vertex4v = glVertex4dv-------------------------------------------------------------------------------------- | Specify the (/x/, /y/, /z/, /w/) coordinates of a four-dimensional vertex.--- This must only be done during--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive', otherwise the--- behaviour is unspecified. The current values of the auxiliary vertex--- attributes are associated with the vertex.--- --- Note that there is no such thing as a \"current vertex\" which could be--- retrieved.--class Vertex a where-   vertex  ::     a -> IO ()-   vertexv :: Ptr a -> IO ()--instance VertexComponent a => Vertex (Vertex2 a) where-   vertex (Vertex2 x y) = vertex2 x y-   vertexv = vertex2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)--instance VertexComponent a => Vertex (Vertex3 a) where-   vertex (Vertex3 x y z) = vertex3 x y z-   vertexv = vertex3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)--instance VertexComponent a => Vertex (Vertex4 a) where-   vertex (Vertex4 x y z w) = vertex4 x y z w-   vertexv = vertex4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)------------------------------------------------------------------------------------- $AuxiliaryVertexAttributes--- Apart from its coordinates in four-dimensional space, every vertex has--- associated /auxiliary attributes/: Its texture coordinates, a normal, a--- fog coordinate, and a color plus a secondary color. For every attribute, the--- OpenGL state contains its current value, which can be changed at any time.------ Every attribute has a \"natural\" format via which it can be manipulated--- directly as part of the OpenGL state, e.g. the current texture coordinates--- are internally handled as @'TexCoord4' 'GLfloat'@. Different formats are--- converted to this format, e.g. the /s/, /r/, and /t/ coordinates of a--- @'TexCoord3' 'GLint'@ are converted to floating point values and a /q/--- coordinate of 1.0 is implicitly assumed.------ Consequently, the vast majority of classes, functions, and data types in this--- module are for convenience only and offer no additional functionality.-------------------------------------------------------------------------------------- | The current texture coordinates (/s/, /t/, /r/, /q/) for the current--- texture unit (see 'Graphics.Rendering.OpenGL.GL.CoordTrans.activeTexture').--- The initial value is (0,0,0,1) for all texture units.--currentTextureCoords :: StateVar (TexCoord4 GLfloat)-currentTextureCoords =-   makeStateVar (getFloat4 TexCoord4 GetCurrentTextureCoords) texCoord-------------------------------------------------------------------------------------- | The class of all types which can be used as a texture coordinate.--class TexCoordComponent a where-   texCoord1 :: a -> IO ()-   texCoord2 :: a -> a -> IO ()-   texCoord3 :: a -> a -> a -> IO ()-   texCoord4 :: a -> a -> a -> a -> IO ()--   texCoord1v :: Ptr a -> IO ()-   texCoord2v :: Ptr a -> IO ()-   texCoord3v :: Ptr a -> IO ()-   texCoord4v :: Ptr a -> IO ()--   multiTexCoord1 :: GLenum -> a -> IO ()-   multiTexCoord2 :: GLenum -> a -> a -> IO ()-   multiTexCoord3 :: GLenum -> a -> a -> a -> IO ()-   multiTexCoord4 :: GLenum -> a -> a -> a -> a -> IO ()--   multiTexCoord1v :: GLenum -> Ptr a -> IO ()-   multiTexCoord2v :: GLenum -> Ptr a -> IO ()-   multiTexCoord3v :: GLenum -> Ptr a -> IO ()-   multiTexCoord4v :: GLenum -> Ptr a -> IO ()--instance TexCoordComponent GLshort where-   texCoord1 = glTexCoord1s-   texCoord2 = glTexCoord2s-   texCoord3 = glTexCoord3s-   texCoord4 = glTexCoord4s--   texCoord1v = glTexCoord1sv-   texCoord2v = glTexCoord2sv-   texCoord3v = glTexCoord3sv-   texCoord4v = glTexCoord4sv--   multiTexCoord1 = glMultiTexCoord1s-   multiTexCoord2 = glMultiTexCoord2s-   multiTexCoord3 = glMultiTexCoord3s-   multiTexCoord4 = glMultiTexCoord4s--   multiTexCoord1v = glMultiTexCoord1sv-   multiTexCoord2v = glMultiTexCoord2sv-   multiTexCoord3v = glMultiTexCoord3sv-   multiTexCoord4v = glMultiTexCoord4sv--instance TexCoordComponent GLint where-   texCoord1 = glTexCoord1i-   texCoord2 = glTexCoord2i-   texCoord3 = glTexCoord3i-   texCoord4 = glTexCoord4i--   texCoord1v = glTexCoord1iv-   texCoord2v = glTexCoord2iv-   texCoord3v = glTexCoord3iv-   texCoord4v = glTexCoord4iv--   multiTexCoord1 = glMultiTexCoord1i-   multiTexCoord2 = glMultiTexCoord2i-   multiTexCoord3 = glMultiTexCoord3i-   multiTexCoord4 = glMultiTexCoord4i--   multiTexCoord1v = glMultiTexCoord1iv-   multiTexCoord2v = glMultiTexCoord2iv-   multiTexCoord3v = glMultiTexCoord3iv-   multiTexCoord4v = glMultiTexCoord4iv--instance TexCoordComponent GLfloat where-   texCoord1 = glTexCoord1f-   texCoord2 = glTexCoord2f-   texCoord3 = glTexCoord3f-   texCoord4 = glTexCoord4f--   texCoord1v = glTexCoord1fv-   texCoord2v = glTexCoord2fv-   texCoord3v = glTexCoord3fv-   texCoord4v = glTexCoord4fv--   multiTexCoord1 = glMultiTexCoord1f-   multiTexCoord2 = glMultiTexCoord2f-   multiTexCoord3 = glMultiTexCoord3f-   multiTexCoord4 = glMultiTexCoord4f--   multiTexCoord1v = glMultiTexCoord1fv-   multiTexCoord2v = glMultiTexCoord2fv-   multiTexCoord3v = glMultiTexCoord3fv-   multiTexCoord4v = glMultiTexCoord4fv--instance TexCoordComponent GLdouble where-   texCoord1 = glTexCoord1d-   texCoord2 = glTexCoord2d-   texCoord3 = glTexCoord3d-   texCoord4 = glTexCoord4d--   texCoord1v = glTexCoord1dv-   texCoord2v = glTexCoord2dv-   texCoord3v = glTexCoord3dv-   texCoord4v = glTexCoord4dv--   multiTexCoord1 = glMultiTexCoord1d-   multiTexCoord2 = glMultiTexCoord2d-   multiTexCoord3 = glMultiTexCoord3d-   multiTexCoord4 = glMultiTexCoord4d--   multiTexCoord1v = glMultiTexCoord1dv-   multiTexCoord2v = glMultiTexCoord2dv-   multiTexCoord3v = glMultiTexCoord3dv-   multiTexCoord4v = glMultiTexCoord4dv-------------------------------------------------------------------------------------- | Change the current texture coordinates of the current or given texture--- unit.--class TexCoord a where-   texCoord       ::                    a -> IO ()-   texCoordv      ::                Ptr a -> IO ()-   multiTexCoord  :: TextureUnit ->     a -> IO ()-   multiTexCoordv :: TextureUnit -> Ptr a -> IO ()--instance TexCoordComponent a => TexCoord (TexCoord1 a) where-   texCoord (TexCoord1 s) = texCoord1 s-   texCoordv = texCoord1v . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)-   multiTexCoord u (TexCoord1 s) =-      multiTexCoord1 (marshalTextureUnit u) s-   multiTexCoordv u =-      multiTexCoord1v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)--instance TexCoordComponent a => TexCoord (TexCoord2 a) where-   texCoord (TexCoord2 s t) = texCoord2 s t-   texCoordv = texCoord2v . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)-   multiTexCoord u (TexCoord2 s t) =-      multiTexCoord2 (marshalTextureUnit u) s t-   multiTexCoordv u =-      multiTexCoord2v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)--instance TexCoordComponent a => TexCoord (TexCoord3 a) where-   texCoord (TexCoord3 s t r) = texCoord3 s t r-   texCoordv = texCoord3v . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)-   multiTexCoord u (TexCoord3 s t r) =-      multiTexCoord3 (marshalTextureUnit u) s t r-   multiTexCoordv u =-      multiTexCoord3v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)--instance TexCoordComponent a => TexCoord (TexCoord4 a) where-   texCoord (TexCoord4 s t r q) = texCoord4 s t r q-   texCoordv = texCoord4v . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)-   multiTexCoord u (TexCoord4 s t r q) =-      multiTexCoord4 (marshalTextureUnit u) s t r q-   multiTexCoordv u =-      multiTexCoord4v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)-------------------------------------------------------------------------------------- | The current normal (/x/, /y/, /z/). The initial value is the unit vector--- (0, 0, 1).--currentNormal :: StateVar (Normal3 GLfloat)-currentNormal = makeStateVar (getFloat3 Normal3 GetCurrentNormal) normal-------------------------------------------------------------------------------------- | The class of all types which can be used as a component of a normal.--class NormalComponent a where-   normal3 :: a -> a -> a -> IO ()-   normal3v :: Ptr a -> IO ()--instance NormalComponent GLbyte where-   normal3 = glNormal3b-   normal3v = glNormal3bv--instance NormalComponent GLshort where-   normal3 = glNormal3s-   normal3v = glNormal3sv--instance NormalComponent GLint where-   normal3 = glNormal3i-   normal3v = glNormal3iv--instance NormalComponent GLfloat where-   normal3 = glNormal3f-   normal3v = glNormal3fv--instance NormalComponent GLdouble where-   normal3 = glNormal3d-   normal3v = glNormal3dv-------------------------------------------------------------------------------------- | Change the current normal. Integral arguments are converted to--- floating-point with a linear mapping that maps the most positive--- representable integer value to 1.0, and the most negative representable--- integer value to -1.0.------ Normals specified with 'normal' or 'normalv' need not have unit length.--- If 'Graphics.Rendering.OpenGL.GL.CoordTrans.normalize' is enabled, then--- normals of any length specified with 'normal' or 'normalv' are normalized--- after transformation. If--- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' is enabled, normals--- are scaled by a scaling factor derived from the modelview matrix.--- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' requires that the--- originally specified normals were of unit length, and that the modelview--- matrix contains only uniform scales for proper results. Normalization is --- initially disabled.--class Normal a where-   normal  ::     a -> IO ()-   normalv :: Ptr a -> IO ()--instance NormalComponent a => Normal (Normal3 a) where-   normal (Normal3 x y z) = normal3 x y z-   normalv = normal3v . (castPtr :: Ptr (Normal3 b) -> Ptr b)-------------------------------------------------------------------------------------- | The current fog coordinate. The initial value is 0.--currentFogCoord :: StateVar (FogCoord1 GLfloat)-currentFogCoord =-   makeStateVar (getFloat1 FogCoord1 GetCurrentFogCoord) fogCoord-------------------------------------------------------------------------------------- | The class of all types which can be used as the fog coordinate.--class FogCoordComponent a where-   fogCoord1 :: a -> IO ()-   fogCoord1v :: Ptr a -> IO ()--instance FogCoordComponent GLfloat where-   fogCoord1 = glFogCoordf-   fogCoord1v = glFogCoordfv--instance FogCoordComponent GLdouble where-   fogCoord1 = glFogCoordd-   fogCoord1v = glFogCoorddv-------------------------------------------------------------------------------------- | Change the current fog coordinate.--class FogCoord a where-   fogCoord  ::     a -> IO ()-   fogCoordv :: Ptr a -> IO ()--instance FogCoordComponent a => FogCoord (FogCoord1 a) where-   fogCoord (FogCoord1 c) = fogCoord1 c-   fogCoordv = fogCoord1v . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)-------------------------------------------------------------------------------------- | If 'rgbaMode' contains 'True', the color buffers store RGBA value. If--- color indexes are stored, it contains 'False'.--rgbaMode :: GettableStateVar Bool-rgbaMode = makeGettableStateVar (getBoolean1 unmarshalGLboolean GetRGBAMode)-------------------------------------------------------------------------------------- The current color (/R/, /G/, /B/, /A/). The initial value is (1, 1, 1, 1).--- Note that this state variable is significant only when the GL is in RGBA--- mode.--currentColor :: StateVar (Color4 GLfloat)-currentColor =-   makeStateVar (getFloat4 Color4 GetCurrentColor) color---- The current secondary color (/R/, /G/, /B/). The initial value is (0, 0, 0).--- Note that this state variable is significant only when the GL is in RGBA--- mode.--currentSecondaryColor :: StateVar (Color3 GLfloat)-currentSecondaryColor =-   makeStateVar-      (do Color4 r g b _ <- getFloat4 Color4 GetCurrentSecondaryColor-          return $ Color3 r g b)-      secondaryColor-------------------------------------------------------------------------------------- | The class of all types which can be used as a color component.--class ColorComponent a where-   color3 :: a -> a -> a -> IO ()-   color4 :: a -> a -> a -> a -> IO ()--   color3v :: Ptr a -> IO ()-   color4v :: Ptr a -> IO ()--   secondaryColor3  :: a -> a -> a -> IO ()-   secondaryColor3v :: Ptr a -> IO ()--instance ColorComponent GLbyte where-   color3 = glColor3b-   color4 = glColor4b--   color3v = glColor3bv-   color4v = glColor4bv--   secondaryColor3 = glSecondaryColor3b-   secondaryColor3v = glSecondaryColor3bv--instance ColorComponent GLshort where-   color3 = glColor3s-   color4 = glColor4s--   color3v = glColor3sv-   color4v = glColor4sv--   secondaryColor3 = glSecondaryColor3s-   secondaryColor3v = glSecondaryColor3sv--instance ColorComponent GLint where-   color3 = glColor3i-   color4 = glColor4i--   color3v = glColor3iv-   color4v = glColor4iv--   secondaryColor3 = glSecondaryColor3i-   secondaryColor3v = glSecondaryColor3iv--instance ColorComponent GLfloat where-   color3 = glColor3f-   color4 = glColor4f--   color3v = glColor3fv-   color4v = glColor4fv--   secondaryColor3 = glSecondaryColor3f-   secondaryColor3v = glSecondaryColor3fv--instance ColorComponent GLclampf where-   color3 r g b = glColor3f (realToFrac r) (realToFrac g) (realToFrac b)-   color4 r g b a = glColor4f (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a)--   color3v = glColor3fv . castPtr-   color4v = glColor4fv . castPtr--   secondaryColor3 r g b = glSecondaryColor3f (realToFrac r) (realToFrac g) (realToFrac b)-   secondaryColor3v = glSecondaryColor3fv . castPtr--instance ColorComponent GLdouble where-   color3 = glColor3d-   color4 = glColor4d--   color3v = glColor3dv-   color4v = glColor4dv--   secondaryColor3 = glSecondaryColor3d-   secondaryColor3v = glSecondaryColor3dv--instance ColorComponent GLclampd where-   color3 r g b = glColor3d (realToFrac r) (realToFrac g) (realToFrac b)-   color4 r g b a = glColor4d (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a)--   color3v = glColor3dv . castPtr-   color4v = glColor4dv . castPtr--   secondaryColor3 r g b = glSecondaryColor3d (realToFrac r) (realToFrac g) (realToFrac b)-   secondaryColor3v = glSecondaryColor3dv . castPtr--instance ColorComponent GLubyte where-   color3 = glColor3ub-   color4 = glColor4ub--   color3v = glColor3ubv-   color4v = glColor4ubv--   secondaryColor3 = glSecondaryColor3ub-   secondaryColor3v = glSecondaryColor3ubv--instance ColorComponent GLushort where-   color3 = glColor3us-   color4 = glColor4us--   color3v = glColor3usv-   color4v = glColor4usv--   secondaryColor3 = glSecondaryColor3us-   secondaryColor3v = glSecondaryColor3usv--instance ColorComponent GLuint where-   color3 = glColor3ui-   color4 = glColor4ui--   color3v = glColor3uiv-   color4v = glColor4uiv--   secondaryColor3 = glSecondaryColor3ui-   secondaryColor3v = glSecondaryColor3uiv-------------------------------------------------------------------------------------- | Change the current color.--class Color a where-   color  ::     a -> IO ()-   colorv :: Ptr a -> IO ()--instance ColorComponent a => Color (Color3 a) where-   color (Color3 r g b) = color3 r g b-   colorv = color3v . (castPtr :: Ptr (Color3 b) -> Ptr b)--instance ColorComponent a => Color (Color4 a) where-   color (Color4 r g b a) = color4 r g b a-   colorv = color4v . (castPtr :: Ptr (Color4 b) -> Ptr b)-------------------------------------------------------------------------------------- | Change the current secondary color.--class SecondaryColor a where-   secondaryColor  ::     a -> IO ()-   secondaryColorv :: Ptr a -> IO ()--instance ColorComponent a => SecondaryColor (Color3 a) where-   secondaryColor (Color3 r g b) = secondaryColor3 r g b-   secondaryColorv = secondaryColor3v . (castPtr :: Ptr (Color3 b) -> Ptr b)-------------------------------------------------------------------------------------- The current color index. The initial value is 1. Note that this state--- variable is significant only when the GL is in color index mode.--currentIndex :: StateVar (Index1 GLint)-currentIndex = makeStateVar (getInteger1 Index1 GetCurrentIndex) index-------------------------------------------------------------------------------------- | The class of all types which can be used as a color index.--class IndexComponent a where-   index1 :: a -> IO ()-   index1v :: Ptr a -> IO ()--instance IndexComponent GLshort where-   index1 = glIndexs-   index1v = glIndexsv--instance IndexComponent GLint where-   index1 = glIndexi-   index1v = glIndexiv--instance IndexComponent GLfloat where-   index1 = glIndexf-   index1v = glIndexfv--instance IndexComponent GLdouble where-   index1 = glIndexd-   index1v = glIndexdv--instance IndexComponent GLubyte where-   index1 = glIndexub-   index1v = glIndexubv-------------------------------------------------------------------------------------- | Change the current color index.--class Index a where-   index  ::     a -> IO ()  -- Collision with Prelude.index-   indexv :: Ptr a -> IO ()--instance IndexComponent a => Index (Index1 a) where-   index (Index1 i) = index1 i-   indexv = index1v . (castPtr :: Ptr (Index1 b) -> Ptr b)------------------------------------------------------------------------------------data IntegerHandling =-     ToFloat-   | ToNormalizedFloat-   | KeepIntegral-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------currentVertexAttrib :: AttribLocation -> StateVar (Vertex4 GLfloat)-currentVertexAttrib location =-   makeStateVar-      (getVertexAttribFloat4 Vertex4 location GetCurrentVertexAttrib)-      (vertexAttrib ToFloat location)--currentVertexAttribI :: AttribLocation -> StateVar (Vertex4 GLint)-currentVertexAttribI location =-   makeStateVar-      (getVertexAttribIInteger4 Vertex4 location GetCurrentVertexAttrib)-      (vertexAttrib ToNormalizedFloat location)--currentVertexAttribIu :: AttribLocation -> StateVar (Vertex4 GLuint)-currentVertexAttribIu location =-   makeStateVar-      (getVertexAttribIuInteger4 Vertex4 location GetCurrentVertexAttrib)-      (vertexAttrib KeepIntegral location)------------------------------------------------------------------------------------- The generic vertex attribute API is not as orthogonal as we would like.--- Minimal methods: vertexAttrib4v and vertexAttrib4Nv and vertexAttrib4Iv---- | The class of all types which can be used as a generic vertex attribute.--- NOTE: Do not use the methods of this class directly, they were only exported--- by accident and will be hidden in future versions of this package.--class (Storable a, Num a) => VertexAttribComponent a where-   vertexAttrib1 :: AttribLocation -> a -> IO ()-   vertexAttrib2 :: AttribLocation -> a -> a -> IO ()-   vertexAttrib3 :: AttribLocation -> a -> a -> a -> IO ()-   vertexAttrib4 :: AttribLocation -> a -> a -> a -> a -> IO ()--   vertexAttrib1N :: AttribLocation -> a -> IO ()-   vertexAttrib2N :: AttribLocation -> a -> a -> IO ()-   vertexAttrib3N :: AttribLocation -> a -> a -> a -> IO ()-   vertexAttrib4N :: AttribLocation -> a -> a -> a -> a -> IO ()--   vertexAttrib1I :: AttribLocation -> a -> IO ()-   vertexAttrib2I :: AttribLocation -> a -> a -> IO ()-   vertexAttrib3I :: AttribLocation -> a -> a -> a -> IO ()-   vertexAttrib4I :: AttribLocation -> a -> a -> a -> a -> IO ()--   vertexAttrib1v :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib2v :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib3v :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib4v :: AttribLocation -> Ptr a -> IO ()--   vertexAttrib1Nv :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib2Nv :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib3Nv :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib4Nv :: AttribLocation -> Ptr a -> IO ()--   vertexAttrib1Iv :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib2Iv :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib3Iv :: AttribLocation -> Ptr a -> IO ()-   vertexAttrib4Iv :: AttribLocation -> Ptr a -> IO ()--   vertexAttrib1 location x = vertexAttrib4 location x 0 0 1-   vertexAttrib2 location x y = vertexAttrib4 location x y 0 1-   vertexAttrib3 location x y z = vertexAttrib4 location x y z 1-   vertexAttrib4 location x y z w = allocaArray 4 $ \buf -> do-                                       poke4 buf x y z w-                                       vertexAttrib4v location buf--   vertexAttrib1N location x = vertexAttrib4N location x 0 0 1-   vertexAttrib2N location x y = vertexAttrib4N location x y 0 1-   vertexAttrib3N location x y z = vertexAttrib4N location x y z 1-   vertexAttrib4N location x y z w = allocaArray 4 $ \buf -> do-                                       poke4 buf x y z w-                                       vertexAttrib4Nv location buf--   vertexAttrib1I location x = vertexAttrib4I location x 0 0 1-   vertexAttrib2I location x y = vertexAttrib4I location x y 0 1-   vertexAttrib3I location x y z = vertexAttrib4I location x y z 1-   vertexAttrib4I location x y z w = allocaArray 4 $ \buf -> do-                                       poke4 buf x y z w-                                       vertexAttrib4Iv location buf--   vertexAttrib1v location = peek1M $ vertexAttrib1 location-   vertexAttrib2v location = peek2M $ vertexAttrib2 location-   vertexAttrib3v location = peek3M $ vertexAttrib3 location--   vertexAttrib1Nv location = peek1M $ vertexAttrib1N location-   vertexAttrib2Nv location = peek2M $ vertexAttrib2N location-   vertexAttrib3Nv location = peek3M $ vertexAttrib3N location--   vertexAttrib1Iv location = peek1M $ vertexAttrib1I location-   vertexAttrib2Iv location = peek2M $ vertexAttrib2I location-   vertexAttrib3Iv location = peek3M $ vertexAttrib3I location--instance VertexAttribComponent GLbyte where-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4bv al-   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nbv al-   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4bv al--instance VertexAttribComponent GLubyte where-   vertexAttrib4N (AttribLocation al) = glVertexAttrib4Nub al-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4ubv al-   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nubv al-   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4ubv al--instance VertexAttribComponent GLshort where-   vertexAttrib1 (AttribLocation al) = glVertexAttrib1s al-   vertexAttrib2 (AttribLocation al) = glVertexAttrib2s al-   vertexAttrib3 (AttribLocation al) = glVertexAttrib3s al-   vertexAttrib4 (AttribLocation al) = glVertexAttrib4s al--   vertexAttrib1v (AttribLocation al) = glVertexAttrib1sv al-   vertexAttrib2v (AttribLocation al) = glVertexAttrib2sv al-   vertexAttrib3v (AttribLocation al) = glVertexAttrib3sv al-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4sv al--   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nsv al--   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4sv al--instance VertexAttribComponent GLushort where-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4usv al-   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nusv al-   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4usv al--instance VertexAttribComponent GLint where-   vertexAttrib1I (AttribLocation al) = glVertexAttribI1i al-   vertexAttrib2I (AttribLocation al) = glVertexAttribI2i al-   vertexAttrib3I (AttribLocation al) = glVertexAttribI3i al-   vertexAttrib4I (AttribLocation al) = glVertexAttribI4i al--   vertexAttrib4v (AttribLocation al) = glVertexAttrib4iv al--   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Niv al--   vertexAttrib1Iv (AttribLocation al) = glVertexAttribI1iv al-   vertexAttrib2Iv (AttribLocation al) = glVertexAttribI2iv al-   vertexAttrib3Iv (AttribLocation al) = glVertexAttribI3iv al-   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4iv al--instance VertexAttribComponent GLuint where-   vertexAttrib1I (AttribLocation al) = glVertexAttribI1ui al-   vertexAttrib2I (AttribLocation al) = glVertexAttribI2ui al-   vertexAttrib3I (AttribLocation al) = glVertexAttribI3ui al-   vertexAttrib4I (AttribLocation al) = glVertexAttribI4ui al--   vertexAttrib4v (AttribLocation al) = glVertexAttrib4uiv al--   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nuiv al--   vertexAttrib1Iv (AttribLocation al) = glVertexAttribI1uiv al-   vertexAttrib2Iv (AttribLocation al) = glVertexAttribI2uiv al-   vertexAttrib3Iv (AttribLocation al) = glVertexAttribI3uiv al-   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4uiv al--instance VertexAttribComponent GLfloat where-   vertexAttrib1 (AttribLocation al) = glVertexAttrib1f al-   vertexAttrib2 (AttribLocation al) = glVertexAttrib2f al-   vertexAttrib3 (AttribLocation al) = glVertexAttrib3f al-   vertexAttrib4 (AttribLocation al) = glVertexAttrib4f al--   vertexAttrib1v (AttribLocation al) = glVertexAttrib1fv al-   vertexAttrib2v (AttribLocation al) = glVertexAttrib2fv al-   vertexAttrib3v (AttribLocation al) = glVertexAttrib3fv al-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4fv al--   vertexAttrib4Nv = vertexAttrib4v--   vertexAttrib4Iv = vertexAttrib4IvRealFrac--instance VertexAttribComponent GLclampf where-   vertexAttrib1 (AttribLocation al) x = glVertexAttrib1f al (realToFrac x)-   vertexAttrib2 (AttribLocation al) x y = glVertexAttrib2f al (realToFrac x) (realToFrac y)-   vertexAttrib3 (AttribLocation al) x y z = glVertexAttrib3f al (realToFrac x) (realToFrac y) (realToFrac z)-   vertexAttrib4 (AttribLocation al) x y z w = glVertexAttrib4f al (realToFrac x) (realToFrac y) (realToFrac z) (realToFrac w)--   vertexAttrib1v (AttribLocation al) = glVertexAttrib1fv al . castPtr-   vertexAttrib2v (AttribLocation al) = glVertexAttrib2fv al . castPtr-   vertexAttrib3v (AttribLocation al) = glVertexAttrib3fv al . castPtr-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4fv al . castPtr--   vertexAttrib4Nv = vertexAttrib4v--   vertexAttrib4Iv = vertexAttrib4IvRealFrac--vertexAttrib4IvRealFrac :: (Storable a, RealFrac a) => AttribLocation -> Ptr a -> IO ()-vertexAttrib4IvRealFrac location = peek4M $ \x y z w ->-   vertexAttrib4I location (toGLint x) (toGLint y) (toGLint z) (toGLint w)---- formula 2.6 from the OpenGL 3.1 spec-toGLint :: RealFrac a => a -> GLint-toGLint = truncate . (fromIntegral (maxBound :: GLint) *). clamp-   where clamp = max (-1.0) . min 1.0--instance VertexAttribComponent GLdouble where-   vertexAttrib1 (AttribLocation al) = glVertexAttrib1d al-   vertexAttrib2 (AttribLocation al) = glVertexAttrib2d al-   vertexAttrib3 (AttribLocation al) = glVertexAttrib3d al-   vertexAttrib4 (AttribLocation al) = glVertexAttrib4d al--   vertexAttrib1v (AttribLocation al) = glVertexAttrib1dv al-   vertexAttrib2v (AttribLocation al) = glVertexAttrib2dv al-   vertexAttrib3v (AttribLocation al) = glVertexAttrib3dv al-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4dv al--   vertexAttrib4Nv = vertexAttrib4v--   vertexAttrib4Iv = vertexAttrib4IvRealFrac--instance VertexAttribComponent GLclampd where-   vertexAttrib1 (AttribLocation al) x = glVertexAttrib1d al (realToFrac x)-   vertexAttrib2 (AttribLocation al) x y = glVertexAttrib2d al (realToFrac x) (realToFrac y)-   vertexAttrib3 (AttribLocation al) x y z = glVertexAttrib3d al (realToFrac x) (realToFrac y) (realToFrac z)-   vertexAttrib4 (AttribLocation al) x y z w = glVertexAttrib4d al (realToFrac x) (realToFrac y) (realToFrac z) (realToFrac w)--   vertexAttrib1v (AttribLocation al) = glVertexAttrib1dv al . castPtr-   vertexAttrib2v (AttribLocation al) = glVertexAttrib2dv al . castPtr-   vertexAttrib3v (AttribLocation al) = glVertexAttrib3dv al . castPtr-   vertexAttrib4v (AttribLocation al) = glVertexAttrib4dv al . castPtr--   vertexAttrib4Nv = vertexAttrib4v--   vertexAttrib4Iv = vertexAttrib4IvRealFrac------------------------------------------------------------------------------------class VertexAttrib a where-   vertexAttrib  :: IntegerHandling -> AttribLocation ->     a -> IO ()-   vertexAttribv :: IntegerHandling -> AttribLocation -> Ptr a -> IO ()--instance VertexAttribComponent a => VertexAttrib (Vertex1 a) where-   vertexAttrib ToFloat location (Vertex1 i) = vertexAttrib1 location i-   vertexAttrib ToNormalizedFloat location (Vertex1 i) = vertexAttrib1N location i-   vertexAttrib KeepIntegral location (Vertex1 i) = vertexAttrib1I location i--   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Vertex2 a) where-   vertexAttrib ToFloat location (Vertex2 x y) = vertexAttrib2 location x y-   vertexAttrib ToNormalizedFloat location (Vertex2 x y) = vertexAttrib2N location x y-   vertexAttrib KeepIntegral location (Vertex2 x y) = vertexAttrib2I location x y--   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Vertex3 a) where-   vertexAttrib ToFloat location (Vertex3 x y z) = vertexAttrib3 location x y z-   vertexAttrib ToNormalizedFloat location (Vertex3 x y z) = vertexAttrib3N location x y z-   vertexAttrib KeepIntegral location (Vertex3 x y z) = vertexAttrib3I location x y z--   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Vertex4 a) where-   vertexAttrib ToFloat location (Vertex4 x y z w) = vertexAttrib4 location x y z w-   vertexAttrib ToNormalizedFloat location (Vertex4 x y z w) = vertexAttrib4N location x y z w-   vertexAttrib KeepIntegral location (Vertex4 x y z w) = vertexAttrib4I location x y z w--   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Vector1 a) where-   vertexAttrib ToFloat location (Vector1 i) = vertexAttrib1 location i-   vertexAttrib ToNormalizedFloat location (Vector1 i) = vertexAttrib1N location i-   vertexAttrib KeepIntegral location (Vector1 i) = vertexAttrib1I location i--   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Vector1 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Vector1 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Vector1 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Vector2 a) where-   vertexAttrib ToFloat location (Vector2 x y) = vertexAttrib2 location x y-   vertexAttrib ToNormalizedFloat location (Vector2 x y) = vertexAttrib2N location x y-   vertexAttrib KeepIntegral location (Vector2 x y) = vertexAttrib2I location x y--   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (Vector2 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (Vector2 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (Vector2 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Vector3 a) where-   vertexAttrib ToFloat location (Vector3 x y z) = vertexAttrib3 location x y z-   vertexAttrib ToNormalizedFloat location (Vector3 x y z) = vertexAttrib3N location x y z-   vertexAttrib KeepIntegral location (Vector3 x y z) = vertexAttrib3I location x y z--   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Vector3 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Vector3 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Vector3 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Vector4 a) where-   vertexAttrib ToFloat location (Vector4 x y z w) = vertexAttrib4 location x y z w-   vertexAttrib ToNormalizedFloat location (Vector4 x y z w) = vertexAttrib4N location x y z w-   vertexAttrib KeepIntegral location (Vector4 x y z w) = vertexAttrib4I location x y z w--   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Vector4 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Vector4 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Vector4 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (TexCoord1 a) where-   vertexAttrib ToFloat location (TexCoord1 s) = vertexAttrib1 location s-   vertexAttrib ToNormalizedFloat location (TexCoord1 s) = vertexAttrib1N location s-   vertexAttrib KeepIntegral location (TexCoord1 s) = vertexAttrib1I location s--   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (TexCoord2 a) where-   vertexAttrib ToFloat location (TexCoord2 s t) = vertexAttrib2 location s t-   vertexAttrib ToNormalizedFloat location (TexCoord2 s t) = vertexAttrib2N location s t-   vertexAttrib KeepIntegral location (TexCoord2 s t) = vertexAttrib2I location s t--   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (TexCoord3 a) where-   vertexAttrib ToFloat location (TexCoord3 s t u) = vertexAttrib3 location s t u-   vertexAttrib ToNormalizedFloat location (TexCoord3 s t u) = vertexAttrib3N location s t u-   vertexAttrib KeepIntegral location (TexCoord3 s t u) = vertexAttrib3I location s t u--   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (TexCoord4 a) where-   vertexAttrib ToFloat location (TexCoord4 s t u v) = vertexAttrib4 location s t u v-   vertexAttrib ToNormalizedFloat location (TexCoord4 s t u v) = vertexAttrib4N location s t u v-   vertexAttrib KeepIntegral location (TexCoord4 s t u v) = vertexAttrib4I location s t u v--   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Normal3 a) where-   vertexAttrib ToFloat location (Normal3 x y z) = vertexAttrib3 location x y z-   vertexAttrib ToNormalizedFloat location (Normal3 x y z) = vertexAttrib3N location x y z-   vertexAttrib KeepIntegral location (Normal3 x y z) = vertexAttrib3I location x y z--   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Normal3 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Normal3 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Normal3 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (FogCoord1 a) where-   vertexAttrib ToFloat location (FogCoord1 c) = vertexAttrib1 location c-   vertexAttrib ToNormalizedFloat location (FogCoord1 c) = vertexAttrib1N location c-   vertexAttrib KeepIntegral location (FogCoord1 c) = vertexAttrib1I location c--   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Color3 a) where-   vertexAttrib ToFloat location (Color3 r g b) = vertexAttrib3 location r g b-   vertexAttrib ToNormalizedFloat location (Color3 r g b) = vertexAttrib3N location r g b-   vertexAttrib KeepIntegral location (Color3 r g b) = vertexAttrib3I location r g b--   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Color3 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Color3 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Color3 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Color4 a) where-   vertexAttrib ToFloat location (Color4 r g b a) = vertexAttrib4 location r g b a-   vertexAttrib ToNormalizedFloat location (Color4 r g b a) = vertexAttrib4N location r g b a-   vertexAttrib KeepIntegral location (Color4 r g b a) = vertexAttrib4I location r g b a--   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Color4 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Color4 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Color4 b) -> Ptr b)--instance VertexAttribComponent a => VertexAttrib (Index1 a) where-   vertexAttrib ToFloat location (Index1 i) = vertexAttrib1 location i-   vertexAttrib ToNormalizedFloat location (Index1 i) = vertexAttrib1N location i-   vertexAttrib KeepIntegral location (Index1 i) = vertexAttrib1I location i--   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Index1 b) -> Ptr b)-   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Index1 b) -> Ptr b)-   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Index1 b) -> Ptr b)-------------------------------------------------------------------------------------- | An implementation must support at least 2 texture units, but it may--- support up to 32 ones. This state variable can be used to query the actual--- implementation limit.--maxTextureUnit :: GettableStateVar TextureUnit-maxTextureUnit =-   makeGettableStateVar (getEnum1 (TextureUnit . fromIntegral) GetMaxTextureUnits)
− Graphics/Rendering/OpenGL/GLU.hs 
@@ -1,31 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.OpenGL.GLU--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ A Haskell binding for GLU, OpenGL\'s accompanying utility library.-----------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU (-     module Graphics.Rendering.OpenGL.GLU.Initialization,-     module Graphics.Rendering.OpenGL.GLU.Mipmapping,-     module Graphics.Rendering.OpenGL.GLU.Matrix,-     module Graphics.Rendering.OpenGL.GLU.Tessellation,-     module Graphics.Rendering.OpenGL.GLU.Quadrics,-     module Graphics.Rendering.OpenGL.GLU.NURBS,-     module Graphics.Rendering.OpenGL.GLU.Errors-) where--import Graphics.Rendering.OpenGL.GLU.Initialization-import Graphics.Rendering.OpenGL.GLU.Mipmapping-import Graphics.Rendering.OpenGL.GLU.Matrix-import Graphics.Rendering.OpenGL.GLU.Tessellation-import Graphics.Rendering.OpenGL.GLU.Quadrics-import Graphics.Rendering.OpenGL.GLU.NURBS-import Graphics.Rendering.OpenGL.GLU.Errors
− Graphics/Rendering/OpenGL/GLU/Errors.hs 
@@ -1,34 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.Errors--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to section 2.5 (GL Errors) of the OpenGL 2.1 specs--- and chapter 8 (Errors) of the GLU specs, offering a generalized view of--- errors in GL and GLU.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.Errors (-   Error(..), ErrorCategory(..), errors-) where--import Data.StateVar-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-------------------------------------------------------------------------------------- | When an error occurs, it is recorded in this state variable and no further--- errors are recorded. Reading 'errors' returns the currently recorded errors--- (there may be more than one due to a possibly distributed implementation) and--- resets the state variable to @[]@, re-enabling the recording of future--- errors. The value @[]@ means that there has been no detectable error since--- the last time 'errors' was read, or since the GL was initialized.--errors :: GettableStateVar [Error]-errors = makeGettableStateVar getErrors
− Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs 
@@ -1,171 +0,0 @@-{-# OPTIONS_GHC -fno-cse #-}---- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.ErrorsInternal--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module corresponding to some parts of section 2.5--- (GL Errors) of the OpenGL 2.1 specs and chapter 8 (Errors) of the GLU specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   Error(..), ErrorCategory(..), getErrors,-   recordErrorCode, recordInvalidEnum, recordInvalidValue, recordOutOfMemory-) where--import Foreign.Ptr ( castPtr )-import Foreign.C.String ( peekCString )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-import System.IO.Unsafe ( unsafePerformIO )-import Graphics.Rendering.GLU.Raw-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility-import Graphics.Rendering.OpenGL.Raw.Core31-------------------------------------------------------------------------------------- | GL\/GLU errors consist of a general error category and a description of--- what went wrong.--data Error = Error ErrorCategory String-   deriving ( Eq, Ord, Show )-------------------------------------------------------------------------------------- | General GL\/GLU error categories--data ErrorCategory-   = InvalidEnum-   | InvalidValue-   | InvalidOperation-   | InvalidFramebufferOperation-   | OutOfMemory-   | StackOverflow-   | StackUnderflow-   | TableTooLarge-   | TesselatorError-   | NURBSError-   deriving ( Eq, Ord, Show )--unmarshalErrorCategory :: GLenum -> ErrorCategory-unmarshalErrorCategory c-   | isInvalidEnum c      = InvalidEnum-   | isInvalidValue c     = InvalidValue-   | isInvalidOperation c = InvalidOperation-   | isInvalidFramebufferOperation c = InvalidFramebufferOperation -   | isOutOfMemory c      = OutOfMemory-   | isStackOverflow c    = StackOverflow-   | isStackUnderflow c   = StackUnderflow-   | isTableTooLarge c    = TableTooLarge-   | isTesselatorError c  = TesselatorError-   | isNURBSError c       = NURBSError-   | otherwise = error "unmarshalErrorCategory"--isInvalidEnum :: GLenum -> Bool-isInvalidEnum c = c == gl_INVALID_ENUM || c == glu_INVALID_ENUM--isInvalidValue :: GLenum -> Bool-isInvalidValue c = c == gl_INVALID_VALUE || c == glu_INVALID_VALUE--isInvalidOperation :: GLenum -> Bool-isInvalidOperation c = c == gl_INVALID_OPERATION || c == glu_INVALID_OPERATION--isInvalidFramebufferOperation :: GLenum -> Bool-isInvalidFramebufferOperation c = c == gl_INVALID_FRAMEBUFFER_OPERATION--isOutOfMemory :: GLenum -> Bool-isOutOfMemory c = c == gl_OUT_OF_MEMORY || c == glu_OUT_OF_MEMORY--isStackOverflow :: GLenum -> Bool-isStackOverflow c = c == gl_STACK_OVERFLOW--isStackUnderflow :: GLenum -> Bool-isStackUnderflow c = c == gl_STACK_UNDERFLOW--isTableTooLarge :: GLenum -> Bool-isTableTooLarge c = c == gl_TABLE_TOO_LARGE--isTesselatorError :: GLenum -> Bool-isTesselatorError c = glu_TESS_ERROR1 <= c && c <= glu_TESS_ERROR8--isNURBSError :: GLenum -> Bool-isNURBSError c = glu_NURBS_ERROR1 <= c && c <= glu_NURBS_ERROR37-------------------------------------------------------------------------------------- The returned error string is statically allocated, so peekCString--- does the right thing here. No malloc/free necessary here.--makeError :: GLenum -> IO Error-makeError e = do-   let category = unmarshalErrorCategory e-   ptr <- gluErrorString e-   description <- peekCString (castPtr ptr)-   return $ Error category description-------------------------------------------------------------------------------------- This seems to be a common Haskell hack nowadays: A plain old global variable--- with an associated getter and mutator. Perhaps some language/library support--- is needed?--{-# NOINLINE theRecordedErrors #-}-theRecordedErrors :: IORef ([GLenum],Bool)-theRecordedErrors = unsafePerformIO (newIORef ([], True))--getRecordedErrors :: IO ([GLenum],Bool)-getRecordedErrors =  readIORef theRecordedErrors--setRecordedErrors :: ([GLenum],Bool) -> IO ()-setRecordedErrors = writeIORef theRecordedErrors------------------------------------------------------------------------------------getGLErrors :: IO [GLenum]-getGLErrors = getGLErrorsAux []-   where getGLErrorsAux acc = do-            errorCode <- glGetError-            if isError errorCode-               then getGLErrorsAux (errorCode : acc)-               else return $ reverse acc--isError :: GLenum -> Bool-isError = (/= gl_NO_ERROR)------------------------------------------------------------------------------------getErrors :: IO [Error]-getErrors = do-   es <- getErrorCodesAux (const ([], True))-   mapM makeError es--recordErrorCode :: GLenum -> IO ()-recordErrorCode e = do-   -- We don't need the return value because this calls setRecordedErrors-   _ <- getErrorCodesAux (\es -> (if null es then [e] else [], False))-   return ()--recordInvalidEnum :: IO ()-recordInvalidEnum = recordErrorCode gl_INVALID_ENUM--recordInvalidValue :: IO ()-recordInvalidValue = recordErrorCode gl_INVALID_VALUE--recordOutOfMemory :: IO ()-recordOutOfMemory = recordErrorCode gl_OUT_OF_MEMORY---- ToDo: Make this thread-safe-getErrorCodesAux :: ([GLenum] -> ([GLenum],Bool)) -> IO [GLenum]-getErrorCodesAux f = do-   (recordedErrors, useGLErrors) <- getRecordedErrors-   glErrors <- getGLErrors-   let es = if useGLErrors then recordedErrors ++ glErrors else recordedErrors-   setRecordedErrors (f es)-   return es
− Graphics/Rendering/OpenGL/GLU/Initialization.hs 
@@ -1,36 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.Initialization--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to chapter 2 (Initialization) of the GLU specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.Initialization (-   gluVersion, gluExtensions-) where--import Data.StateVar-import Foreign.C.String-import Foreign.Ptr-import Graphics.Rendering.GLU.Raw-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------gluVersion :: GettableStateVar String-gluVersion = makeGettableStateVar (getString glu_VERSION)--gluExtensions :: GettableStateVar [String]-gluExtensions = makeGettableStateVar (fmap words $ getString glu_EXTENSIONS)--getString :: GLenum -> IO String-getString n = gluGetString n >>=-              maybeNullPtr (return "") (peekCString . castPtr)
− Graphics/Rendering/OpenGL/GLU/Matrix.hs 
@@ -1,135 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.Matrix--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to chapter 4 (Matrix Manipulation) of the GLU specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.Matrix (-   ortho2D, perspective, lookAt, pickMatrix,-   project, unProject, unProject4-) where--import Data.Tensor-import Foreign.Marshal.Alloc-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.GLU.Raw-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal-import Graphics.Rendering.OpenGL.Raw.Core31------------------------------------------------------------------------------------- matrix setup--ortho2D :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()-ortho2D = gluOrtho2D---perspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()-perspective = gluPerspective--lookAt :: Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble -> IO ()-lookAt (Vertex3 eyeX    eyeY    eyeZ)-       (Vertex3 centerX centerY centerZ)-       (Vector3 upX     upY     upZ) =-   gluLookAt eyeX eyeY eyeZ centerX centerY centerZ upX upY upZ--pickMatrix ::-   (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> (Position, Size) -> IO ()-pickMatrix (x, y) (w, h) viewPort =-   withViewport viewPort $ gluPickMatrix x y w h------------------------------------------------------------------------------------- coordinate projection--project ::-      Matrix m-   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)-   -> IO (Vertex3 GLdouble)-project (Vertex3 objX objY objZ) model proj viewPort =-   withColumnMajor model $ \modelBuf ->-   withColumnMajor proj $ \projBuf ->-   withViewport viewPort $ \viewBuf ->-   getVertex3 $ gluProject objX objY objZ modelBuf projBuf viewBuf--unProject ::-      Matrix m-   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)-   -> IO (Vertex3 GLdouble)-unProject (Vertex3 objX objY objZ) model proj viewPort =-   withColumnMajor model $ \modelBuf ->-   withColumnMajor proj $ \projBuf ->-   withViewport viewPort $ \viewBuf ->-   getVertex3 $ gluUnProject objX objY objZ modelBuf projBuf viewBuf--unProject4 ::-      Matrix m-   => Vertex4 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)-   -> GLclampd -> GLclampd-   -> IO (Vertex4 GLdouble)-unProject4 (Vertex4 objX objY objZ clipW) model proj viewPort near far =-   withColumnMajor model $ \modelBuf ->-   withColumnMajor proj $ \projBuf ->-   withViewport viewPort $ \viewBuf ->-   getVertex4 $-      gluUnProject4 objX objY objZ clipW modelBuf projBuf viewBuf near far------------------------------------------------------------------------------------withViewport :: (Position, Size) -> (Ptr GLint -> IO a ) -> IO a-withViewport (Position x y, Size w h) =-   withArray [ x, y, fromIntegral w, fromIntegral h ]--withColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO b) -> IO b-withColumnMajor mat act = withMatrix mat juggle-   where juggle ColumnMajor p = act p-         juggle RowMajor    p = do-            transposedElems <- mapM (peekElemOff p) [ 0, 4,  8, 12,-                                                      1, 5,  9, 13,-                                                      2, 6, 10, 14,-                                                      3, 7, 11, 15 ]-            withArray transposedElems act--getVertex3 ::-      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)-   -> IO (Vertex3 GLdouble)-getVertex3 act =-   alloca $ \xBuf ->-   alloca $ \yBuf ->-   alloca $ \zBuf -> do-   ok <- act xBuf yBuf zBuf-   if unmarshalGLboolean ok-      then do x <- peek xBuf-              y <- peek yBuf-              z <- peek zBuf-              return $ Vertex3 x y z-      else do recordInvalidValue-              return $ Vertex3 0 0 0--getVertex4 ::-      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)-   -> IO (Vertex4 GLdouble)-getVertex4 act =-   alloca $ \xBuf ->-   alloca $ \yBuf ->-   alloca $ \zBuf ->-   alloca $ \wBuf -> do-   ok <- act xBuf yBuf zBuf wBuf-   if unmarshalGLboolean ok-      then do x <- peek xBuf-              y <- peek yBuf-              z <- peek zBuf-              w <- peek wBuf-              return $ Vertex4 x y z w-      else do recordInvalidValue-              return $ Vertex4 0 0 0 0
− Graphics/Rendering/OpenGL/GLU/Mipmapping.hs 
@@ -1,66 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.Mipmapping--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to chapter 3 (Mipmapping) of the GLU specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.Mipmapping (-   scaleImage, build1DMipmaps, build2DMipmaps-) where--import Graphics.Rendering.GLU.Raw-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )-import Graphics.Rendering.OpenGL.GL.PixelData ( PixelData, withPixelData )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   PixelInternalFormat, marshalPixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (-   TextureTarget, marshalTextureTarget )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidValue )------------------------------------------------------------------------------------- Section 3.1 (Image Scaling)--scaleImage :: Size -> PixelData a -> Size -> PixelData b -> IO ()-scaleImage (Size widthIn  heightIn)  pdIn (Size widthOut heightOut) pdOut =-   withPixelData pdIn $ \fIn dIn pIn ->-      withPixelData pdOut $ \fOut dOut pOut ->-         if fIn == fOut-            then do _ <- gluScaleImage-                      fIn widthIn heightIn dIn pIn widthOut heightOut dOut pOut-                    return ()   -- TODO: Should we use the return value?-            else recordInvalidValue------------------------------------------------------------------------------------- Section 3.2 (Automatic Mipmapping)--- Missing for GLU 1.3: gluBuild3DMipmaps, gluBuild{1,2,3}DMipmapLevels--build1DMipmaps ::-   TextureTarget -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()-build1DMipmaps target internalFormat height pd = do-   _ <- withPixelData pd $-      gluBuild1DMipmaps-         (marshalTextureTarget target)-         (marshalPixelInternalFormat internalFormat)-         height-   return ()   -- TODO: Should we use the return value?------------------------------------------------------------------------------------build2DMipmaps :: TextureTarget -> PixelInternalFormat -> GLsizei -> GLsizei-               -> PixelData a -> IO ()-build2DMipmaps target internalFormat width height pd = do-   _ <- withPixelData pd $-      gluBuild2DMipmaps-         (marshalTextureTarget target)-         (marshalPixelInternalFormat internalFormat)-         width height-   return ()   -- TODO: Should we use the return value?
− Graphics/Rendering/OpenGL/GLU/NURBS.hs 
@@ -1,310 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.NURBS--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to chapter 7 (NURBS) of the GLU specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.NURBS (-   NURBSObj, withNURBSObj,-   NURBSBeginCallback, withNURBSBeginCallback,-   NURBSVertexCallback, withNURBSVertexCallback,-   NURBSNormalCallback, withNURBSNormalCallback,-   NURBSColorCallback, withNURBSColorCallback,-   NURBSEndCallback, withNURBSEndCallback,-   checkForNURBSError,-   nurbsBeginEndCurve, nurbsCurve,-   nurbsBeginEndSurface, nurbsSurface,-   TrimmingPoint, nurbsBeginEndTrim, pwlCurve, trimmingCurve,-   NURBSMode(..), setNURBSMode,-   setNURBSCulling,-   SamplingMethod(..), setSamplingMethod,-   loadSamplingMatrices,-   DisplayMode'(..), setDisplayMode'-) where--import Control.Monad-import Data.Tensor-import Foreign.Marshal.Array-import Foreign.Ptr-import Foreign.Storable-import Graphics.Rendering.GLU.Raw hiding (-   NURBSBeginCallback, NURBSVertexCallback, NURBSNormalCallback,-   NURBSColorCallback, NURBSEndCallback )-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.GL.Capability-import Graphics.Rendering.OpenGL.GL.ControlPoint-import Graphics.Rendering.OpenGL.GL.CoordTrans-import Graphics.Rendering.OpenGL.GL.Exception-import Graphics.Rendering.OpenGL.GL.GLboolean-import Graphics.Rendering.OpenGL.GL.PrimitiveMode-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal------------------------------------------------------------------------------------- chapter 7.1: The NURBS Object---- an opaque pointer to a NURBS object-type NURBSObj = Ptr GLUnurbs--isNullNURBSObj :: NURBSObj -> Bool-isNullNURBSObj = (nullPtr ==)--withNURBSObj :: a -> (NURBSObj -> IO a) -> IO a-withNURBSObj failureValue action =-   bracket gluNewNurbsRenderer safeDeleteNurbsRenderer-           (\nurbsObj -> if isNullNURBSObj nurbsObj-                            then do recordOutOfMemory-                                    return failureValue-                            else action nurbsObj)--safeDeleteNurbsRenderer :: NURBSObj -> IO ()-safeDeleteNurbsRenderer nurbsObj =-   unless (isNullNURBSObj nurbsObj) $ gluDeleteNurbsRenderer nurbsObj------------------------------------------------------------------------------------- chapter 7.2: Callbacks (begin)--type NURBSBeginCallback = PrimitiveMode -> IO ()--withNURBSBeginCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a-withNURBSBeginCallback nurbsObj beginCallback action =-   bracket (makeNURBSBeginCallback (beginCallback . unmarshalPrimitiveMode))-           freeHaskellFunPtr $ \callbackPtr -> do-      gluNurbsCallback nurbsObj glu_NURBS_BEGIN callbackPtr-      action------------------------------------------------------------------------------------- chapter 7.2: Callbacks (vertex)--type NURBSVertexCallback = Vertex3 GLfloat -> IO ()--withNURBSVertexCallback :: NURBSObj -> NURBSVertexCallback -> IO a -> IO a-withNURBSVertexCallback nurbsObj vertexCallback action =-   bracket (makeNURBSVertexCallback (\p -> peek (castPtr p) >>= vertexCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      gluNurbsCallback nurbsObj glu_NURBS_VERTEX callbackPtr-      action------------------------------------------------------------------------------------- chapter 7.2: Callbacks (normal)--type NURBSNormalCallback = Normal3 GLfloat -> IO ()--withNURBSNormalCallback :: NURBSObj -> NURBSNormalCallback -> IO a -> IO a-withNURBSNormalCallback nurbsObj normalCallback action =-   bracket (makeNURBSNormalCallback (\p -> peek (castPtr p) >>= normalCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      gluNurbsCallback nurbsObj glu_NURBS_NORMAL callbackPtr-      action------------------------------------------------------------------------------------- chapter 7.2: Callbacks (color)--type NURBSColorCallback = Color4 GLfloat -> IO ()--withNURBSColorCallback :: NURBSObj -> NURBSColorCallback -> IO a -> IO a-withNURBSColorCallback nurbsObj colorCallback action =-   bracket (makeNURBSColorCallback (\p -> peek (castPtr p) >>= colorCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      gluNurbsCallback nurbsObj glu_NURBS_COLOR callbackPtr-      action------------------------------------------------------------------------------------- chapter 7.2: Callbacks (end)--type NURBSEndCallback = IO ()--withNURBSEndCallback :: NURBSObj -> NURBSEndCallback -> IO a -> IO a-withNURBSEndCallback nurbsObj endCallback action =-   bracket (makeNURBSEndCallback endCallback)-           freeHaskellFunPtr $ \callbackPtr -> do-      gluNurbsCallback nurbsObj glu_NURBS_END callbackPtr-      action------------------------------------------------------------------------------------- chapter 7.2: Callbacks (error)--type ErrorCallback = GLenum -> IO ()--withErrorCallback :: NURBSObj -> ErrorCallback -> IO a -> IO a-withErrorCallback nurbsObj errorCallback action =-   bracket (makeNURBSErrorCallback errorCallback)-           freeHaskellFunPtr $ \callbackPtr -> do-      gluNurbsCallback nurbsObj glu_NURBS_ERROR callbackPtr-      action--checkForNURBSError :: NURBSObj -> IO a -> IO a-checkForNURBSError nurbsObj = withErrorCallback nurbsObj recordErrorCode------------------------------------------------------------------------------------- chapter 7.3: NURBS Curves--nurbsBeginEndCurve :: NURBSObj -> IO a -> IO a-nurbsBeginEndCurve nurbsObj =-   bracket_ (gluBeginCurve nurbsObj) (gluEndCurve nurbsObj)---nurbsCurve :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()-nurbsCurve nurbsObj knotCount knots stride control order =-   gluNurbsCurve nurbsObj knotCount knots stride (castPtr control) order (map1Target (pseudoPeek control))--pseudoPeek :: Ptr (c GLfloat) -> c GLfloat-pseudoPeek _ = undefined------------------------------------------------------------------------------------- chapter 7.4: NURBS Surfaces--nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a-nurbsBeginEndSurface nurbsObj =-   bracket_ (gluBeginSurface nurbsObj) (gluEndSurface nurbsObj)---nurbsSurface :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr GLfloat -> GLint -> GLint -> Ptr (c GLfloat) -> GLint -> GLint -> IO ()-nurbsSurface nurbsObj sKnotCount sKnots tKnotCount tKnots sStride tStride control sOrder tOrder =-   gluNurbsSurface nurbsObj sKnotCount sKnots tKnotCount tKnots sStride tStride (castPtr control) sOrder tOrder (map2Target (pseudoPeek control))------------------------------------------------------------------------------------- chapter 7.5: Trimming--class TrimmingPoint p where-   trimmingTarget :: p GLfloat -> GLenum--instance TrimmingPoint Vertex2 where-   trimmingTarget = const glu_MAP1_TRIM_2--instance TrimmingPoint Vertex3 where-   trimmingTarget = const glu_MAP1_TRIM_3--nurbsBeginEndTrim :: NURBSObj -> IO a -> IO a-nurbsBeginEndTrim nurbsObj =-   bracket_ (gluBeginTrim nurbsObj) (gluEndTrim nurbsObj)--pwlCurve :: TrimmingPoint p => NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()-pwlCurve nurbsObj count points stride =-   gluPwlCurve nurbsObj count (castPtr points) stride (trimmingTarget (pseudoPeek points))--trimmingCurve :: TrimmingPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()-trimmingCurve nurbsObj knotCount knots stride control order =-   gluNurbsCurve nurbsObj knotCount knots stride (castPtr control) order (trimmingTarget (pseudoPeek control))------------------------------------------------------------------------------------data NURBSMode =-     NURBSTessellator-   | NURBSRenderer-   deriving ( Eq, Ord, Show )--marshalNURBSMode :: NURBSMode -> GLfloat-marshalNURBSMode x = fromIntegral $ case x of-   NURBSTessellator -> glu_NURBS_TESSELLATOR-   NURBSRenderer -> glu_NURBS_RENDERER--setNURBSMode :: NURBSObj -> NURBSMode -> IO ()-setNURBSMode nurbsObj = gluNurbsProperty nurbsObj glu_NURBS_MODE . marshalNURBSMode------------------------------------------------------------------------------------setNURBSCulling :: NURBSObj -> Capability -> IO ()-setNURBSCulling nurbsObj = gluNurbsProperty nurbsObj glu_CULLING . fromIntegral . marshalCapability------------------------------------------------------------------------------------data SamplingMethod' =-     PathLength'-   | ParametricError'-   | DomainDistance'-   | ObjectPathLength'-   | ObjectParametricError'--marshalSamplingMethod' :: SamplingMethod' -> GLfloat-marshalSamplingMethod' x = fromIntegral $ case x of-   PathLength' -> glu_PATH_LENGTH-   ParametricError' -> glu_PARAMETRIC_TOLERANCE-   DomainDistance' -> glu_DOMAIN_DISTANCE-   ObjectPathLength' -> glu_OBJECT_PATH_LENGTH-   ObjectParametricError' -> glu_OBJECT_PARAMETRIC_ERROR--setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()-setSamplingMethod' nurbsObj = gluNurbsProperty nurbsObj glu_SAMPLING_METHOD . marshalSamplingMethod'------------------------------------------------------------------------------------data SamplingMethod =-     PathLength GLfloat-   | ParametricError GLfloat-   | DomainDistance GLfloat GLfloat-   | ObjectPathLength GLfloat-   | ObjectParametricError GLfloat-   deriving ( Eq, Ord, Show )--setSamplingMethod :: NURBSObj -> SamplingMethod -> IO ()-setSamplingMethod nurbsObj x = case x of-   PathLength s -> do-      gluNurbsProperty nurbsObj glu_SAMPLING_TOLERANCE s-      setSamplingMethod' nurbsObj PathLength'-   ParametricError p -> do-      gluNurbsProperty nurbsObj glu_PARAMETRIC_TOLERANCE p-      setSamplingMethod' nurbsObj ParametricError'-   DomainDistance u v -> do-      gluNurbsProperty nurbsObj glu_U_STEP u-      gluNurbsProperty nurbsObj glu_V_STEP v-      setSamplingMethod' nurbsObj DomainDistance'-   ObjectPathLength s -> do-      gluNurbsProperty nurbsObj glu_SAMPLING_TOLERANCE s-      setSamplingMethod' nurbsObj ObjectPathLength'-   ObjectParametricError p -> do-      gluNurbsProperty nurbsObj glu_PARAMETRIC_TOLERANCE p-      setSamplingMethod' nurbsObj ObjectParametricError'------------------------------------------------------------------------------------setAutoLoadMatrix :: NURBSObj -> Bool -> IO ()-setAutoLoadMatrix nurbsObj = gluNurbsProperty nurbsObj glu_AUTO_LOAD_MATRIX . marshalGLboolean--loadSamplingMatrices :: (Matrix m1, Matrix m2) => NURBSObj -> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ()-loadSamplingMatrices nurbsObj =-   maybe-      (setAutoLoadMatrix nurbsObj True)-      (\(mv, proj, (Position x y, Size w h)) -> do-          withMatrixColumnMajor mv $ \mvBuf ->-             withMatrixColumnMajor proj $ \projBuf ->-                withArray [x, y, fromIntegral w, fromIntegral h] $ \viewportBuf ->-                  gluLoadSamplingMatrices nurbsObj mvBuf projBuf viewportBuf-          setAutoLoadMatrix nurbsObj False)--withMatrixColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO a) -> IO a-withMatrixColumnMajor mat act =-   withMatrix mat $ \order p ->-      if order == ColumnMajor-         then act p-         else do-            elems <- mapM (peekElemOff p) [ 0, 4,  8, 12,-                                            1, 5,  9, 13,-                                            2, 6, 10, 14,-                                            3, 7, 11, 15 ]-            withArray elems act------------------------------------------------------------------------------------data DisplayMode' =-     Fill'-   | OutlinePolygon-   | OutlinePatch-   deriving ( Eq, Ord, Show )--marshalDisplayMode' :: DisplayMode' -> GLfloat-marshalDisplayMode' x = fromIntegral $ case x of-   Fill' -> glu_FILL-   OutlinePolygon -> glu_OUTLINE_POLYGON-   OutlinePatch -> glu_OUTLINE_PATCH--setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()-setDisplayMode' nurbsObj = gluNurbsProperty nurbsObj glu_DISPLAY_MODE . marshalDisplayMode'
− Graphics/Rendering/OpenGL/GLU/Quadrics.hs 
@@ -1,155 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.Quadrics--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to chapter 6 (Quadrics) of the GLU specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.Quadrics (-   QuadricNormal, QuadricTexture(..), QuadricOrientation(..),-   QuadricDrawStyle(..), QuadricStyle(..),-   Radius, Height, Angle, Slices, Stacks, Loops, QuadricPrimitive(..),-   renderQuadric-) where--import Control.Monad ( unless )-import Foreign.Ptr ( Ptr, nullPtr, freeHaskellFunPtr )-import Graphics.Rendering.GLU.Raw-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.GL.Colors ( ShadingModel(Smooth,Flat) )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket )-import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   recordErrorCode, recordOutOfMemory )------------------------------------------------------------------------------------data QuadricDrawStyle =-     PointStyle-   | LineStyle-   | FillStyle-   | SilhouetteStyle-   deriving ( Eq, Ord, Show )--marshalQuadricDrawStyle :: QuadricDrawStyle -> GLenum-marshalQuadricDrawStyle x = case x of-   PointStyle -> glu_POINT-   LineStyle -> glu_LINE-   FillStyle -> glu_FILL-   SilhouetteStyle -> glu_SILHOUETTE------------------------------------------------------------------------------------type QuadricNormal = Maybe ShadingModel--marshalQuadricNormal :: QuadricNormal -> GLenum-marshalQuadricNormal (Just Smooth) = glu_SMOOTH-marshalQuadricNormal (Just Flat  ) = glu_FLAT-marshalQuadricNormal Nothing       = glu_NONE------------------------------------------------------------------------------------data QuadricOrientation =-     Outside-   | Inside-   deriving ( Eq, Ord, Show )--marshalQuadricOrientation :: QuadricOrientation -> GLenum-marshalQuadricOrientation x = case x of-   Outside -> glu_OUTSIDE-   Inside -> glu_INSIDE------------------------------------------------------------------------------------data QuadricTexture-   = NoTextureCoordinates-   | GenerateTextureCoordinates-   deriving ( Eq,Ord )--marshalQuadricTexture :: QuadricTexture -> GLboolean-marshalQuadricTexture NoTextureCoordinates       = marshalGLboolean False-marshalQuadricTexture GenerateTextureCoordinates = marshalGLboolean True------------------------------------------------------------------------------------data QuadricStyle-   = QuadricStyle QuadricNormal-                  QuadricTexture-                  QuadricOrientation-                  QuadricDrawStyle-   deriving ( Eq,Ord )------------------------------------------------------------------------------------type Radius = GLdouble-type Height = GLdouble-type Angle  = GLdouble-type Slices = GLint-type Stacks = GLint-type Loops  = GLint------------------------------------------------------------------------------------data QuadricPrimitive-   = Sphere Radius Slices Stacks-   | Cylinder Radius Radius Height Slices Stacks-   | Disk Radius Radius Slices Loops-   | PartialDisk Radius Radius Slices Loops Angle Angle-   deriving ( Eq, Ord )------------------------------------------------------------------------------------renderQuadric :: QuadricStyle -> QuadricPrimitive -> IO ()-renderQuadric style prim = do-   withQuadricObj recordOutOfMemory $ \quadricObj ->-      withErrorCallback quadricObj recordErrorCode $ do-         setStyle quadricObj style-         renderPrimitive quadricObj prim--withQuadricObj :: IO a -> (QuadricObj -> IO a) -> IO a-withQuadricObj failure success =-   bracket gluNewQuadric safeDeleteQuadric-           (\quadricObj -> if isNullQuadricObj quadricObj-                              then failure-                              else success quadricObj)--safeDeleteQuadric :: QuadricObj -> IO ()-safeDeleteQuadric quadricObj =-   unless (isNullQuadricObj quadricObj) $ gluDeleteQuadric quadricObj--withErrorCallback :: QuadricObj -> QuadricCallback -> IO a -> IO a-withErrorCallback quadricObj callback action =-   bracket (makeQuadricCallback callback) freeHaskellFunPtr $ \callbackPtr -> do-      gluQuadricCallback quadricObj glu_ERROR callbackPtr-      action--setStyle :: QuadricObj -> QuadricStyle -> IO ()-setStyle quadricObj (QuadricStyle n t o d) = do-   gluQuadricNormals     quadricObj (marshalQuadricNormal      n)-   gluQuadricTexture     quadricObj (marshalQuadricTexture     t)-   gluQuadricOrientation quadricObj (marshalQuadricOrientation o)-   gluQuadricDrawStyle   quadricObj (marshalQuadricDrawStyle   d)--renderPrimitive :: QuadricObj -> QuadricPrimitive -> IO ()-renderPrimitive quadricObj (Sphere r s n) =-   gluSphere quadricObj r s n-renderPrimitive quadricObj (Cylinder b t h s n) =-   gluCylinder quadricObj b t h s n-renderPrimitive quadricObj (Disk i o s l) =-   gluDisk quadricObj i o s l-renderPrimitive quadricObj (PartialDisk i o s l a w) =-   gluPartialDisk quadricObj i o s l a w------------------------------------------------------------------------------------type QuadricObj = Ptr GLUquadric--isNullQuadricObj :: QuadricObj -> Bool-isNullQuadricObj = (nullPtr ==)
− Graphics/Rendering/OpenGL/GLU/Tessellation.hs 
@@ -1,521 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GLU.Tessellation--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module corresponds to chapter 5 (Polygon Tessellation) of the GLU specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GLU.Tessellation (-   -- * Polygon description-   AnnotatedVertex(..), ComplexContour(..), ComplexPolygon(..),--   -- * Combining vertices-   WeightedProperties(..), Combiner,--   -- * Tessellation parameters-   TessWinding(..), Tolerance,--   -- * Tessellator type-   Tessellator,--   -- * Contour extraction-   SimpleContour(..), PolygonContours(..), extractContours,--   -- * Triangulation-   TriangleVertex, Triangle(..), Triangulation(..), triangulate,--   -- * Tessellation into primitives-   Primitive(..), SimplePolygon(..), tessellate-) where--import Control.Monad ( foldM, unless )-import Data.IORef ( newIORef, readIORef, writeIORef, modifyIORef )-import Data.Maybe ( fromJust )-import Data.Tensor-import Foreign.Marshal.Alloc ( allocaBytes )-import Foreign.Marshal.Array ( peekArray, pokeArray )-import Foreign.Marshal.Pool ( Pool, withPool, pooledNew )-import Foreign.Ptr ( Ptr, nullPtr, plusPtr, castPtr, freeHaskellFunPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.GLU.Raw-import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.GL.EdgeFlag ( unmarshalEdgeFlag )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket )-import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )-import Graphics.Rendering.OpenGL.GL.PrimitiveMode ( unmarshalPrimitiveMode )-import Graphics.Rendering.OpenGL.GL.BeginEnd (-   PrimitiveMode, EdgeFlag(BeginsInteriorEdge) )-import Graphics.Rendering.OpenGL.GL.VertexSpec-import Graphics.Rendering.OpenGL.GL.QueryUtils-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal------------------------------------------------------------------------------------data TessWinding =-     TessWindingOdd-   | TessWindingNonzero-   | TessWindingPositive-   | TessWindingNegative-   | TessWindingAbsGeqTwo-   deriving ( Eq, Ord, Show )--marshalTessWinding :: TessWinding -> GLenum-marshalTessWinding x = case x of-   TessWindingOdd -> glu_TESS_WINDING_ODD-   TessWindingNonzero -> glu_TESS_WINDING_NONZERO-   TessWindingPositive -> glu_TESS_WINDING_POSITIVE-   TessWindingNegative -> glu_TESS_WINDING_NEGATIVE-   TessWindingAbsGeqTwo -> glu_TESS_WINDING_ABS_GEQ_TWO-------------------------------------------------------------------------------------- | The basic building block in tessellation is a 3D vertex with an associated--- property, e.g. color, texture coordinates, etc.--data AnnotatedVertex v = AnnotatedVertex (Vertex3 GLdouble) v-   deriving ( Eq, Ord )--offsetOfProperty :: Storable v => v -> Int-offsetOfProperty v = alignOffset v (3 * sizeOf x)-   where AnnotatedVertex (Vertex3 x _ _) _ = undefined--alignOffset :: Storable a => a -> Int -> Int-alignOffset x offset = n - (n `mod` a)-   where a = alignment x-         n = a + offset - 1--instance Storable v => Storable (AnnotatedVertex v) where--   sizeOf ~(AnnotatedVertex (Vertex3 x _ _) v) =-      alignOffset x (sizeOf v + offsetOfProperty v)--   alignment ~(AnnotatedVertex (Vertex3 x _ _) _) =-      alignment x--   peek ptr = do-      x <- peekElemOff (castPtr ptr) 0-      y <- peekElemOff (castPtr ptr) 1-      z <- peekElemOff (castPtr ptr) 2-      let dummyElement :: Ptr (AnnotatedVertex v) -> v-          dummyElement = undefined-      v <- peekByteOff (castPtr ptr) (offsetOfProperty (dummyElement ptr))-      return $ AnnotatedVertex (Vertex3 x y z) v--   poke ptr (AnnotatedVertex (Vertex3 x y z) v) = do-      pokeElemOff (castPtr ptr) 0 x-      pokeElemOff (castPtr ptr) 1 y-      pokeElemOff (castPtr ptr) 2 z-      pokeByteOff (castPtr ptr) (offsetOfProperty v) v-------------------------------------------------------------------------------------- | A complex contour, which can be self-intersecting and\/or concave.--newtype ComplexContour v = ComplexContour [AnnotatedVertex v]-   deriving ( Eq, Ord )--sizeOfComplexContour :: Storable v => ComplexContour v -> Int-sizeOfComplexContour (ComplexContour vs) =-   length vs * sizeOf (head vs)--pokeComplexContour ::-   Storable v => Ptr (ComplexContour v) -> ComplexContour v -> IO ()-pokeComplexContour ptr (ComplexContour vs) =-   pokeArray (castPtr ptr) vs-------------------------------------------------------------------------------------- | A complex (possibly concave) polygon, represented by one or more complex--- and possibly intersecting contours.--newtype ComplexPolygon v = ComplexPolygon [ComplexContour v]-   deriving ( Eq, Ord )--sizeOfComplexPolygon :: Storable v => ComplexPolygon v -> Int-sizeOfComplexPolygon (ComplexPolygon complexContours) =-   sum (map sizeOfComplexContour complexContours)--pokeComplexPolygon ::-   Storable v => Ptr (ComplexPolygon v) -> ComplexPolygon v -> IO ()-pokeComplexPolygon ptr (ComplexPolygon complexContours) =-   foldM pokeAndAdvance (castPtr ptr) complexContours >> return ()-   where pokeAndAdvance p complexContour = do-            pokeComplexContour p complexContour-            return $ p `plusPtr` sizeOfComplexContour complexContour--withComplexPolygon ::-   Storable v => ComplexPolygon v -> (Ptr (ComplexPolygon v) -> IO a) -> IO a-withComplexPolygon complexPolygon f =-   allocaBytes (sizeOfComplexPolygon complexPolygon) $ \ptr -> do-      pokeComplexPolygon ptr complexPolygon-      f ptr-------------------------------------------------------------------------------------- | Four vertex properties (cf. 'AnnotatedVertex') with associated weigths--- summing up to 1.0.--data WeightedProperties v-   = WeightedProperties (GLfloat, v)-                        (GLfloat, v)-                        (GLfloat, v)-                        (GLfloat, v)-   deriving ( Eq, Ord )---- | A function combining given vertex properties into a property for a newly--- generated vertex--type Combiner v-    = Vertex3 GLdouble-   -> WeightedProperties v-   -> v-------------------------------------------------------------------------------------- | The relative tolerance under which two vertices can be combined (see--- 'Combiner'). Multiplication with the largest coordinate magnitude of all--- polygon vertices yields the maximum distance between two mergeable vertices.------ Note that merging is optional and the tolerance is only a hint.--type Tolerance = GLdouble-------------------------------------------------------------------------------------- | A general tessellator type.------ Before tessellation of a complex polygon, all its vertices are projected into--- a plane perpendicular to the given normal. If the given normal is--- @Normal3 0 0 0@, a fitting plane of all vertices is used.--type Tessellator p v-   = TessWinding-  -> Tolerance-  -> Normal3 GLdouble-  -> Combiner v-  -> ComplexPolygon v-  -> IO (p v)-------------------------------------------------------------------------------------- | A simple, non-self-intersecting contour--newtype SimpleContour v = SimpleContour [AnnotatedVertex v]-   deriving ( Eq, Ord )---- | The contours of a complex polygon, represented by one or more--- non-intersecting simple contours--newtype PolygonContours v = PolygonContours [SimpleContour v]-   deriving ( Eq, Ord )--extractContours :: Storable v => Tessellator PolygonContours v-extractContours windingRule tolerance theNormal combiner complexPoly = do--   vertices <- newIORef []-   let addVertex v = modifyIORef vertices (v:)--   contours <- newIORef []-   let finishContour = do-          vs <- readIORef vertices-          writeIORef vertices []-          modifyIORef contours (SimpleContour (reverse vs) :)--       getContours = fmap (PolygonContours . reverse) (readIORef contours)--   withTessellatorObj (PolygonContours [])$ \tessObj -> do-      setTessellatorProperties tessObj windingRule tolerance theNormal True-      withVertexCallback tessObj addVertex $-         withEndCallback tessObj finishContour $-            checkForError tessObj $-               withCombineCallback tessObj combiner $ do-                  defineComplexPolygon tessObj complexPoly-                  getContours-------------------------------------------------------------------------------------- | A triangle vertex with additional information about the edge it begins--type TriangleVertex v = AnnotatedVertex (v,EdgeFlag)---- | A triangle, represented by three triangle vertices--data Triangle v-   = Triangle (TriangleVertex v) (TriangleVertex v) (TriangleVertex v)-   deriving ( Eq, Ord )---- | A triangulation of a complex polygon--newtype Triangulation v = Triangulation [Triangle v]-   deriving ( Eq, Ord )--triangulate :: Storable v => Tessellator Triangulation v-triangulate windingRule tolerance theNormal combiner complexPoly = do--   edgeFlagState <- newIORef BeginsInteriorEdge-   let registerEdgeFlag = writeIORef edgeFlagState--   vertices <- newIORef []-   let addVertex (AnnotatedVertex xyz v) = do-          ef <- readIORef edgeFlagState-          modifyIORef vertices (AnnotatedVertex xyz (v,ef) :)--       getTriangulation = do-          vs <- readIORef vertices-          return $ Triangulation (collectTriangles (reverse vs))--   withTessellatorObj (Triangulation []) $ \tessObj -> do-      setTessellatorProperties tessObj windingRule tolerance theNormal False-      withEdgeFlagCallback tessObj registerEdgeFlag $-         withVertexCallback tessObj addVertex $-            checkForError tessObj $-               withCombineCallback tessObj combiner $ do-                  defineComplexPolygon tessObj complexPoly-                  getTriangulation--collectTriangles :: [TriangleVertex v] -> [Triangle v]-collectTriangles []           = []-collectTriangles (a:b:c:rest) = Triangle a b c : collectTriangles rest-collectTriangles _            = error "triangles left"------------------------------------------------------------------------------------data Primitive v = Primitive PrimitiveMode [AnnotatedVertex v]-   deriving ( Eq, Ord )--newtype SimplePolygon v = SimplePolygon [Primitive v]-   deriving ( Eq, Ord )--tessellate :: Storable v => Tessellator SimplePolygon v-tessellate windingRule tolerance theNormal combiner complexPoly = do--   beginModeState <- newIORef undefined-   let setPrimitiveMode = writeIORef beginModeState--   vertices <- newIORef []-   let addVertex v = modifyIORef vertices (v:)--   primitives <- newIORef []-   let finishPrimitive = do-          beginMode <- readIORef beginModeState-          vs <- readIORef vertices-          writeIORef vertices []-          modifyIORef primitives (Primitive beginMode (reverse vs) :)--       getSimplePolygon = fmap (SimplePolygon . reverse) (readIORef primitives)--   withTessellatorObj (SimplePolygon []) $ \tessObj -> do-      setTessellatorProperties tessObj windingRule tolerance theNormal False-      withBeginCallback tessObj setPrimitiveMode $-         withVertexCallback tessObj addVertex $-            withEndCallback tessObj finishPrimitive $-               checkForError tessObj $-                  withCombineCallback tessObj combiner $ do-                     defineComplexPolygon tessObj complexPoly-                     getSimplePolygon------------------------------------------------------------------------------------- chapter 5.1: The Tessellation Object---- an opaque pointer to a tessellator object-type TessellatorObj = Ptr GLUtesselator--isNullTesselatorObj :: TessellatorObj -> Bool-isNullTesselatorObj = (nullPtr ==)--withTessellatorObj :: a -> (TessellatorObj -> IO a) -> IO a-withTessellatorObj failureValue action =-   bracket gluNewTess safeDeleteTess-           (\tessObj -> if isNullTesselatorObj tessObj-                           then do recordOutOfMemory-                                   return failureValue-                           else action tessObj)--safeDeleteTess :: TessellatorObj -> IO ()-safeDeleteTess tessObj =-   unless (isNullTesselatorObj tessObj) $ gluDeleteTess tessObj------------------------------------------------------------------------------------- chapter 5.2: Polygon Definition (polygons)--defineComplexPolygon ::-   Storable v => TessellatorObj -> ComplexPolygon v -> IO ()-defineComplexPolygon tessObj cp@(ComplexPolygon complexContours) =-   withComplexPolygon cp $ \ptr ->-      tessBeginEndPolygon tessObj nullPtr $-         let loop _ []     = return ()-             loop p (c:cs) = do defineComplexContour tessObj (castPtr p) c-                                loop (p `plusPtr` sizeOfComplexContour c) cs-         in loop ptr complexContours--tessBeginEndPolygon :: TessellatorObj -> Ptr p -> IO a -> IO a-tessBeginEndPolygon tessObj ptr f = do-   gluTessBeginPolygon tessObj ptr-   res <- f-   gluTessEndPolygon tessObj-   return res------------------------------------------------------------------------------------- chapter 5.2: Polygon Definition (contours)--defineComplexContour ::-   Storable v =>-   TessellatorObj -> Ptr (ComplexContour v) -> ComplexContour v -> IO ()-defineComplexContour tessObj ptr (ComplexContour annotatedVertices) =-   tessBeginEndContour tessObj $-         let loop _ []     = return ()-             loop p (v:vs) = do defineVertex tessObj (castPtr p)-                                loop (p `plusPtr` sizeOf v) vs-         in loop ptr annotatedVertices--tessBeginEndContour :: TessellatorObj -> IO a -> IO a-tessBeginEndContour tessObj f = do-   gluTessBeginContour tessObj-   res <- f-   gluTessEndContour tessObj-   return res------------------------------------------------------------------------------------- chapter 5.2: Polygon Definition (vertices)--defineVertex :: TessellatorObj -> Ptr (AnnotatedVertex v) -> IO ()-defineVertex tessObj ptr = gluTessVertex tessObj (castPtr ptr) ptr------------------------------------------------------------------------------------- chapter 5.3: Callbacks (begin)--type BeginCallback  = PrimitiveMode -> IO ()--withBeginCallback :: TessellatorObj -> BeginCallback -> IO a -> IO a-withBeginCallback tessObj beginCallback action =-   bracket (makeTessBeginCallback (beginCallback . unmarshalPrimitiveMode))-           freeHaskellFunPtr $ \callbackPtr -> do-      gluTessCallback tessObj glu_TESS_BEGIN callbackPtr-      action------------------------------------------------------------------------------------- chapter 5.3: Callbacks (edgeFlag)--type EdgeFlagCallback  = EdgeFlag -> IO ()--withEdgeFlagCallback :: TessellatorObj -> EdgeFlagCallback -> IO a -> IO a-withEdgeFlagCallback tessObj edgeFlagCallback action =-   bracket (makeTessEdgeFlagCallback (edgeFlagCallback . unmarshalEdgeFlag))-           freeHaskellFunPtr $ \callbackPtr -> do-      gluTessCallback tessObj glu_TESS_EDGE_FLAG callbackPtr-      action------------------------------------------------------------------------------------- chapter 5.3: Callbacks (vertex)--type VertexCallback v = AnnotatedVertex v -> IO ()--withVertexCallback ::-   Storable v => TessellatorObj -> VertexCallback v -> IO a -> IO a-withVertexCallback tessObj vertexCallback action =-   bracket (makeTessVertexCallback (\p -> peek p >>= vertexCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      gluTessCallback tessObj glu_TESS_VERTEX callbackPtr-      action------------------------------------------------------------------------------------- chapter 5.3: Callbacks (end)--type EndCallback  = IO ()--withEndCallback :: TessellatorObj -> EndCallback -> IO a -> IO a-withEndCallback tessObj endCallback action =-   bracket (makeTessEndCallback endCallback) freeHaskellFunPtr $ \callbackPtr -> do-      gluTessCallback tessObj glu_TESS_END callbackPtr-      action------------------------------------------------------------------------------------- chapter 5.3: Callbacks (error)--type ErrorCallback = GLenum -> IO ()--withErrorCallback :: TessellatorObj -> ErrorCallback -> IO a -> IO a-withErrorCallback tessObj errorCallback action =-   bracket (makeTessErrorCallback errorCallback)-           freeHaskellFunPtr $ \callbackPtr -> do-      gluTessCallback tessObj glu_TESS_ERROR callbackPtr-      action--checkForError :: TessellatorObj -> IO a -> IO a-checkForError tessObj = withErrorCallback tessObj recordErrorCode------------------------------------------------------------------------------------- chapter 5.3: Callbacks (combine)--type CombineCallback v =-      Ptr GLdouble-   -> Ptr (Ptr (AnnotatedVertex v))-   -> Ptr GLfloat-   -> Ptr (Ptr (AnnotatedVertex v))-   -> IO ()--withCombineCallback ::-   Storable v => TessellatorObj -> Combiner v -> IO a -> IO a-withCombineCallback tessObj combiner action =-   withPool $ \vertexPool ->-      bracket (makeTessCombineCallback (combineProperties vertexPool combiner))-              freeHaskellFunPtr $ \callbackPtr -> do-         gluTessCallback tessObj glu_TESS_COMBINE callbackPtr-         action ---- NOTE: SGI's tesselator has a bug, sometimes passing NULL for the last two--- vertices instead of valid vertex data, so we have to work around this. We--- just pass the first vertex in these cases, which is OK, because the--- corresponding weight is 0.-combineProperties :: Storable v => Pool -> Combiner v -> CombineCallback v-combineProperties pool combiner newVertexPtr propertyPtrs weights result = do-   newVertex <- peek (castPtr newVertexPtr :: Ptr (Vertex3 GLdouble))-   [v0, v1, v2, v3] <- mapM (getProperty propertyPtrs) [0..3]-   [w0, w1, w2, w3] <- peekArray 4 weights-   let defaultProperty = fromJust v0-       f = maybe defaultProperty id-       wp = WeightedProperties (w0, f v0) (w1, f v1) (w2, f v2) (w3, f v3)-       av = AnnotatedVertex newVertex (combiner newVertex wp)-   poke result =<< pooledNew pool av--getProperty :: Storable v => Ptr (Ptr (AnnotatedVertex v)) -> Int -> IO (Maybe v)-getProperty propertyPtrs n = peekElemOff propertyPtrs n >>=-                             maybeNullPtr (return Nothing) peekProperty--peekProperty :: Storable v => Ptr (AnnotatedVertex v) -> IO (Maybe v)-peekProperty ptr = do-   AnnotatedVertex _ v <- peek ptr-   return (Just v)------------------------------------------------------------------------------------- chapter 5.4: Control over Tessellation--setTessellatorProperties ::-    TessellatorObj -> TessWinding -> Tolerance -> Normal3 GLdouble -> Bool- -> IO ()-setTessellatorProperties tessObj windingRule tolerance theNormal boundaryOnly = do-   setWindingRule tessObj windingRule-   setTolerance tessObj tolerance-   setNormal tessObj theNormal-   setBoundaryOnly tessObj boundaryOnly--setWindingRule :: TessellatorObj -> TessWinding -> IO ()-setWindingRule tessObj =-   gluTessProperty tessObj glu_TESS_WINDING_RULE . fromIntegral . marshalTessWinding--setBoundaryOnly :: TessellatorObj -> Bool -> IO ()-setBoundaryOnly tessObj =-   gluTessProperty tessObj glu_TESS_BOUNDARY_ONLY . marshalGLboolean--setTolerance :: TessellatorObj -> Tolerance -> IO ()-setTolerance tessObj = gluTessProperty tessObj glu_TESS_TOLERANCE--setNormal :: TessellatorObj -> Normal3 GLdouble -> IO ()-setNormal tessObj (Normal3 x y z) = gluTessNormal tessObj x y z
OpenGL.cabal view
@@ -1,113 +1,187 @@ name: OpenGL-version: 2.5.0.0+version: 3.0.3.0+synopsis: A binding for the OpenGL graphics system+description:+  A Haskell binding for the OpenGL graphics system (GL, version 4.6) and its+  accompanying utility library (GLU, version 1.3).+  .+  OpenGL is the industry's most widely used and supported 2D and 3D graphics+  application programming interface (API), incorporating a broad set of+  rendering, texture mapping, special effects, and other powerful visualization+  functions. For more information about OpenGL and its various extensions,+  please see <http://www.opengl.org/>+  and <http://www.opengl.org/registry/>.+homepage: https://wiki.haskell.org/OpenGL+bug-reports: https://github.com/haskell-opengl/OpenGL/issues+copyright: Copyright (C) 2002-2019 Sven Panne license: BSD3 license-file: LICENSE-maintainer: Jason Dagit <dagitj@gmail.com>, Sven Panne <sven.panne@aedion.de>-bug-reports: https://github.com/haskell-opengl/OpenGL/issues-homepage: http://www.haskell.org/haskellwiki/Opengl+author: Sven Panne+maintainer: Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com> category: Graphics-synopsis: A binding for the OpenGL graphics system-description:-   A Haskell binding for the OpenGL graphics system (GL, version 3.2) and its-   accompanying utility library (GLU, version 1.3).-   .-   OpenGL is the industry's most widely used and supported 2D and 3D graphics-   application programming interface (API), incorporating a broad set of-   rendering, texture mapping, special effects, and other powerful visualization-   functions. For more information about OpenGL and its various extensions,-   please see <http://www.opengl.org/>-   and <http://www.opengl.org/registry/>. build-type: Simple-cabal-version: >= 1.6+tested-with:+  GHC == 7.8.4+  GHC == 7.10.3+  GHC == 8.0.2+  GHC == 8.2.2+  GHC == 8.4.3+  GHC == 8.6.5+  GHC == 8.8.1+cabal-version: >= 1.10+extra-source-files:+   CHANGELOG.md+   README.md+ library   exposed-modules:-   Graphics.Rendering.OpenGL.GL.Antialiasing,-   Graphics.Rendering.OpenGL.GL.BeginEnd,-   Graphics.Rendering.OpenGL.GL.Bitmaps,-   Graphics.Rendering.OpenGL.GL.BufferObjects,-   Graphics.Rendering.OpenGL.GL.Clipping,-   Graphics.Rendering.OpenGL.GL.Colors,-   Graphics.Rendering.OpenGL.GL.ColorSum,-   Graphics.Rendering.OpenGL.GL.CoordTrans,-   Graphics.Rendering.OpenGL.GL.DisplayLists,-   Graphics.Rendering.OpenGL.GL.Evaluators,-   Graphics.Rendering.OpenGL.GL.Feedback,-   Graphics.Rendering.OpenGL.GL.FlushFinish,-   Graphics.Rendering.OpenGL.GL.Fog,-   Graphics.Rendering.OpenGL.GL.Framebuffer,-   Graphics.Rendering.OpenGL.GL.Hints,-   Graphics.Rendering.OpenGL.GL,-   Graphics.Rendering.OpenGL.GL.LineSegments,-   Graphics.Rendering.OpenGL.GL.PerFragment,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram,-   Graphics.Rendering.OpenGL.GL.PixelRectangles,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization,-   Graphics.Rendering.OpenGL.GL.Points,-   Graphics.Rendering.OpenGL.GL.Polygons,-   Graphics.Rendering.OpenGL.GL.RasterPos,-   Graphics.Rendering.OpenGL.GL.ReadCopyPixels,-   Graphics.Rendering.OpenGL.GL.Rectangles,-   Graphics.Rendering.OpenGL.GL.SavingState,-   Graphics.Rendering.OpenGL.GL.Selection,-   Graphics.Rendering.OpenGL.GL.Shaders,-   Graphics.Rendering.OpenGL.GL.StringQueries,-   Graphics.Rendering.OpenGL.GL.Texturing.Application,-   Graphics.Rendering.OpenGL.GL.Texturing.Environments,-   Graphics.Rendering.OpenGL.GL.Texturing,-   Graphics.Rendering.OpenGL.GL.Texturing.Objects,-   Graphics.Rendering.OpenGL.GL.Texturing.Parameters,-   Graphics.Rendering.OpenGL.GL.Texturing.Queries,-   Graphics.Rendering.OpenGL.GL.Texturing.Specification,-   Graphics.Rendering.OpenGL.GLU.Errors,-   Graphics.Rendering.OpenGL.GLU,-   Graphics.Rendering.OpenGL.GLU.Initialization,-   Graphics.Rendering.OpenGL.GLU.Matrix,-   Graphics.Rendering.OpenGL.GLU.Mipmapping,-   Graphics.Rendering.OpenGL.GLU.NURBS,-   Graphics.Rendering.OpenGL.GLU.Quadrics,-   Graphics.Rendering.OpenGL.GLU.Tessellation,-   Graphics.Rendering.OpenGL.GL.VertexArrays,-   Graphics.Rendering.OpenGL.GL.VertexSpec,-   Graphics.Rendering.OpenGL+    Graphics.Rendering.OpenGL+    Graphics.Rendering.OpenGL.GL+    Graphics.Rendering.OpenGL.GL.Antialiasing+    Graphics.Rendering.OpenGL.GL.BeginEnd+    Graphics.Rendering.OpenGL.GL.Bitmaps+    Graphics.Rendering.OpenGL.GL.BufferObjects+    Graphics.Rendering.OpenGL.GL.Clipping+    Graphics.Rendering.OpenGL.GL.ColorSum+    Graphics.Rendering.OpenGL.GL.Colors+    Graphics.Rendering.OpenGL.GL.ConditionalRendering+    Graphics.Rendering.OpenGL.GL.CoordTrans+    Graphics.Rendering.OpenGL.GL.DebugOutput+    Graphics.Rendering.OpenGL.GL.DisplayLists+    Graphics.Rendering.OpenGL.GL.Evaluators+    Graphics.Rendering.OpenGL.GL.Feedback+    Graphics.Rendering.OpenGL.GL.FlushFinish+    Graphics.Rendering.OpenGL.GL.Fog+    Graphics.Rendering.OpenGL.GL.Framebuffer+    Graphics.Rendering.OpenGL.GL.FramebufferObjects+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects+    Graphics.Rendering.OpenGL.GL.Hints+    Graphics.Rendering.OpenGL.GL.LineSegments+    Graphics.Rendering.OpenGL.GL.PerFragment+    Graphics.Rendering.OpenGL.GL.PixelRectangles+    Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable+    Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution+    Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram+    Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax+    Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap+    Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage+    Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer+    Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization+    Graphics.Rendering.OpenGL.GL.PixellikeObject+    Graphics.Rendering.OpenGL.GL.Points+    Graphics.Rendering.OpenGL.GL.Polygons+    Graphics.Rendering.OpenGL.GL.PrimitiveMode+    Graphics.Rendering.OpenGL.GL.QueryObjects+    Graphics.Rendering.OpenGL.GL.RasterPos+    Graphics.Rendering.OpenGL.GL.ReadCopyPixels+    Graphics.Rendering.OpenGL.GL.Rectangles+    Graphics.Rendering.OpenGL.GL.SavingState+    Graphics.Rendering.OpenGL.GL.Selection+    Graphics.Rendering.OpenGL.GL.Shaders+    Graphics.Rendering.OpenGL.GL.Shaders.Attribs+    Graphics.Rendering.OpenGL.GL.Shaders.Limits+    Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries+    Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects+    Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries+    Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects+    Graphics.Rendering.OpenGL.GL.Shaders.Uniform+    Graphics.Rendering.OpenGL.GL.StringQueries+    Graphics.Rendering.OpenGL.GL.SyncObjects+    Graphics.Rendering.OpenGL.GL.Tensor+    Graphics.Rendering.OpenGL.GL.Texturing+    Graphics.Rendering.OpenGL.GL.Texturing.Application+    Graphics.Rendering.OpenGL.GL.Texturing.Environments+    Graphics.Rendering.OpenGL.GL.Texturing.Objects+    Graphics.Rendering.OpenGL.GL.Texturing.Parameters+    Graphics.Rendering.OpenGL.GL.Texturing.Queries+    Graphics.Rendering.OpenGL.GL.Texturing.Specification+    Graphics.Rendering.OpenGL.GL.TransformFeedback+    Graphics.Rendering.OpenGL.GL.VertexArrayObjects+    Graphics.Rendering.OpenGL.GL.VertexArrays+    Graphics.Rendering.OpenGL.GL.VertexSpec+    Graphics.Rendering.OpenGL.GLU+    Graphics.Rendering.OpenGL.GLU.Errors+    Graphics.Rendering.OpenGL.GLU.Initialization+    Graphics.Rendering.OpenGL.GLU.Matrix+    Graphics.Rendering.OpenGL.GLU.Mipmapping+    Graphics.Rendering.OpenGL.GLU.NURBS+    Graphics.Rendering.OpenGL.GLU.Quadrics+    Graphics.Rendering.OpenGL.GLU.Tessellation   other-modules:-   Graphics.Rendering.OpenGL.GL.BlendingFactor,-   Graphics.Rendering.OpenGL.GL.BufferMode,-   Graphics.Rendering.OpenGL.GL.Capability,-   Graphics.Rendering.OpenGL.GL.ComparisonFunction,-   Graphics.Rendering.OpenGL.GL.ControlPoint,-   Graphics.Rendering.OpenGL.GL.DataType,-   Graphics.Rendering.OpenGL.GL.Domain,-   Graphics.Rendering.OpenGL.GL.EdgeFlag,-   Graphics.Rendering.OpenGL.GL.Exception,-   Graphics.Rendering.OpenGL.GL.Face,-   Graphics.Rendering.OpenGL.GL.GLboolean,-   Graphics.Rendering.OpenGL.GL.IOState,-   Graphics.Rendering.OpenGL.GL.PeekPoke,-   Graphics.Rendering.OpenGL.GL.PixelData,-   Graphics.Rendering.OpenGL.GL.PixelFormat,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset,-   Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink,-   Graphics.Rendering.OpenGL.GL.PointParameter,-   Graphics.Rendering.OpenGL.GL.PolygonMode,-   Graphics.Rendering.OpenGL.GL.PrimitiveMode,-   Graphics.Rendering.OpenGL.GL.QueryUtils,-   Graphics.Rendering.OpenGL.GL.RenderMode,-   Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat,-   Graphics.Rendering.OpenGL.GL.Texturing.TexParameter,-   Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget,-   Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit,-   Graphics.Rendering.OpenGL.GL.VertexAttributes,-   Graphics.Rendering.OpenGL.GLU.ErrorsInternal+    Graphics.Rendering.OpenGL.GL.BlendingFactor+    Graphics.Rendering.OpenGL.GL.BufferMode+    Graphics.Rendering.OpenGL.GL.ByteString+    Graphics.Rendering.OpenGL.GL.Capability+    Graphics.Rendering.OpenGL.GL.ComparisonFunction+    Graphics.Rendering.OpenGL.GL.ControlPoint+    Graphics.Rendering.OpenGL.GL.DataType+    Graphics.Rendering.OpenGL.GL.Domain+    Graphics.Rendering.OpenGL.GL.EdgeFlag+    Graphics.Rendering.OpenGL.GL.Exception+    Graphics.Rendering.OpenGL.GL.Face+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject+    Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+    Graphics.Rendering.OpenGL.GL.GLboolean+    Graphics.Rendering.OpenGL.GL.IOState+    Graphics.Rendering.OpenGL.GL.MatrixComponent+    Graphics.Rendering.OpenGL.GL.PeekPoke+    Graphics.Rendering.OpenGL.GL.PixelData+    Graphics.Rendering.OpenGL.GL.PixelFormat+    Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset+    Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink+    Graphics.Rendering.OpenGL.GL.PointParameter+    Graphics.Rendering.OpenGL.GL.PolygonMode+    Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal+    Graphics.Rendering.OpenGL.GL.QueryObject+    Graphics.Rendering.OpenGL.GL.QueryUtils+    Graphics.Rendering.OpenGL.GL.QueryUtils.PName+    Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib+    Graphics.Rendering.OpenGL.GL.RenderMode+    Graphics.Rendering.OpenGL.GL.Shaders.Program+    Graphics.Rendering.OpenGL.GL.Shaders.Shader+    Graphics.Rendering.OpenGL.GL.Shaders.Variables+    Graphics.Rendering.OpenGL.GL.Texturing.Filter+    Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+    Graphics.Rendering.OpenGL.GL.Texturing.TexParameter+    Graphics.Rendering.OpenGL.GL.Texturing.TextureObject+    Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+    Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+    Graphics.Rendering.OpenGL.GL.VertexAttributes+    Graphics.Rendering.OpenGL.GLU.ErrorsInternal+  hs-source-dirs: src   ghc-options: -Wall+  if impl(ghc > 8)+    ghc-options: -Wcompat   build-depends:-   base >= 3 && < 5, OpenGLRaw >= 1.1.0.0, GLURaw >= 1.1.0.0, StateVar == 1.0.*, ObjectName == 1.0.*, Tensor == 1.0.*+    base         >= 3   && < 5,+    bytestring   >= 0.9 && < 0.11,+    containers   >= 0.3 && < 0.7,+    text         >= 0.1 && < 1.3,+    transformers >= 0.2 && < 0.6,+    ObjectName   >= 1.1 && < 1.2,+    StateVar     >= 1.1 && < 1.2,+    OpenGLRaw    >= 3.0 && < 3.4,+    GLURaw       >= 2.0 && < 2.1+  default-language: Haskell2010+  other-extensions:+    CPP+    DeriveDataTypeable+    KindSignatures+    TypeSynonymInstances+  if os(windows)+    if arch(i386)+      cpp-options: "-DCALLCONV=stdcall"+    else+      cpp-options: "-DCALLCONV=ccall"+  else+    cpp-options: "-DCALLCONV=ccall"  source-repository head-  type:     git-  location: https://github.com/haskell-opengl/OpenGL+  type: git+  location: https://github.com/haskell-opengl/OpenGL.git
+ README.md view
@@ -0,0 +1,4 @@+[![Hackage](https://img.shields.io/hackage/v/OpenGL.svg)](https://hackage.haskell.org/package/OpenGL)+[![Stackage LTS](https://www.stackage.org/package/OpenGL/badge/lts)](https://www.stackage.org/lts/package/OpenGL)+[![Stackage nightly](https://www.stackage.org/package/OpenGL/badge/nightly)](https://www.stackage.org/nightly/package/OpenGL)+[![Build Status](https://img.shields.io/travis/haskell-opengl/OpenGL/master.svg)](https://travis-ci.org/haskell-opengl/OpenGL)
+ src/Graphics/Rendering/OpenGL.hs view
@@ -0,0 +1,138 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- A convenience module, combining the Haskell bindings for GL and GLU.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL (+   -- * Supported Extensions++   -- $SupportedExtensions++   -- * Legal stuff++   -- $LegalStuff++     module Graphics.Rendering.OpenGL.GL+   , module Graphics.Rendering.OpenGL.GLU+) where++import Graphics.Rendering.OpenGL.GL+import Graphics.Rendering.OpenGL.GLU++--------------------------------------------------------------------------------+-- $SupportedExtensions+-- There is support for full OpenGL 4.4 (compatibility profile), plus some+-- extensions:+--+-- @+-- extension                      | core since+-- -------------------------------+------------+-- GL_APPLE_packed_pixels         | 1.2+-- GL_APPLE_ycbcr_422             |+-- GL_ARB_copy_buffer             | 3.1+-- GL_ARB_depth_buffer_float      | 3.0+-- GL_ARB_depth_texture           | 1.4+-- GL_ARB_half_float_pixel        | 3.0+-- GL_ARB_imaging                 |+-- GL_ARB_multisample             | 1.3+-- GL_ARB_multitexture            | 1.3+-- GL_ARB_occlusion_query         | 1.5+-- GL_ARB_point_parameters        | 1.4+-- GL_ARB_point_sprite            |+-- GL_ARB_shadow                  | 1.4+-- GL_ARB_texture_border_clamp    | 1.3+-- GL_ARB_texture_compression     | 1.3+-- GL_ARB_texture_cube_map        | 1.3+-- GL_ARB_texture_env_add         | 1.3+-- GL_ARB_texture_env_combine     | 1.3+-- GL_ARB_texture_env_crossbar    | 1.4+-- GL_ARB_texture_env_dot3        | 1.3+-- GL_ARB_texture_mirrored_repeat | 1.4+-- GL_ARB_texture_rectangle       | 3.1+-- GL_ARB_transpose_matrix        | 1.3+-- GL_ARB_vertex_buffer_object    | 1.5+-- GL_ARB_vertex_shader           | 2.0+-- GL_ARB_window_pos              | 1.4+-- GL_EXT_abgr                    |+-- GL_EXT_bgra                    | 1.2+-- GL_EXT_blend_color             | 1.4+-- GL_EXT_blend_func_separate     | 1.4+-- GL_EXT_blend_logic_op          | 1.1+-- GL_EXT_blend_minmax            | 1.4+-- GL_EXT_blend_subtract          | 1.4+-- GL_EXT_color_subtable          |+-- GL_EXT_compiled_vertex_array   |+-- GL_EXT_convolution             |+-- GL_EXT_copy_texture            | 1.1+-- GL_EXT_depth_bounds_test       |+-- GL_EXT_draw_range_elements     | 1.2+-- GL_EXT_fog_coord               | 1.4+-- GL_EXT_histogram               |+-- GL_EXT_multi_draw_arrays       | 1.4+-- GL_EXT_packed_float            | 3.0+-- GL_EXT_packed_pixels           | 1.2+-- GL_EXT_polygon_offset          | 1.1+-- GL_EXT_rescale_normal          | 1.2+-- GL_EXT_secondary_color         | 1.4+-- GL_EXT_separate_specular_color | 1.2+-- GL_EXT_shadow_funcs            | 1.5+-- GL_EXT_stencil_two_side        |+-- GL_EXT_stencil_wrap            | 1.4+-- GL_EXT_subtexture              | 1.1+-- GL_EXT_texture                 | 1.1+-- GL_EXT_texture3D               | 1.2+-- GL_EXT_texture_lod_bias        | 1.4+-- GL_EXT_texture_shared_exponent | 3.0+-- GL_EXT_texture_object          | 1.1+-- GL_EXT_vertex_array            | 1.1+-- GL_HP_convolution_border_modes |+-- GL_IBM_rasterpos_clip          |+-- GL_MESA_ycbcr_texture          |+-- GL_NV_blend_square             | 1.4+-- GL_NV_depth_clamp              |+-- GL_NV_fog_distance             |+-- GL_NV_light_max_exponent       |+-- GL_NV_packed_depth_stencil     |+-- GL_NV_primitive_restart        |+-- GL_SGIS_generate_mipmap        | 1.4+-- GL_SGIS_texture_edge_clamp     |+-- GL_SGIS_texture_lod            |+-- GL_SGI_color_matrix            |+-- GL_SGI_color_table             |+-- @++--------------------------------------------------------------------------------+-- $LegalStuff+-- The documentation is loosely based on the man pages of the OpenGL Sample+-- Implemenation from SGI, see: <http://oss.sgi.com/projects/ogl-sample/>. It is+-- used under the SGI Free Software License B. This license requires the+-- following notice:+--+-- /License Applicability/. Except to the extent portions of this file are made+-- subject to an alternative license as permitted in the SGI Free Software+-- License B, Version 1.1 (the \"License\"), the contents of this file are+-- subject only to the provisions of the License. You may not use this file+-- except in compliance with the License. You may obtain a copy of the License+-- at Silicon Graphics, Inc., attn: Legal Services, 1600 Amphitheatre Parkway,+-- Mountain View, CA 94043-1351, or at: <http://oss.sgi.com/projects/FreeB/>.+-- +-- Note that, as provided in the License, the Software is distributed on an \"AS+-- IS\" basis, with ALL EXPRESS AND IMPLIED WARRANTIES AND CONDITIONS+-- DISCLAIMED, INCLUDING, WITHOUT LIMITATION, ANY IMPLIED WARRANTIES AND+-- CONDITIONS OF MERCHANTABILITY, SATISFACTORY QUALITY, FITNESS FOR A PARTICULAR+-- PURPOSE, AND NON-INFRINGEMENT.+--+-- /Original Code/. The Original Code is: OpenGL Sample Implementation, Version+-- 1.2.1, released January 26, 2000, developed by Silicon Graphics, Inc. The+-- Original Code is Copyright (c) 1991-2002 Silicon Graphics, Inc.  Copyright in+-- any portions created by third parties is as indicated elsewhere herein. All+-- Rights Reserved.
+ src/Graphics/Rendering/OpenGL/GL.hs view
@@ -0,0 +1,126 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- A Haskell binding for OpenGL, the industry\'s most widely used and+-- supported 2D and 3D graphics API.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL (+   -- * OpenGL Fundamentals+   module Graphics.GL.Types,+   module Graphics.Rendering.OpenGL.GL.FlushFinish,+   module Data.ObjectName,++   -- * Event Model+   module Graphics.Rendering.OpenGL.GL.SyncObjects,+   module Graphics.Rendering.OpenGL.GL.QueryObjects,++   -- * Vertex Specification and Drawing Commands+   module Graphics.Rendering.OpenGL.GL.PrimitiveMode,+   module Graphics.Rendering.OpenGL.GL.BeginEnd,+   module Graphics.Rendering.OpenGL.GL.Rectangles,+   module Graphics.Rendering.OpenGL.GL.ConditionalRendering,++   -- * OpenGL Operation+   module Graphics.Rendering.OpenGL.GL.VertexSpec,+   module Graphics.Rendering.OpenGL.GL.VertexArrays,+   module Graphics.Rendering.OpenGL.GL.VertexArrayObjects,+   module Graphics.Rendering.OpenGL.GL.BufferObjects,+   module Graphics.Rendering.OpenGL.GL.CoordTrans,+   module Graphics.Rendering.OpenGL.GL.Clipping,+   module Graphics.Rendering.OpenGL.GL.RasterPos,+   module Graphics.Rendering.OpenGL.GL.Colors,+   module Graphics.Rendering.OpenGL.GL.Shaders,++   -- * Rasterization+   module Graphics.Rendering.OpenGL.GL.Antialiasing,+   module Graphics.Rendering.OpenGL.GL.FramebufferObjects,+   module Graphics.Rendering.OpenGL.GL.Points,+   module Graphics.Rendering.OpenGL.GL.LineSegments,+   module Graphics.Rendering.OpenGL.GL.Polygons,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles,+   module Graphics.Rendering.OpenGL.GL.Bitmaps,+   module Graphics.Rendering.OpenGL.GL.Texturing,+   module Graphics.Rendering.OpenGL.GL.ColorSum,+   module Graphics.Rendering.OpenGL.GL.Fog,++   -- * Per-Fragment Operations and the Framebuffer+   module Graphics.Rendering.OpenGL.GL.PerFragment,+   module Graphics.Rendering.OpenGL.GL.Framebuffer,+   module Graphics.Rendering.OpenGL.GL.ReadCopyPixels,++   -- * Special Functions+   module Graphics.Rendering.OpenGL.GL.Evaluators,+   module Graphics.Rendering.OpenGL.GL.Selection,+   module Graphics.Rendering.OpenGL.GL.Feedback,+   module Graphics.Rendering.OpenGL.GL.DisplayLists,+   module Graphics.Rendering.OpenGL.GL.Hints,+   module Graphics.Rendering.OpenGL.GL.PixellikeObject,+   module Graphics.Rendering.OpenGL.GL.TransformFeedback,+   module Graphics.Rendering.OpenGL.GL.DebugOutput,++   -- * State and State Requests+   module Data.StateVar,+   module Graphics.Rendering.OpenGL.GL.Tensor,+   module Graphics.Rendering.OpenGL.GL.StringQueries,+   module Graphics.Rendering.OpenGL.GL.SavingState+) where++import Graphics.GL.Types+import Graphics.Rendering.OpenGL.GL.FlushFinish+import Data.ObjectName+import Data.StateVar++import Graphics.Rendering.OpenGL.GL.SyncObjects+import Graphics.Rendering.OpenGL.GL.QueryObjects++import Graphics.Rendering.OpenGL.GL.PrimitiveMode+import Graphics.Rendering.OpenGL.GL.BeginEnd+import Graphics.Rendering.OpenGL.GL.Rectangles+import Graphics.Rendering.OpenGL.GL.ConditionalRendering++import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GL.VertexArrays+import Graphics.Rendering.OpenGL.GL.VertexArrayObjects+import Graphics.Rendering.OpenGL.GL.BufferObjects+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.Clipping+import Graphics.Rendering.OpenGL.GL.RasterPos+import Graphics.Rendering.OpenGL.GL.Colors+import Graphics.Rendering.OpenGL.GL.Shaders++import Graphics.Rendering.OpenGL.GL.Antialiasing+import Graphics.Rendering.OpenGL.GL.FramebufferObjects+import Graphics.Rendering.OpenGL.GL.Points+import Graphics.Rendering.OpenGL.GL.LineSegments+import Graphics.Rendering.OpenGL.GL.Polygons+import Graphics.Rendering.OpenGL.GL.PixelRectangles+import Graphics.Rendering.OpenGL.GL.Bitmaps+import Graphics.Rendering.OpenGL.GL.Texturing+import Graphics.Rendering.OpenGL.GL.ColorSum+import Graphics.Rendering.OpenGL.GL.Fog++import Graphics.Rendering.OpenGL.GL.PerFragment+import Graphics.Rendering.OpenGL.GL.Framebuffer+import Graphics.Rendering.OpenGL.GL.ReadCopyPixels++import Graphics.Rendering.OpenGL.GL.Evaluators+import Graphics.Rendering.OpenGL.GL.Selection+import Graphics.Rendering.OpenGL.GL.Feedback+import Graphics.Rendering.OpenGL.GL.DisplayLists+import Graphics.Rendering.OpenGL.GL.Hints+import Graphics.Rendering.OpenGL.GL.PixellikeObject+import Graphics.Rendering.OpenGL.GL.TransformFeedback+import Graphics.Rendering.OpenGL.GL.DebugOutput++import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.StringQueries+import Graphics.Rendering.OpenGL.GL.SavingState
+ src/Graphics/Rendering/OpenGL/GL/Antialiasing.hs view
@@ -0,0 +1,40 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Antialiasing+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.2 (Antialiasing) of the OpenGL 2.1+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Antialiasing (+   sampleBuffers, samples, multisample, subpixelBits+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++sampleBuffers :: GettableStateVar GLsizei+sampleBuffers = antialiasingInfo GetSampleBuffers++samples :: GettableStateVar GLsizei+samples = antialiasingInfo GetSamples++multisample :: StateVar Capability+multisample = makeCapability CapMultisample++subpixelBits :: GettableStateVar GLsizei+subpixelBits = antialiasingInfo GetSubpixelBits++antialiasingInfo :: GetPName1I p => p -> GettableStateVar GLsizei+antialiasingInfo = makeGettableStateVar . getSizei1 id
+ src/Graphics/Rendering/OpenGL/GL/BeginEnd.hs view
@@ -0,0 +1,129 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BeginEnd+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 10.8 (Drawing Commands Using Begin and+-- End) of the OpenGL 4.4 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.BeginEnd (+   -- * Begin and End Objects+   renderPrimitive, unsafeRenderPrimitive, primitiveRestart,++   -- * Polygon Edges+   EdgeFlag(..),+   edgeFlag+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.EdgeFlag+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.PrimitiveMode+import Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++-- | Delimit the vertices that define a primitive or a group of like primitives.+--+-- Only a subset of GL commands can be used in the delimited action:+-- Those for specifying vertex coordinates+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.vertex',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.vertexv'),+-- vertex colors+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.color',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.colorv',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColor',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColorv',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.index',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.indexv'),+-- normal+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.normal',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.normalv'),+-- texture coordinates+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.texCoord',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.texCoordv',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoord',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoordv'),+-- and fog coordinates+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoord',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoordv').+-- Additionally,+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint1',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint2',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1v',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2v',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbient',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialDiffuse',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbientAndDiffuse',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialSpecular',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialEmission',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialShininess',+-- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callList',+-- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callLists',+-- and setting 'edgeFlag' are allowed. Writing the respective state variables+-- is allowed in the delimited action, too.+--+-- Regardless of the chosen 'PrimitiveMode', there is no limit to the number of+-- vertices that can be defined during a single 'renderPrimitive'. Lines,+-- triangles, quadrilaterals, and polygons that are incompletely specified are+-- not drawn. Incomplete specification results when either too few vertices are+-- provided to specify even a single primitive or when an incorrect multiple of+-- vertices is specified. The incomplete primitive is ignored; the rest are+-- drawn.+--+-- The minimum specification of vertices for each primitive is as follows: 1+-- for a point, 2 for a line, 3 for a triangle, 4 for a quadrilateral, and 3 for+-- a polygon. Modes that require a certain multiple of vertices are 'Lines' (2),+-- 'Triangles' (3), 'Quads' (4), and 'QuadStrip' (2).++renderPrimitive :: PrimitiveMode -> IO a -> IO a+renderPrimitive = renderPrim bracket_++-- | A more efficient, but potentially dangerous version of 'renderPrimitive':+-- The given action is not allowed to throw an exception.++unsafeRenderPrimitive :: PrimitiveMode -> IO a -> IO a+unsafeRenderPrimitive = renderPrim unsafeBracket_++{-# INLINE renderPrim #-}+renderPrim :: (IO () -> IO () -> IO a -> IO a) -> PrimitiveMode -> IO a -> IO a+renderPrim brack_ beginMode =+   brack_ (glBegin (marshalPrimitiveMode beginMode)) glEnd++--------------------------------------------------------------------------------++primitiveRestart :: IO ()+primitiveRestart = glPrimitiveRestartNV++--------------------------------------------------------------------------------++-- | Each vertex of a polygon, separate triangle, or separate quadrilateral+-- specified during 'renderPrimitive' is marked as the start of either a boundary+-- or nonboundary (interior) edge.+--+-- The vertices of connected triangles and connected quadrilaterals are always+-- marked as boundary, regardless of the value of the edge flag.+--+-- Boundary and nonboundary edge flags on vertices are significant only if+-- 'Graphics.Rendering.OpenGL.GL.Polygons.polygonMode' is set to+-- 'Graphics.Rendering.OpenGL.GL.Polygons.Point' or+-- 'Graphics.Rendering.OpenGL.GL.Polygons.Line'.+--+-- Note that the current edge flag can be updated at any time, in particular+-- during 'renderPrimitive'.++edgeFlag :: StateVar EdgeFlag+edgeFlag =+   makeStateVar (getBoolean1 unmarshalEdgeFlag GetEdgeFlag)+                (glEdgeFlag . marshalEdgeFlag)
+ src/Graphics/Rendering/OpenGL/GL/Bitmaps.hs view
@@ -0,0 +1,28 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Bitmaps+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.7 (Bitmaps) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Bitmaps (+   bitmap+) where++import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.GL++--------------------------------------------------------------------------------++bitmap :: Size -> (Vertex2 GLfloat) -> (Vector2 GLfloat) -> Ptr GLubyte -> IO ()+bitmap (Size w h) (Vertex2 xbo ybo) (Vector2 xbi ybi) =+   glBitmap w h xbo ybo xbi ybi
+ src/Graphics/Rendering/OpenGL/GL/BlendingFactor.hs view
@@ -0,0 +1,77 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BlendingFactor+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling BlendingFactor.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.BlendingFactor (+   BlendingFactor(..), marshalBlendingFactor, unmarshalBlendingFactor+) where++import Graphics.GL++--------------------------------------------------------------------------------++data BlendingFactor =+     Zero+   | One+   | SrcColor+   | OneMinusSrcColor+   | DstColor+   | OneMinusDstColor+   | SrcAlpha+   | OneMinusSrcAlpha+   | DstAlpha+   | OneMinusDstAlpha+   | ConstantColor+   | OneMinusConstantColor+   | ConstantAlpha+   | OneMinusConstantAlpha+   | SrcAlphaSaturate+   deriving ( Eq, Ord, Show )++marshalBlendingFactor :: BlendingFactor -> GLenum+marshalBlendingFactor x = case x of+   Zero -> GL_ZERO+   One -> GL_ONE+   SrcColor -> GL_SRC_COLOR+   OneMinusSrcColor -> GL_ONE_MINUS_SRC_COLOR+   DstColor -> GL_DST_COLOR+   OneMinusDstColor -> GL_ONE_MINUS_DST_COLOR+   SrcAlpha -> GL_SRC_ALPHA+   OneMinusSrcAlpha -> GL_ONE_MINUS_SRC_ALPHA+   DstAlpha -> GL_DST_ALPHA+   OneMinusDstAlpha -> GL_ONE_MINUS_DST_ALPHA+   ConstantColor -> GL_CONSTANT_COLOR+   OneMinusConstantColor -> GL_ONE_MINUS_CONSTANT_COLOR+   ConstantAlpha -> GL_CONSTANT_ALPHA+   OneMinusConstantAlpha -> GL_ONE_MINUS_CONSTANT_ALPHA+   SrcAlphaSaturate -> GL_SRC_ALPHA_SATURATE++unmarshalBlendingFactor :: GLenum -> BlendingFactor+unmarshalBlendingFactor x+   | x == GL_ZERO = Zero+   | x == GL_ONE = One+   | x == GL_SRC_COLOR = SrcColor+   | x == GL_ONE_MINUS_SRC_COLOR = OneMinusSrcColor+   | x == GL_DST_COLOR = DstColor+   | x == GL_ONE_MINUS_DST_COLOR = OneMinusDstColor+   | x == GL_SRC_ALPHA = SrcAlpha+   | x == GL_ONE_MINUS_SRC_ALPHA = OneMinusSrcAlpha+   | x == GL_DST_ALPHA = DstAlpha+   | x == GL_ONE_MINUS_DST_ALPHA = OneMinusDstAlpha+   | x == GL_CONSTANT_COLOR = ConstantColor+   | x == GL_ONE_MINUS_CONSTANT_COLOR = OneMinusConstantColor+   | x == GL_CONSTANT_ALPHA = ConstantAlpha+   | x == GL_ONE_MINUS_CONSTANT_ALPHA = OneMinusConstantAlpha+   | x == GL_SRC_ALPHA_SATURATE = SrcAlphaSaturate+   | otherwise = error ("unmarshalBlendingFactor: illegal value " ++ show x)
+ src/Graphics/Rendering/OpenGL/GL/BufferMode.hs view
@@ -0,0 +1,116 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BufferMode+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling BufferMode.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.BufferMode (+   BufferMode(..), marshalBufferMode, unmarshalBufferMode,+   unmarshalBufferModeSafe,+   maxColorAttachments,+) where++import Graphics.GL++--------------------------------------------------------------------------------++-- | The set of color buffers which are selected for reading and writing. Note+-- that 'FBOColorAttachment' can only be used with framebuffer objects, while+-- the rest can only be used with the default framebuffer. Furthermore, OpenGL+-- 3.0 deprecated auxiliary buffers, so avoid 'AuxBuffer' in modern code.++data BufferMode =+     NoBuffers+     -- ^ No color buffers are selected.+   | FrontLeftBuffer+     -- ^ Only the front left color buffer is selected.+   | FrontRightBuffer+     -- ^ Only the front right color buffer is selected.+   | BackLeftBuffer+     -- ^ Only the  back left color buffer is selected.+   | BackRightBuffer+     -- ^ Only the back right color buffer is selected.+   | FrontBuffers+     -- ^ Only the front left and front right color buffers are selected. If+     -- there is no front right color buffer, only the front left color buffer+     -- is selected.+   | BackBuffers+     -- ^ Only the back left and back right color buffers are selected. If there+     -- is no back right color buffer, only the back left color buffer is+     -- selected.+   | LeftBuffers+     -- ^ Only the front left and back left color buffers are selected. If there+     -- is no back left color buffer, only the front left color buffer is+     -- selected.+   | RightBuffers+     -- ^ Only the front right and back right color buffers are selected. If+     -- there is no back right color buffer, only the front right color buffer+     -- is selected.+   | FrontAndBackBuffers+     -- ^ All the front and back color buffers (front left, front right, back+     -- left, back right) are selected. If there are no back color buffers, only+     -- the front left and front right color buffers are selected. If there are+     -- no right color buffers, only the front left and back left color buffers+     -- are selected. If there are no right or back color buffers, only the+     -- front left color buffer is selected.+   | AuxBuffer GLsizei+     -- ^ Only the given auxiliary color buffer no. /i/ is selected.+   | FBOColorAttachment GLsizei+     -- ^ Only the given color attachment of the bound framebufferobject is selected for reading+     -- or writing.+   deriving ( Eq, Ord, Show )++marshalBufferMode :: BufferMode -> Maybe GLenum+marshalBufferMode x = case x of+   NoBuffers -> Just GL_NONE+   FrontLeftBuffer -> Just GL_FRONT_LEFT+   FrontRightBuffer -> Just GL_FRONT_RIGHT+   BackLeftBuffer -> Just GL_BACK_LEFT+   BackRightBuffer -> Just GL_BACK_RIGHT+   FrontBuffers -> Just GL_FRONT+   BackBuffers -> Just GL_BACK+   LeftBuffers -> Just GL_LEFT+   RightBuffers -> Just GL_RIGHT+   FrontAndBackBuffers -> Just GL_FRONT_AND_BACK+   AuxBuffer i+      | fromIntegral i <= maxAuxBuffer -> Just (GL_AUX0 + fromIntegral i)+      | otherwise -> Nothing+   FBOColorAttachment i+      | fromIntegral i <= maxColorAttachments -> Just (GL_COLOR_ATTACHMENT0 + fromIntegral i)+      | otherwise -> Nothing++unmarshalBufferMode :: GLenum -> BufferMode+unmarshalBufferMode x = maybe+   (error ("unmarshalBufferMode: illegal value " ++ show x)) id $ unmarshalBufferModeSafe x++unmarshalBufferModeSafe :: GLenum -> Maybe BufferMode+unmarshalBufferModeSafe x+   | x == GL_NONE = Just NoBuffers+   | x == GL_FRONT_LEFT = Just FrontLeftBuffer+   | x == GL_FRONT_RIGHT = Just FrontRightBuffer+   | x == GL_BACK_LEFT = Just BackLeftBuffer+   | x == GL_BACK_RIGHT = Just BackRightBuffer+   | x == GL_FRONT = Just FrontBuffers+   | x == GL_BACK = Just BackBuffers+   | x == GL_LEFT = Just LeftBuffers+   | x == GL_RIGHT = Just RightBuffers+   | x == GL_FRONT_AND_BACK = Just FrontAndBackBuffers+   | GL_AUX0 <= x && x <= GL_AUX0 + maxAuxBuffer = Just . AuxBuffer . fromIntegral $ x - GL_AUX0+   | GL_COLOR_ATTACHMENT0 <= x && x <= GL_COLOR_ATTACHMENT0 + maxColorAttachments+      = Just . FBOColorAttachment . fromIntegral $ x - GL_COLOR_ATTACHMENT0+   | otherwise = Nothing++maxAuxBuffer :: GLenum+maxAuxBuffer = 246++maxColorAttachments :: GLenum+maxColorAttachments = 16
+ src/Graphics/Rendering/OpenGL/GL/BufferObjects.hs view
@@ -0,0 +1,447 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BufferObjects+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.9 (Buffer Objects) of the OpenGL 2.1+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.BufferObjects (+   -- * Buffer Objects+   BufferObject,++   -- * Binding Buffer Objects+   BufferTarget(..), bindBuffer, arrayBufferBinding,+   vertexAttribArrayBufferBinding,++   -- * Handling Buffer Data+   BufferUsage(..), bufferData, TransferDirection(..), bufferSubData,++   -- * Mapping Buffer Objects+   BufferAccess(..), MappingFailure(..), withMappedBuffer,+   mapBuffer, unmapBuffer,+   bufferAccess, bufferMapped,++   MapBufferUsage(..), Offset, Length,+   mapBufferRange, flushMappedBufferRange,++   -- * Indexed Buffer manipulation+   BufferIndex,+   RangeStartIndex, RangeSize,+   BufferRange,+   IndexedBufferTarget(..),+   bindBufferBase, bindBufferRange,+   indexedBufferStart, indexedBufferSize+) where++import Control.Monad.IO.Class+import Data.Maybe ( fromMaybe )+import Data.ObjectName+import Data.StateVar+import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( Ptr, nullPtr )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexArrays+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++newtype BufferObject = BufferObject { bufferID :: GLuint }+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++instance ObjectName BufferObject where+   isObjectName = liftIO . fmap unmarshalGLboolean . glIsBuffer . bufferID++   deleteObjectNames bufferObjects =+      liftIO . withArrayLen (map bufferID bufferObjects) $+         glDeleteBuffers . fromIntegral++instance GeneratableObjectName BufferObject where+   genObjectNames n =+      liftIO . allocaArray n $ \buf -> do+        glGenBuffers (fromIntegral n) buf+        fmap (map BufferObject) $ peekArray n buf++instance CanBeLabeled BufferObject where+   objectLabel = objectNameLabel GL_BUFFER . bufferID++--------------------------------------------------------------------------------++data BufferTarget =+     ArrayBuffer+   | AtomicCounterBuffer+   | CopyReadBuffer+   | CopyWriteBuffer+   | DispatchIndirectBuffer+   | DrawIndirectBuffer+   | ElementArrayBuffer+   | PixelPackBuffer+   | PixelUnpackBuffer+   | QueryBuffer+   | ShaderStorageBuffer+   | TextureBuffer+   | TransformFeedbackBuffer+   | UniformBuffer+   deriving ( Eq, Ord, Show )++marshalBufferTarget :: BufferTarget -> GLenum+marshalBufferTarget x = case x of+   ArrayBuffer -> GL_ARRAY_BUFFER+   AtomicCounterBuffer -> GL_ATOMIC_COUNTER_BUFFER+   CopyReadBuffer -> GL_COPY_READ_BUFFER+   CopyWriteBuffer -> GL_COPY_WRITE_BUFFER+   DispatchIndirectBuffer -> GL_DISPATCH_INDIRECT_BUFFER+   DrawIndirectBuffer -> GL_DRAW_INDIRECT_BUFFER+   ElementArrayBuffer -> GL_ELEMENT_ARRAY_BUFFER+   PixelPackBuffer -> GL_PIXEL_PACK_BUFFER+   PixelUnpackBuffer -> GL_PIXEL_UNPACK_BUFFER+   QueryBuffer -> GL_QUERY_BUFFER+   ShaderStorageBuffer -> GL_SHADER_STORAGE_BUFFER+   TextureBuffer -> GL_TEXTURE_BUFFER+   TransformFeedbackBuffer -> GL_TRANSFORM_FEEDBACK_BUFFER+   UniformBuffer -> GL_UNIFORM_BUFFER++bufferTargetToGetPName :: BufferTarget -> PName1I+bufferTargetToGetPName x = case x of+   ArrayBuffer -> GetArrayBufferBinding+   AtomicCounterBuffer -> GetAtomicCounterBufferBinding+   CopyReadBuffer -> GetCopyReadBufferBinding+   CopyWriteBuffer -> GetCopyWriteBufferBinding+   DispatchIndirectBuffer -> GetDispatchIndirectBufferBinding+   DrawIndirectBuffer -> GetDrawIndirectBufferBinding+   ElementArrayBuffer -> GetElementArrayBufferBinding+   PixelPackBuffer -> GetPixelPackBufferBinding+   PixelUnpackBuffer -> GetPixelUnpackBufferBinding+   QueryBuffer -> GetQueryBufferBinding+   ShaderStorageBuffer -> GetShaderStorageBufferBinding+   TextureBuffer -> GetTextureBindingBuffer+   TransformFeedbackBuffer -> GetTransformFeedbackBufferBinding+   UniformBuffer -> GetUniformBufferBinding++--------------------------------------------------------------------------------++data BufferUsage =+     StreamDraw+   | StreamRead+   | StreamCopy+   | StaticDraw+   | StaticRead+   | StaticCopy+   | DynamicDraw+   | DynamicRead+   | DynamicCopy+   deriving ( Eq, Ord, Show )++marshalBufferUsage :: BufferUsage -> GLenum+marshalBufferUsage x = case x of+   StreamDraw -> GL_STREAM_DRAW+   StreamRead -> GL_STREAM_READ+   StreamCopy -> GL_STREAM_COPY+   StaticDraw -> GL_STATIC_DRAW+   StaticRead -> GL_STATIC_READ+   StaticCopy -> GL_STATIC_COPY+   DynamicDraw -> GL_DYNAMIC_DRAW+   DynamicRead -> GL_DYNAMIC_READ+   DynamicCopy -> GL_DYNAMIC_COPY++unmarshalBufferUsage :: GLenum -> BufferUsage+unmarshalBufferUsage x+   | x == GL_STREAM_DRAW = StreamDraw+   | x == GL_STREAM_READ = StreamRead+   | x == GL_STREAM_COPY = StreamCopy+   | x == GL_STATIC_DRAW = StaticDraw+   | x == GL_STATIC_READ = StaticRead+   | x == GL_STATIC_COPY = StaticCopy+   | x == GL_DYNAMIC_DRAW = DynamicDraw+   | x == GL_DYNAMIC_READ = DynamicRead+   | x == GL_DYNAMIC_COPY = DynamicCopy+   | otherwise = error ("unmarshalBufferUsage: illegal value " ++ show x)++--------------------------------------------------------------------------------++data BufferAccess =+     ReadOnly+   | WriteOnly+   | ReadWrite+   deriving ( Eq, Ord, Show )++marshalBufferAccess :: BufferAccess -> GLenum+marshalBufferAccess x = case x of+   ReadOnly -> GL_READ_ONLY+   WriteOnly -> GL_WRITE_ONLY+   ReadWrite -> GL_READ_WRITE++unmarshalBufferAccess :: GLenum -> BufferAccess+unmarshalBufferAccess x+   | x == GL_READ_ONLY = ReadOnly+   | x == GL_WRITE_ONLY = WriteOnly+   | x == GL_READ_WRITE = ReadWrite+   | otherwise = error ("unmarshalBufferAccess: illegal value " ++ show x)++--------------------------------------------------------------------------------++bindBuffer :: BufferTarget -> StateVar (Maybe BufferObject)+bindBuffer t = makeStateVar (getBindBuffer t) (setBindBuffer t)++getBindBuffer :: BufferTarget -> IO (Maybe BufferObject)+getBindBuffer = bufferQuery bufferTargetToGetPName++bufferQuery :: (a -> PName1I) -> a -> IO (Maybe BufferObject)+bufferQuery func t = do+   buf <- getInteger1 (BufferObject . fromIntegral) (func t)+   return $ if buf == noBufferObject then Nothing else Just buf++noBufferObject :: BufferObject+noBufferObject = BufferObject 0++setBindBuffer :: BufferTarget -> Maybe BufferObject -> IO ()+setBindBuffer t =+   glBindBuffer (marshalBufferTarget t) . bufferID . fromMaybe noBufferObject++clientArrayTypeToGetPName :: ClientArrayType -> PName1I+clientArrayTypeToGetPName x = case x of+   VertexArray -> GetVertexArrayBufferBinding+   NormalArray -> GetNormalArrayBufferBinding+   ColorArray -> GetColorArrayBufferBinding+   IndexArray -> GetIndexArrayBufferBinding+   TextureCoordArray -> GetTextureCoordArrayBufferBinding+   EdgeFlagArray -> GetEdgeFlagArrayBufferBinding+   FogCoordArray -> GetFogCoordArrayBufferBinding+   SecondaryColorArray -> GetSecondaryColorArrayBufferBinding+   MatrixIndexArray -> error "clientArrayTypeToGetPName: impossible"++arrayBufferBinding :: ClientArrayType -> GettableStateVar (Maybe BufferObject)+arrayBufferBinding t =+   makeGettableStateVar $ case t of+      MatrixIndexArray -> do recordInvalidEnum ; return Nothing+      _ -> bufferQuery clientArrayTypeToGetPName t+++vertexAttribArrayBufferBinding :: AttribLocation -> GettableStateVar (Maybe BufferObject)+vertexAttribArrayBufferBinding location =+   makeGettableStateVar $ do+      buf <- getVertexAttribInteger1 (BufferObject . fromIntegral) location GetVertexAttribArrayBufferBinding+      return $ if buf == noBufferObject then Nothing else Just buf++--------------------------------------------------------------------------------++bufferData :: BufferTarget -> StateVar (GLsizeiptr, Ptr a, BufferUsage)+bufferData t = makeStateVar (getBufferData t) (setBufferData t)++getBufferData :: BufferTarget -> IO (GLsizeiptr, Ptr a, BufferUsage)+getBufferData t = do+   s <- getBufferParameter t fromIntegral GetBufferSize+   p <- getBufferPointer t+   u <- getBufferParameter t unmarshalBufferUsage GetBufferUsage+   return (s, p, u)++setBufferData :: BufferTarget -> (GLsizeiptr, Ptr a, BufferUsage) -> IO ()+setBufferData t (s, p, u) =+   glBufferData (marshalBufferTarget t) s p (marshalBufferUsage u)++--------------------------------------------------------------------------------++data TransferDirection =+     ReadFromBuffer+   | WriteToBuffer+   deriving ( Eq, Ord, Show )++bufferSubData ::+   BufferTarget -> TransferDirection -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()+bufferSubData t WriteToBuffer = glBufferSubData (marshalBufferTarget t)+bufferSubData t ReadFromBuffer = glGetBufferSubData (marshalBufferTarget t)++--------------------------------------------------------------------------------++data GetBufferPName =+     GetBufferSize+   | GetBufferUsage+   | GetBufferAccess+   | GetBufferMapped++marshalGetBufferPName :: GetBufferPName -> GLenum+marshalGetBufferPName x = case x of+   GetBufferSize -> GL_BUFFER_SIZE+   GetBufferUsage -> GL_BUFFER_USAGE+   GetBufferAccess -> GL_BUFFER_ACCESS+   GetBufferMapped -> GL_BUFFER_MAPPED++getBufferParameter :: BufferTarget -> (GLenum -> a) -> GetBufferPName -> IO a+getBufferParameter t f p = with 0 $ \buf -> do+   glGetBufferParameteriv (marshalBufferTarget t)+                          (marshalGetBufferPName p) buf+   peek1 (f . fromIntegral) buf++--------------------------------------------------------------------------------++getBufferPointer :: BufferTarget -> IO (Ptr a)+getBufferPointer t = with nullPtr $ \buf -> do+   glGetBufferPointerv (marshalBufferTarget t) GL_BUFFER_MAP_POINTER buf+   peek1 id buf++--------------------------------------------------------------------------------++data MappingFailure =+     MappingFailed+   | UnmappingFailed+   deriving ( Eq, Ord, Show )++-- | Convenience function for an exception-safe combination of 'mapBuffer' and+-- 'unmapBuffer'.+withMappedBuffer :: BufferTarget -> BufferAccess -> (Ptr a -> IO b) -> (MappingFailure -> IO b) -> IO b+withMappedBuffer t a action err = do+   maybeBuf <- mapBuffer t a+   case maybeBuf  of+      Nothing -> err MappingFailed+      Just buf -> do (ret, ok) <- action buf `finallyRet` unmapBuffer t+                     if ok+                        then return ret+                        else err UnmappingFailed++mapBuffer :: BufferTarget -> BufferAccess -> IO (Maybe (Ptr a))+mapBuffer t = fmap (maybeNullPtr Nothing Just) . mapBuffer_ t++mapBuffer_ :: BufferTarget -> BufferAccess -> IO (Ptr a)+mapBuffer_ t = glMapBuffer (marshalBufferTarget t) . marshalBufferAccess++unmapBuffer :: BufferTarget -> IO Bool+unmapBuffer = fmap unmarshalGLboolean . glUnmapBuffer . marshalBufferTarget++bufferAccess :: BufferTarget -> GettableStateVar BufferAccess+bufferAccess t = makeGettableStateVar $+   getBufferParameter t unmarshalBufferAccess GetBufferAccess++bufferMapped :: BufferTarget -> GettableStateVar Bool+bufferMapped t = makeGettableStateVar $+   getBufferParameter t unmarshalGLboolean GetBufferMapped++--------------------------------------------------------------------------------++data MapBufferUsage =+     Read+   | Write+   | InvalidateRange+   | InvalidateBuffer+   | FlushExplicit+   | Unsychronized+   deriving ( Eq, Ord, Show )++type Offset = GLintptr+type Length = GLsizeiptr++marshalMapBufferUsage :: MapBufferUsage -> GLbitfield+marshalMapBufferUsage x = case x of+    Read -> GL_MAP_READ_BIT+    Write -> GL_MAP_WRITE_BIT+    InvalidateRange -> GL_MAP_INVALIDATE_RANGE_BIT+    InvalidateBuffer -> GL_MAP_INVALIDATE_BUFFER_BIT+    FlushExplicit -> GL_MAP_FLUSH_EXPLICIT_BIT+    Unsychronized -> GL_MAP_FLUSH_EXPLICIT_BIT++--------------------------------------------------------------------------------++mapBufferRange_ ::+   BufferTarget -> Offset -> Length -> [MapBufferUsage] -> IO (Ptr a)+mapBufferRange_ t o l b = glMapBufferRange (marshalBufferTarget t) o l+   (sum (map marshalMapBufferUsage b))++mapBufferRange ::+   BufferTarget -> Offset -> Length -> [MapBufferUsage] -> IO (Maybe (Ptr a))+mapBufferRange t o l b =+   fmap (maybeNullPtr Nothing Just) $ mapBufferRange_ t o l b++flushMappedBufferRange :: BufferTarget -> Offset -> Length -> IO ()+flushMappedBufferRange t = glFlushMappedBufferRange (marshalBufferTarget t)++--------------------------------------------------------------------------------++type BufferIndex = GLuint++type RangeStartIndex = GLintptr+type RangeSize = GLsizeiptr+type BufferRange = (BufferObject, RangeStartIndex, RangeSize)++data IndexedBufferTarget =+     IndexedAtomicCounterBuffer+   | IndexedShaderStorageBuffer+   | IndexedTransformFeedbackBuffer+   | IndexedUniformBuffer+   deriving ( Eq, Ord, Show )++marshalIndexedBufferTarget :: IndexedBufferTarget -> IPName1I+marshalIndexedBufferTarget x = case x of+   IndexedAtomicCounterBuffer -> GetAtomicCounterBuffer+   IndexedShaderStorageBuffer -> GetShaderStorageBuffer+   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBuffer+   IndexedUniformBuffer -> GetUniformBuffer++bindBufferBase :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferObject)+bindBufferBase t i = makeStateVar (getIndexedBufferBinding t i) (setIndexedBufferBase t i)++getIndexedBufferBinding :: IndexedBufferTarget -> BufferIndex -> IO (Maybe BufferObject)+getIndexedBufferBinding t i = do+   buf <- getInteger1i (BufferObject . fromIntegral) (marshalIndexedBufferTarget t) i+   return $ if buf == noBufferObject then Nothing else Just buf++setIndexedBufferBase :: IndexedBufferTarget -> BufferIndex -> Maybe BufferObject -> IO ()+setIndexedBufferBase t i buf =+   case marshalGetPName . marshalIndexedBufferTarget $ t of+      Nothing -> recordInvalidEnum+      Just t' -> glBindBufferBase t' i . bufferID . fromMaybe noBufferObject $ buf++bindBufferRange :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferRange)+bindBufferRange t i = makeStateVar (getIndexedBufferRange t i) (setIndexedBufferRange t i)++getIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> IO (Maybe BufferRange)+getIndexedBufferRange t i = do+  buf <- getInteger1i (BufferObject . fromIntegral) (marshalIndexedBufferTarget t) i+  if buf == noBufferObject+     then return Nothing+     else do start <- get $ indexedBufferStart t i+             size <- get $ indexedBufferSize t i+             return $ Just (buf, start, size)++setIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> Maybe BufferRange -> IO ()+setIndexedBufferRange t i br =+   case marshalGetPName . marshalIndexedBufferTarget $ t of+      Nothing -> recordInvalidEnum+      Just t' -> glBindBufferRange t' i (bufferID buf) start range+   where (buf, start, range) = fromMaybe (noBufferObject, 0, 0) br++getIndexed :: Num a => IPName1I -> BufferIndex -> GettableStateVar a+getIndexed e i = makeGettableStateVar $ getInteger641i fromIntegral e i++marshalIndexedBufferStart :: IndexedBufferTarget -> IPName1I+marshalIndexedBufferStart x = case x of+   IndexedAtomicCounterBuffer -> GetAtomicCounterBufferStart+   IndexedShaderStorageBuffer -> GetShaderStorageBufferStart+   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBufferStart+   IndexedUniformBuffer -> GetUniformBufferStart++indexedBufferStart :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeStartIndex+indexedBufferStart = getIndexed . marshalIndexedBufferStart++marshalIndexedBufferSize :: IndexedBufferTarget -> IPName1I+marshalIndexedBufferSize x = case x of+   IndexedAtomicCounterBuffer -> GetAtomicCounterBufferSize+   IndexedShaderStorageBuffer -> GetShaderStorageBufferSize+   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBufferSize+   IndexedUniformBuffer -> GetUniformBufferSize++indexedBufferSize :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeSize+indexedBufferSize = getIndexed . marshalIndexedBufferSize
+ src/Graphics/Rendering/OpenGL/GL/ByteString.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ByteString+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for interfacing with ByteStrings.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.ByteString (+   B.ByteString, stringQuery, createAndTrimByteString,+   withByteString, withGLstring,+   packUtf8, unpackUtf8,+   getStringWith+) where++import Data.StateVar+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as BI+import qualified Data.ByteString.Unsafe as BU+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++--------------------------------------------------------------------------------++stringQuery :: (a -> GettableStateVar GLsizei)+            -> (a -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())+            -> a+            -> IO B.ByteString+stringQuery lengthVar getStr obj = do+   len <- get (lengthVar obj)+   createByteString len $+      getStr obj len nullPtr++createByteString :: Integral a => a -> (Ptr GLchar -> IO ()) -> IO B.ByteString+createByteString size act = BI.create (fromIntegral size) (act . castPtr)++createAndTrimByteString ::+   (Integral a, Integral b) => a -> (Ptr GLchar -> IO b) -> IO B.ByteString+createAndTrimByteString maxLen act =+   BI.createAndTrim (fromIntegral maxLen) (fmap fromIntegral . act . castPtr)++withByteString :: B.ByteString -> (Ptr GLchar -> GLsizei -> IO b) -> IO b+withByteString bs act =+   BU.unsafeUseAsCStringLen bs $ \(ptr, size) ->+      act (castPtr ptr) (fromIntegral size)++withGLstring :: String -> (Ptr GLchar -> IO a) -> IO a+withGLstring s act = withByteString (packUtf8 (s ++ "\0")) (const . act)++packUtf8 :: String -> B.ByteString+packUtf8 = TE.encodeUtf8 . T.pack++unpackUtf8 :: B.ByteString -> String+unpackUtf8 = T.unpack . TE.decodeUtf8++getStringWith :: IO (Ptr GLubyte) -> IO String+getStringWith getStr = getStr >>= maybeNullPtr (return "") peekGLstring++peekGLstring :: Ptr GLubyte -> IO String+peekGLstring p = fmap unpackUtf8 $ BU.unsafePackCString (castPtr p)
+ src/Graphics/Rendering/OpenGL/GL/Capability.hs view
@@ -0,0 +1,310 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Capability+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling OpenGL capabilities, i.e.+-- boolean state variables.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Capability (+   Capability(..), marshalCapability, unmarshalCapability,+   EnableCap(..), makeCapability, makeStateVarMaybe,++   IndexedEnableCap(..), makeIndexedCapability,+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++data Capability =+     Disabled+   | Enabled+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++marshalCapability :: Capability -> GLboolean+marshalCapability = marshalGLboolean . (Enabled ==)++unmarshalCapability :: GLboolean -> Capability+unmarshalCapability x = if unmarshalGLboolean x then Enabled else Disabled++--------------------------------------------------------------------------------++data EnableCap =+     CapFog+   | CapLighting+   | CapTexture1D+   | CapTexture2D+   | CapTexture2DMultisample+   | CapTexture1DArray+   | CapTextureRectangle+   | CapTextureCubeMap+   | CapTexture3D+   | CapTexture2DArray+   | CapTexture2DMultisampleArray+   | CapTextureCubeMapArray+   | CapLineStipple+   | CapPolygonStipple+   | CapCullFace+   | CapAlphaTest+   | CapBlend+   | CapIndexLogicOp+   | CapColorLogicOp+   | CapDither+   | CapStencilTest+   | CapDepthTest+   | CapClipPlane GLsizei+   | CapLight GLsizei+   | CapTextureGenS+   | CapTextureGenT+   | CapTextureGenR+   | CapTextureGenQ+   | CapMap1Vertex3+   | CapMap1Vertex4+   | CapMap1Color4+   | CapMap1Index+   | CapMap1Normal+   | CapMap1TextureCoord1+   | CapMap1TextureCoord2+   | CapMap1TextureCoord3+   | CapMap1TextureCoord4+   | CapMap2Vertex3+   | CapMap2Vertex4+   | CapMap2Color4+   | CapMap2Index+   | CapMap2Normal+   | CapMap2TextureCoord1+   | CapMap2TextureCoord2+   | CapMap2TextureCoord3+   | CapMap2TextureCoord4+   | CapPointSmooth+   | CapLineSmooth+   | CapPolygonSmooth+   | CapScissorTest+   | CapColorMaterial+   | CapNormalize+   | CapAutoNormal+   | CapPolygonOffsetPoint+   | CapPolygonOffsetLine+   | CapPolygonOffsetFill+   | CapVertexArray+   | CapNormalArray+   | CapColorArray+   | CapIndexArray+   | CapTextureCoordArray+   | CapEdgeFlagArray+   | CapFogCoordArray+   | CapSecondaryColorArray+   | CapMatrixIndexArray+   | CapConvolution1D+   | CapConvolution2D+   | CapSeparable2D+   | CapHistogram+   | CapMinmax+   | CapRescaleNormal+   | CapSharedTexturePalette+   | CapMultisample+   | CapSampleAlphaToCoverage+   | CapSampleAlphaToOne+   | CapSampleCoverage+   | CapColorTable+   | CapPostConvolutionColorTable+   | CapPostColorMatrixColorTable+   | CapColorSum+   | CapWeightSumUnity+   | CapVertexBlend+   | CapWeightArray+   | CapMatrixPalette+   | CapDepthClamp+   | CapDepthBoundsTest+   | CapPrimitiveRestart+   | CapPointSprite+   | CapStencilTestTwoSide+   | CapRasterPositionUnclipped+   | CapRasterizerDiscard+   | CapTextureColorTable+   | CapVertexProgramPointSize+   | CapVertexProgramTwoSide+   | CapDebugOutput+   | CapDebugOutputSynchronous++marshalEnableCap :: EnableCap -> Maybe GLenum+marshalEnableCap x = case x of+   CapFog -> Just GL_FOG+   CapLighting -> Just GL_LIGHTING+   CapTexture1D -> Just GL_TEXTURE_1D+   CapTexture2D -> Just GL_TEXTURE_2D+   CapTexture2DMultisample -> Just GL_TEXTURE_2D_MULTISAMPLE+   CapTexture1DArray -> Just GL_TEXTURE_1D_ARRAY+   CapTextureRectangle -> Just GL_TEXTURE_RECTANGLE+   CapTextureCubeMap -> Just GL_TEXTURE_CUBE_MAP+   CapTexture3D -> Just GL_TEXTURE_3D+   CapTexture2DArray -> Just GL_TEXTURE_2D_ARRAY+   CapTexture2DMultisampleArray -> Just GL_TEXTURE_2D_MULTISAMPLE_ARRAY+   CapTextureCubeMapArray -> Just GL_TEXTURE_CUBE_MAP_ARRAY+   CapLineStipple -> Just GL_LINE_STIPPLE+   CapPolygonStipple -> Just GL_POLYGON_STIPPLE+   CapCullFace -> Just GL_CULL_FACE+   CapAlphaTest -> Just GL_ALPHA_TEST+   CapBlend -> Just GL_BLEND+   CapIndexLogicOp -> Just GL_INDEX_LOGIC_OP+   CapColorLogicOp -> Just GL_COLOR_LOGIC_OP+   CapDither -> Just GL_DITHER+   CapStencilTest -> Just GL_STENCIL_TEST+   CapDepthTest -> Just GL_DEPTH_TEST+   CapClipPlane i -> clipPlaneIndexToEnum i+   CapLight i -> lightIndexToEnum i+   CapTextureGenS -> Just GL_TEXTURE_GEN_S+   CapTextureGenT -> Just GL_TEXTURE_GEN_T+   CapTextureGenR -> Just GL_TEXTURE_GEN_R+   CapTextureGenQ -> Just GL_TEXTURE_GEN_Q+   CapMap1Vertex3 -> Just GL_MAP1_VERTEX_3+   CapMap1Vertex4 -> Just GL_MAP1_VERTEX_4+   CapMap1Color4 -> Just GL_MAP1_COLOR_4+   CapMap1Index -> Just GL_MAP1_INDEX+   CapMap1Normal -> Just GL_MAP1_NORMAL+   CapMap1TextureCoord1 -> Just GL_MAP1_TEXTURE_COORD_1+   CapMap1TextureCoord2 -> Just GL_MAP1_TEXTURE_COORD_2+   CapMap1TextureCoord3 -> Just GL_MAP1_TEXTURE_COORD_3+   CapMap1TextureCoord4 -> Just GL_MAP1_TEXTURE_COORD_4+   CapMap2Vertex3 -> Just GL_MAP2_VERTEX_3+   CapMap2Vertex4 -> Just GL_MAP2_VERTEX_4+   CapMap2Color4 -> Just GL_MAP2_COLOR_4+   CapMap2Index -> Just GL_MAP2_INDEX+   CapMap2Normal -> Just GL_MAP2_NORMAL+   CapMap2TextureCoord1 -> Just GL_MAP2_TEXTURE_COORD_1+   CapMap2TextureCoord2 -> Just GL_MAP2_TEXTURE_COORD_2+   CapMap2TextureCoord3 -> Just GL_MAP2_TEXTURE_COORD_3+   CapMap2TextureCoord4 -> Just GL_MAP2_TEXTURE_COORD_4+   CapPointSmooth -> Just GL_POINT_SMOOTH+   CapLineSmooth -> Just GL_LINE_SMOOTH+   CapPolygonSmooth -> Just GL_POLYGON_SMOOTH+   CapScissorTest -> Just GL_SCISSOR_TEST+   CapColorMaterial -> Just GL_COLOR_MATERIAL+   CapNormalize -> Just GL_NORMALIZE+   CapAutoNormal -> Just GL_AUTO_NORMAL+   CapPolygonOffsetPoint -> Just GL_POLYGON_OFFSET_POINT+   CapPolygonOffsetLine -> Just GL_POLYGON_OFFSET_LINE+   CapPolygonOffsetFill -> Just GL_POLYGON_OFFSET_FILL+   CapVertexArray -> Just GL_VERTEX_ARRAY+   CapNormalArray -> Just GL_NORMAL_ARRAY+   CapColorArray -> Just GL_COLOR_ARRAY+   CapIndexArray -> Just GL_INDEX_ARRAY+   CapTextureCoordArray -> Just GL_TEXTURE_COORD_ARRAY+   CapEdgeFlagArray -> Just GL_EDGE_FLAG_ARRAY+   CapFogCoordArray -> Just GL_FOG_COORD_ARRAY+   CapSecondaryColorArray -> Just GL_SECONDARY_COLOR_ARRAY+   CapMatrixIndexArray -> Just GL_MATRIX_INDEX_ARRAY_ARB+   CapConvolution1D -> Just GL_CONVOLUTION_1D+   CapConvolution2D -> Just GL_CONVOLUTION_2D+   CapSeparable2D -> Just GL_SEPARABLE_2D+   CapHistogram -> Just GL_HISTOGRAM+   CapMinmax -> Just GL_MINMAX+   CapRescaleNormal -> Just GL_RESCALE_NORMAL+   CapSharedTexturePalette -> Just GL_SHARED_TEXTURE_PALETTE_EXT+   CapMultisample -> Just GL_MULTISAMPLE+   CapSampleAlphaToCoverage -> Just GL_SAMPLE_ALPHA_TO_COVERAGE+   CapSampleAlphaToOne -> Just GL_SAMPLE_ALPHA_TO_ONE+   CapSampleCoverage -> Just GL_SAMPLE_COVERAGE+   CapColorTable -> Just GL_COLOR_TABLE+   CapPostConvolutionColorTable -> Just GL_POST_CONVOLUTION_COLOR_TABLE+   CapPostColorMatrixColorTable -> Just GL_POST_COLOR_MATRIX_COLOR_TABLE+   CapColorSum -> Just GL_COLOR_SUM+   CapWeightSumUnity -> Just GL_WEIGHT_SUM_UNITY_ARB+   CapVertexBlend -> Just GL_VERTEX_BLEND_ARB+   CapWeightArray -> Just GL_WEIGHT_ARRAY_ARB+   CapMatrixPalette -> Just GL_MATRIX_PALETTE_ARB+   CapDepthClamp -> Just GL_DEPTH_CLAMP+   CapDepthBoundsTest -> Just GL_DEPTH_BOUNDS_TEST_EXT+   CapPrimitiveRestart -> Just GL_PRIMITIVE_RESTART+   CapPointSprite -> Just GL_POINT_SPRITE+   CapStencilTestTwoSide -> Just GL_STENCIL_TEST_TWO_SIDE_EXT+   CapRasterPositionUnclipped -> Just GL_RASTER_POSITION_UNCLIPPED_IBM+   CapRasterizerDiscard -> Just GL_RASTERIZER_DISCARD+   CapTextureColorTable -> Just GL_TEXTURE_COLOR_TABLE_SGI+   CapVertexProgramPointSize -> Just GL_VERTEX_PROGRAM_POINT_SIZE+   CapVertexProgramTwoSide -> Just GL_VERTEX_PROGRAM_TWO_SIDE+   CapDebugOutput -> Just GL_DEBUG_OUTPUT+   CapDebugOutputSynchronous -> Just GL_DEBUG_OUTPUT_SYNCHRONOUS++--------------------------------------------------------------------------------++makeCapability :: EnableCap -> StateVar Capability+makeCapability cap = makeStateVar (isEnabled cap) (enable cap)++--------------------------------------------------------------------------------++isEnabled :: EnableCap -> IO Capability+isEnabled =+   maybe (do recordInvalidEnum; return Disabled)+         (fmap unmarshalCapability . glIsEnabled) .+   marshalEnableCap++--------------------------------------------------------------------------------++enable :: EnableCap -> Capability -> IO ()+enable cap state = maybe recordInvalidEnum (f state) (marshalEnableCap cap)+   where f Disabled = glDisable+         f Enabled  = glEnable++--------------------------------------------------------------------------------++makeStateVarMaybe :: IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)+makeStateVarMaybe getCap getAct setAct =+   makeStateVar+      (getStateVarMaybe getCap getAct)+      (setStateVarMaybe getCap setAct)++getStateVarMaybe :: IO EnableCap -> IO a -> IO (Maybe a)+getStateVarMaybe getCap act = do+   capability <- fmap makeCapability getCap+   state <- get capability+   if state == Enabled+      then fmap Just act+      else return Nothing++setStateVarMaybe :: IO EnableCap -> (a -> IO ()) -> Maybe a -> IO ()+setStateVarMaybe getCap act val = do+   capability <- fmap makeCapability getCap+   maybe (capability $= Disabled) (\x -> act x >> capability $= Enabled) val++--------------------------------------------------------------------------------++data IndexedEnableCap =+   BlendI++marshalIndexedEnableCap :: IndexedEnableCap -> Maybe GLenum+marshalIndexedEnableCap x = case x of+   BlendI -> Just GL_BLEND++makeIndexedCapability ::(a -> GLuint) -> IndexedEnableCap ->  a+   -> StateVar Capability+makeIndexedCapability f cap val = makeStateVar+   (isIndexedEnabled (f val) cap)+   (\state -> enableIndexed (f val) cap state)++isIndexedEnabled :: GLuint -> IndexedEnableCap -> IO Capability+isIndexedEnabled i =+   maybe (do recordInvalidEnum; return Disabled)+         (\cap -> fmap unmarshalCapability $ glIsEnabledi cap i) .+   marshalIndexedEnableCap++enableIndexed :: GLuint -> IndexedEnableCap -> Capability -> IO ()+enableIndexed i cap state =+   maybe recordInvalidEnum (f state) (marshalIndexedEnableCap cap)+      where f Enabled  = \c -> glEnablei c i+            f Disabled = \c -> glDisablei c i
+ src/Graphics/Rendering/OpenGL/GL/Clipping.hs view
@@ -0,0 +1,57 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Clipping+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 13.5 (Primitive Clipping) of the OpenGL+-- 4.4 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Clipping (+   ClipPlaneName(..), clipPlane, maxClipPlanes+) where++import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++newtype ClipPlaneName = ClipPlaneName GLsizei+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++clipPlane :: ClipPlaneName -> StateVar (Maybe (Plane GLdouble))+clipPlane name =+   makeStateVarMaybe+      (return $ nameToCap name)+      (alloca $ \buf -> do+          clipPlaneAction name $ flip glGetClipPlane $ castPtr buf+          peek buf)+      (\plane -> with plane $ clipPlaneAction name . flip glClipPlane . castPtr)++nameToCap :: ClipPlaneName -> EnableCap+nameToCap (ClipPlaneName i) = CapClipPlane i++clipPlaneAction :: ClipPlaneName -> (GLenum -> IO ()) -> IO ()+clipPlaneAction (ClipPlaneName i) act =+   maybe recordInvalidEnum act (clipPlaneIndexToEnum i)++--------------------------------------------------------------------------------++maxClipPlanes :: GettableStateVar GLsizei+maxClipPlanes = makeGettableStateVar (getSizei1 id GetMaxClipPlanes)
+ src/Graphics/Rendering/OpenGL/GL/ColorSum.hs view
@@ -0,0 +1,25 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ColorSum+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.9 (Color Sum) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.ColorSum (+   colorSum+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.Capability++--------------------------------------------------------------------------------++colorSum :: StateVar Capability+colorSum = makeCapability CapColorSum
+ src/Graphics/Rendering/OpenGL/GL/Colors.hs view
@@ -0,0 +1,510 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Colors+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.14 (Colors and Coloring) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Colors (+   -- * Lighting+   lighting, Light(..), light, maxLights,+   FrontFaceDirection(..), frontFace,++   -- * Lighting Parameter Specification+   Face(..),+   materialAmbient, materialDiffuse, materialAmbientAndDiffuse,+   materialSpecular, materialEmission, materialShininess, maxShininess,+   materialColorIndexes,++   ambient, diffuse, specular,+   position, spotDirection, spotExponent, maxSpotExponent, spotCutoff,+   attenuation,++   lightModelAmbient, lightModelLocalViewer, lightModelTwoSide,+   vertexProgramTwoSide,+   LightModelColorControl(..), lightModelColorControl,++   -- * ColorMaterial+   ColorMaterialParameter(..), colorMaterial,++   -- * Flatshading+   ShadingModel(..), shadeModel,++   -- * Color clamping+   ClampTarget(..), ClampMode(..),+   clampColor,+) where++import Control.Monad+import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Face+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++lighting :: StateVar Capability+lighting = makeCapability CapLighting++--------------------------------------------------------------------------------++newtype Light = Light GLsizei+   deriving ( Eq, Ord, Show )++marshalLight :: Light -> Maybe GLenum+marshalLight (Light l) = lightIndexToEnum l++--------------------------------------------------------------------------------++light :: Light -> StateVar Capability+light (Light l) = makeCapability (CapLight l)++maxLights :: GettableStateVar GLsizei+maxLights = makeGettableStateVar (getSizei1 id GetMaxLights)++--------------------------------------------------------------------------------++data FrontFaceDirection =+     CW+   | CCW+   deriving ( Eq, Ord, Show )++marshalFrontFaceDirection :: FrontFaceDirection -> GLenum+marshalFrontFaceDirection x = case x of+   CW -> GL_CW+   CCW -> GL_CCW++unmarshalFrontFaceDirection :: GLenum -> FrontFaceDirection+unmarshalFrontFaceDirection x+   | x == GL_CW = CW+   | x == GL_CCW = CCW+   | otherwise = error ("unmarshalFrontFaceDirection: illegal value " ++ show x)++--------------------------------------------------------------------------------++frontFace :: StateVar FrontFaceDirection+frontFace =+   makeStateVar+      (getEnum1 unmarshalFrontFaceDirection GetFrontFace)+      (glFrontFace . marshalFrontFaceDirection)++--------------------------------------------------------------------------------++data MaterialParameter =+     MaterialEmission+   | MaterialShininess+   | MaterialAmbientAndDiffuse+   | MaterialColorIndexes+   | MaterialAmbient+   | MaterialDiffuse+   | MaterialSpecular++marshalMaterialParameter :: MaterialParameter -> GLenum+marshalMaterialParameter x = case x of+   MaterialEmission -> GL_EMISSION+   MaterialShininess -> GL_SHININESS+   MaterialAmbientAndDiffuse -> GL_AMBIENT_AND_DIFFUSE+   MaterialColorIndexes -> GL_COLOR_INDEXES+   MaterialAmbient -> GL_AMBIENT+   MaterialDiffuse -> GL_DIFFUSE+   MaterialSpecular -> GL_SPECULAR++--------------------------------------------------------------------------------++materialAmbient :: Face -> StateVar (Color4 GLfloat)+materialAmbient =+   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialAmbient++materialDiffuse :: Face -> StateVar (Color4 GLfloat)+materialDiffuse =+   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialDiffuse++materialAmbientAndDiffuse :: Face -> StateVar (Color4 GLfloat)+materialAmbientAndDiffuse =+   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialAmbientAndDiffuse++materialSpecular :: Face -> StateVar (Color4 GLfloat)+materialSpecular =+   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialSpecular++materialEmission :: Face -> StateVar (Color4 GLfloat)+materialEmission =+   makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialEmission++makeMaterialVar :: Storable a+                => (GLenum -> GLenum -> Ptr a -> IO ())+                -> (GLenum -> GLenum -> Ptr a -> IO ())+                -> MaterialParameter -> Face -> StateVar a+makeMaterialVar getter setter materialParameter face =+   makeStateVar (alloca $ \buf -> do getter f mp buf ; peek buf)+                (\val -> with val $ setter f mp)+   where mp = marshalMaterialParameter materialParameter+         f  = marshalFace face++glGetMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glGetMaterialfvc face pname ptr = glGetMaterialfv face pname (castPtr ptr)++glMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glMaterialfvc face pname ptr = glMaterialfv face pname (castPtr ptr)++--------------------------------------------------------------------------------++materialShininess :: Face -> StateVar GLfloat+materialShininess =+   makeMaterialVar glGetMaterialfvf glMaterialff MaterialShininess++glGetMaterialfvf :: GLenum -> GLenum -> Ptr GLfloat -> IO ()+glGetMaterialfvf face pname ptr = glGetMaterialfv face pname (castPtr ptr)++glMaterialff :: GLenum -> GLenum -> Ptr GLfloat -> IO ()+glMaterialff face pname ptr = glMaterialfv face pname (castPtr ptr)++maxShininess :: GettableStateVar GLfloat+maxShininess = makeGettableStateVar $ getFloat1 id GetMaxShininess++--------------------------------------------------------------------------------++-- Alas, (Index1 GLint, Index1 GLint, Index1 GLint) is not an instance of+-- Storable...++materialColorIndexes ::+   Face -> StateVar (Index1 GLint, Index1 GLint, Index1 GLint)+materialColorIndexes face =+   makeStateVar (getMaterialColorIndexes face) (setMaterialColorIndexes face)++getMaterialColorIndexes :: Face -> IO (Index1 GLint, Index1 GLint, Index1 GLint)+getMaterialColorIndexes face =+   allocaArray 3 $ \buf -> do+      glGetMaterialiv (marshalFace face)+                      (marshalMaterialParameter MaterialColorIndexes)+                      buf+      peek3 (\a d s -> (Index1 a, Index1 d, Index1 s)) buf++setMaterialColorIndexes ::+   Face -> (Index1 GLint, Index1 GLint, Index1 GLint) -> IO ()+setMaterialColorIndexes face (Index1 a, Index1 d, Index1 s) =+   withArray [a, d, s] $+      glMaterialiv (marshalFace face)+                   (marshalMaterialParameter MaterialColorIndexes)++--------------------------------------------------------------------------------++data LightParameter =+     Ambient'+   | Diffuse'+   | Specular'+   | Position+   | SpotDirection+   | SpotExponent+   | SpotCutoff+   | ConstantAttenuation+   | LinearAttenuation+   | QuadraticAttenuation++marshalLightParameter :: LightParameter -> GLenum+marshalLightParameter x = case x of+   Ambient' -> GL_AMBIENT+   Diffuse' -> GL_DIFFUSE+   Specular' -> GL_SPECULAR+   Position -> GL_POSITION+   SpotDirection -> GL_SPOT_DIRECTION+   SpotExponent -> GL_SPOT_EXPONENT+   SpotCutoff -> GL_SPOT_CUTOFF+   ConstantAttenuation -> GL_CONSTANT_ATTENUATION+   LinearAttenuation -> GL_LINEAR_ATTENUATION+   QuadraticAttenuation -> GL_QUADRATIC_ATTENUATION++--------------------------------------------------------------------------------++ambient :: Light -> StateVar (Color4 GLfloat)+ambient = makeLightVar glGetLightfvc glLightfvc Ambient' black++black :: Color4 GLfloat+black = Color4 0 0 0 0++diffuse :: Light -> StateVar (Color4 GLfloat)+diffuse = makeLightVar glGetLightfvc glLightfvc Diffuse' black++specular :: Light -> StateVar (Color4 GLfloat)+specular = makeLightVar glGetLightfvc glLightfvc Specular' black++makeLightVar :: Storable a+             => (GLenum -> GLenum -> Ptr a -> IO ())+             -> (GLenum -> GLenum -> Ptr a -> IO ())+             -> LightParameter -> a -> Light -> StateVar a+makeLightVar getter setter lightParameter defaultValue theLight =+   makeStateVar (maybe (return defaultValue) getLightVar ml)+                (\val -> maybe recordInvalidEnum (setLightVar val) ml)+   where lp          = marshalLightParameter lightParameter+         ml          = marshalLight theLight+         getLightVar = \l -> alloca $ \buf -> do getter l lp buf ; peek buf+         setLightVar = \val l -> with val $ setter l lp++glGetLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glGetLightfvc l pname ptr = glGetLightfv l pname (castPtr ptr)++glLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glLightfvc l pname ptr = glLightfv l pname (castPtr ptr)++--------------------------------------------------------------------------------++position :: Light -> StateVar (Vertex4 GLfloat)+position = makeLightVar glGetLightfvv glLightfvv Position (Vertex4 0 0 0 0)++glLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()+glLightfvv l pname ptr = glLightfv l pname (castPtr ptr)++glGetLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()+glGetLightfvv l pname ptr = glGetLightfv l pname (castPtr ptr)++--------------------------------------------------------------------------------++spotDirection :: Light -> StateVar (Normal3 GLfloat)+spotDirection =+   makeLightVar glGetLightfvn glLightfvn SpotDirection (Normal3 0 0 0)++glLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()+glLightfvn l pname ptr = glLightfv l pname (castPtr ptr)++glGetLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()+glGetLightfvn l pname ptr = glGetLightfv l pname (castPtr ptr)++--------------------------------------------------------------------------------++spotExponent :: Light -> StateVar GLfloat+spotExponent = makeLightVar glGetLightfv glLightfv SpotExponent 0++maxSpotExponent :: GettableStateVar GLfloat+maxSpotExponent = makeGettableStateVar $ getFloat1 id GetMaxSpotExponent++--------------------------------------------------------------------------------++spotCutoff :: Light -> StateVar GLfloat+spotCutoff = makeLightVar glGetLightfv glLightfv SpotCutoff 0++--------------------------------------------------------------------------------++attenuation :: Light -> StateVar (GLfloat, GLfloat, GLfloat)+attenuation theLight =+   makeStateVar+      (liftM3 (,,) (get (constantAttenuation  theLight))+                   (get (linearAttenuation    theLight))+                   (get (quadraticAttenuation theLight)))+      (\(constant, linear, quadratic) -> do+         constantAttenuation  theLight $= constant+         linearAttenuation    theLight $= linear+         quadraticAttenuation theLight $= quadratic)++constantAttenuation :: Light -> StateVar GLfloat+constantAttenuation = makeLightVar glGetLightfv glLightfv ConstantAttenuation 0++linearAttenuation :: Light -> StateVar GLfloat+linearAttenuation = makeLightVar glGetLightfv glLightfv LinearAttenuation 0++quadraticAttenuation :: Light -> StateVar GLfloat+quadraticAttenuation =+   makeLightVar glGetLightfv glLightfv QuadraticAttenuation 0++--------------------------------------------------------------------------------++data LightModelParameter =+     LightModelAmbient+   | LightModelLocalViewer+   | LightModelTwoSide+   | LightModelColorControl++marshalLightModelParameter :: LightModelParameter -> GLenum+marshalLightModelParameter x = case x of+   LightModelAmbient -> GL_LIGHT_MODEL_AMBIENT+   LightModelLocalViewer -> GL_LIGHT_MODEL_LOCAL_VIEWER+   LightModelTwoSide -> GL_LIGHT_MODEL_TWO_SIDE+   LightModelColorControl -> GL_LIGHT_MODEL_COLOR_CONTROL++--------------------------------------------------------------------------------++lightModelAmbient :: StateVar (Color4 GLfloat)+lightModelAmbient =+   makeStateVar+      (getFloat4 Color4 GetLightModelAmbient)+      (\c -> with c $+                glLightModelfv (marshalLightModelParameter LightModelAmbient) . castPtr)++--------------------------------------------------------------------------------++lightModelLocalViewer :: StateVar Capability+lightModelLocalViewer =+   makeLightModelCapVar GetLightModelLocalViewer LightModelLocalViewer++makeLightModelCapVar :: PName1I -> LightModelParameter -> StateVar Capability+makeLightModelCapVar pname lightModelParameter =+   makeStateVar+      (getBoolean1 unmarshalCapability pname)+      (glLightModeli (marshalLightModelParameter lightModelParameter) .+                     fromIntegral . marshalCapability)++--------------------------------------------------------------------------------++lightModelTwoSide :: StateVar Capability+lightModelTwoSide = makeLightModelCapVar GetLightModelTwoSide LightModelTwoSide++vertexProgramTwoSide :: StateVar Capability+vertexProgramTwoSide = makeCapability CapVertexProgramTwoSide++--------------------------------------------------------------------------------++data LightModelColorControl =+     SingleColor+   | SeparateSpecularColor+   deriving ( Eq, Ord, Show )++marshalLightModelColorControl :: LightModelColorControl -> GLenum+marshalLightModelColorControl x = case x of+   SingleColor -> GL_SINGLE_COLOR+   SeparateSpecularColor -> GL_SEPARATE_SPECULAR_COLOR++unmarshalLightModelColorControl :: GLenum -> LightModelColorControl+unmarshalLightModelColorControl x+   | x == GL_SINGLE_COLOR = SingleColor+   | x == GL_SEPARATE_SPECULAR_COLOR = SeparateSpecularColor+   | otherwise = error ("unmarshalLightModelColorControl: illegal value " ++ show x)++--------------------------------------------------------------------------------++lightModelColorControl :: StateVar LightModelColorControl+lightModelColorControl =+   makeStateVar+      (getEnum1 unmarshalLightModelColorControl GetLightModelColorControl)+      (glLightModeli (marshalLightModelParameter LightModelColorControl) .+                     fromIntegral . marshalLightModelColorControl)++--------------------------------------------------------------------------------++data ColorMaterialParameter =+     Ambient+   | Diffuse+   | Specular+   | Emission+   | AmbientAndDiffuse+   deriving ( Eq, Ord, Show )++marshalColorMaterialParameter :: ColorMaterialParameter -> GLenum+marshalColorMaterialParameter x = case x of+   Ambient -> GL_AMBIENT+   Diffuse -> GL_DIFFUSE+   Specular -> GL_SPECULAR+   Emission -> GL_EMISSION+   AmbientAndDiffuse -> GL_AMBIENT_AND_DIFFUSE++unmarshalColorMaterialParameter :: GLenum -> ColorMaterialParameter+unmarshalColorMaterialParameter x+   | x == GL_AMBIENT = Ambient+   | x == GL_DIFFUSE = Diffuse+   | x == GL_SPECULAR = Specular+   | x == GL_EMISSION = Emission+   | x == GL_AMBIENT_AND_DIFFUSE = AmbientAndDiffuse+   | otherwise = error ("unmarshalColorMaterialParameter: illegal value " ++ show x)++--------------------------------------------------------------------------------++colorMaterial :: StateVar (Maybe (Face, ColorMaterialParameter))+colorMaterial =+   makeStateVarMaybe+      (return CapColorMaterial)+      (liftM2+         (,)+         (getEnum1 unmarshalFace GetColorMaterialFace)+         (getEnum1 unmarshalColorMaterialParameter GetColorMaterialParameter))+      (\(face, param) -> glColorMaterial (marshalFace face)+                                         (marshalColorMaterialParameter param))++--------------------------------------------------------------------------------++data ShadingModel =+     Flat+   | Smooth+   deriving ( Eq, Ord, Show )++marshalShadingModel :: ShadingModel -> GLenum+marshalShadingModel x = case x of+   Flat -> GL_FLAT+   Smooth -> GL_SMOOTH++unmarshalShadingModel :: GLenum -> ShadingModel+unmarshalShadingModel x+   | x == GL_FLAT = Flat+   | x == GL_SMOOTH = Smooth+   | otherwise = error ("unmarshalShadingModel: illegal value " ++ show x)++--------------------------------------------------------------------------------++shadeModel :: StateVar ShadingModel+shadeModel =+   makeStateVar+      (getEnum1 unmarshalShadingModel GetShadeModel)+      (glShadeModel . marshalShadingModel)++--------------------------------------------------------------------------------++data ClampTarget =+     ClampVertexColor+   | ClampFragmentColor+   | ClampReadColor+   deriving ( Eq, Ord, Show )++marshalClampTarget :: ClampTarget -> GLenum+marshalClampTarget x = case x of+   ClampVertexColor -> GL_CLAMP_VERTEX_COLOR+   ClampFragmentColor -> GL_CLAMP_FRAGMENT_COLOR+   ClampReadColor -> GL_CLAMP_READ_COLOR++marshalClampTargetToPName :: ClampTarget -> PName1I+marshalClampTargetToPName x = case x of+   ClampFragmentColor -> GetFragmentColorClamp+   ClampVertexColor -> GetVertexColorClamp+   ClampReadColor -> GetReadColorClamp++--------------------------------------------------------------------------------++data ClampMode =+     ClampOn+   | FixedOnly+   | ClampOff+   deriving ( Eq, Ord, Show )++marshalClampMode :: ClampMode -> GLenum+marshalClampMode x = case x of+   ClampOn -> fromIntegral GL_TRUE+   FixedOnly -> GL_FIXED_ONLY+   ClampOff -> fromIntegral GL_FALSE++unmarshalClampMode :: GLenum -> ClampMode+unmarshalClampMode x+   | x == fromIntegral GL_TRUE = ClampOn+   | x == GL_FIXED_ONLY = FixedOnly+   | x == fromIntegral GL_FALSE = ClampOff+   | otherwise = error $ "unmarshalClampMode: unknown enum value " ++ show x++--------------------------------------------------------------------------------++clampColor :: ClampTarget -> StateVar ClampMode+clampColor ct = makeStateVar (getClampColor ct) (setClampColor ct)+   where getClampColor = getEnum1 unmarshalClampMode . marshalClampTargetToPName+         setClampColor t = glClampColor (marshalClampTarget t) . marshalClampMode
+ src/Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ComparisonFunction+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling ComparisonFunction.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.ComparisonFunction (+   ComparisonFunction(..), marshalComparisonFunction,+   unmarshalComparisonFunction+) where++import Graphics.GL++--------------------------------------------------------------------------------++data ComparisonFunction =+     Never+   | Less+   | Equal+   | Lequal+   | Greater+   | Notequal+   | Gequal+   | Always+   deriving ( Eq, Ord, Show )++marshalComparisonFunction :: ComparisonFunction -> GLenum+marshalComparisonFunction x = case x of+   Never -> GL_NEVER+   Less -> GL_LESS+   Equal -> GL_EQUAL+   Lequal -> GL_LEQUAL+   Greater -> GL_GREATER+   Notequal -> GL_NOTEQUAL+   Gequal -> GL_GEQUAL+   Always -> GL_ALWAYS++unmarshalComparisonFunction :: GLenum -> ComparisonFunction+unmarshalComparisonFunction x+   | x == GL_NEVER = Never+   | x == GL_LESS = Less+   | x == GL_EQUAL = Equal+   | x == GL_LEQUAL = Lequal+   | x == GL_GREATER = Greater+   | x == GL_NOTEQUAL = Notequal+   | x == GL_GEQUAL = Gequal+   | x == GL_ALWAYS = Always+   | otherwise = error ("unmarshalComparisonFunction: illegal value " ++ show x)
+ src/Graphics/Rendering/OpenGL/GL/ConditionalRendering.hs view
@@ -0,0 +1,52 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ConditionalRendering+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 10.10 (Conditional Rendering) of the+-- OpenGL 4.4 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.ConditionalRendering (+   ConditionalRenderMode(..),+   beginConditionalRender, endConditionalRender, withConditionalRender+) where++import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.QueryObject+import Graphics.GL++--------------------------------------------------------------------------------++data ConditionalRenderMode =+     QueryWait+   | QueryNoWait+   | QueryByRegionWait+   | QueryByRegionNoWait+   deriving ( Eq, Ord, Show )++marshalConditionalRenderMode :: ConditionalRenderMode -> GLenum+marshalConditionalRenderMode x = case x of+   QueryWait -> GL_QUERY_WAIT+   QueryNoWait -> GL_QUERY_NO_WAIT+   QueryByRegionWait -> GL_QUERY_BY_REGION_WAIT+   QueryByRegionNoWait -> GL_QUERY_BY_REGION_NO_WAIT++--------------------------------------------------------------------------------++beginConditionalRender :: QueryObject -> ConditionalRenderMode -> IO ()+beginConditionalRender q =+   glBeginConditionalRender (queryID q) . marshalConditionalRenderMode++endConditionalRender :: IO ()+endConditionalRender = glEndConditionalRender++withConditionalRender :: QueryObject -> ConditionalRenderMode -> IO a -> IO a+withConditionalRender q m =+   bracket_ (beginConditionalRender q m) endConditionalRender
+ src/Graphics/Rendering/OpenGL/GL/ControlPoint.hs view
@@ -0,0 +1,162 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ControlPoint+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling control points.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.ControlPoint (+   ControlPoint(..)+) where++import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Domain+import Graphics.Rendering.OpenGL.GL.VertexArrays+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++class ControlPoint c where+   map1Target       :: Domain d => c d -> GLenum+   map2Target       :: Domain d => c d -> GLenum+   enableCap1       :: Domain d => c d -> EnableCap+   enableCap2       :: Domain d => c d -> EnableCap+   numComponents    :: Domain d => c d -> Stride+   peekControlPoint :: Domain d => Ptr (c d) -> IO (c d)+   pokeControlPoint :: Domain d => Ptr (c d) -> (c d) -> IO ()++instance ControlPoint Vertex3 where+   map1Target       = marshalMapTarget . const Map1Vertex3+   map2Target       = marshalMapTarget . const Map2Vertex3+   enableCap1       = const CapMap1Vertex3+   enableCap2       = const CapMap2Vertex3+   numComponents    = const 3+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Vertex4 where+   map1Target       = marshalMapTarget . const Map1Vertex4+   map2Target       = marshalMapTarget . const Map2Vertex4+   enableCap1       = const CapMap1Vertex4+   enableCap2       = const CapMap2Vertex4+   numComponents    = const 4+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Index1 where+   map1Target       = marshalMapTarget . const Map1Index+   map2Target       = marshalMapTarget . const Map2Index+   enableCap1       = const CapMap1Index+   enableCap2       = const CapMap2Index+   numComponents    = const 1+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Color4 where+   map1Target       = marshalMapTarget . const Map1Color4+   map2Target       = marshalMapTarget . const Map2Color4+   enableCap1       = const CapMap1Color4+   enableCap2       = const CapMap2Color4+   numComponents    = const 4+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Normal3 where+   map1Target       = marshalMapTarget . const Map1Normal+   map2Target       = marshalMapTarget . const Map2Normal+   enableCap1       = const CapMap1Normal+   enableCap2       = const CapMap2Normal+   numComponents    = const 3+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord1 where+   map1Target       = marshalMapTarget . const Map1TextureCoord1+   map2Target       = marshalMapTarget . const Map2TextureCoord1+   enableCap1       = const CapMap1TextureCoord1+   enableCap2       = const CapMap2TextureCoord1+   numComponents    = const 1+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord2 where+   map1Target       = marshalMapTarget . const Map1TextureCoord2+   map2Target       = marshalMapTarget . const Map2TextureCoord2+   enableCap1       = const CapMap1TextureCoord2+   enableCap2       = const CapMap2TextureCoord2+   numComponents    = const 2+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord3 where+   map1Target       = marshalMapTarget . const Map1TextureCoord3+   map2Target       = marshalMapTarget . const Map2TextureCoord3+   enableCap1       = const CapMap1TextureCoord3+   enableCap2       = const CapMap2TextureCoord3+   numComponents    = const 3+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord4 where+   map1Target       = marshalMapTarget . const Map1TextureCoord4+   map2Target       = marshalMapTarget . const Map2TextureCoord4+   enableCap1       = const CapMap1TextureCoord4+   enableCap2       = const CapMap2TextureCoord4+   numComponents    = const 4+   peekControlPoint = peek+   pokeControlPoint = poke++--------------------------------------------------------------------------------++data MapTarget =+     Map1Color4+   | Map1Index+   | Map1Normal+   | Map1TextureCoord1+   | Map1TextureCoord2+   | Map1TextureCoord3+   | Map1TextureCoord4+   | Map1Vertex3+   | Map1Vertex4+   | Map2Color4+   | Map2Index+   | Map2Normal+   | Map2TextureCoord1+   | Map2TextureCoord2+   | Map2TextureCoord3+   | Map2TextureCoord4+   | Map2Vertex3+   | Map2Vertex4++marshalMapTarget :: MapTarget -> GLenum+marshalMapTarget x = case x of+   Map1Color4 -> GL_MAP1_COLOR_4+   Map1Index -> GL_MAP1_INDEX+   Map1Normal -> GL_MAP1_NORMAL+   Map1TextureCoord1 -> GL_MAP1_TEXTURE_COORD_1+   Map1TextureCoord2 -> GL_MAP1_TEXTURE_COORD_2+   Map1TextureCoord3 -> GL_MAP1_TEXTURE_COORD_3+   Map1TextureCoord4 -> GL_MAP1_TEXTURE_COORD_4+   Map1Vertex3 -> GL_MAP1_VERTEX_3+   Map1Vertex4 -> GL_MAP1_VERTEX_4+   Map2Color4 -> GL_MAP2_COLOR_4+   Map2Index -> GL_MAP2_INDEX+   Map2Normal -> GL_MAP2_NORMAL+   Map2TextureCoord1 -> GL_MAP2_TEXTURE_COORD_1+   Map2TextureCoord2 -> GL_MAP2_TEXTURE_COORD_2+   Map2TextureCoord3 -> GL_MAP2_TEXTURE_COORD_3+   Map2TextureCoord4 -> GL_MAP2_TEXTURE_COORD_4+   Map2Vertex3 -> GL_MAP2_VERTEX_3+   Map2Vertex4 -> GL_MAP2_VERTEX_4
+ src/Graphics/Rendering/OpenGL/GL/CoordTrans.hs view
@@ -0,0 +1,484 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.CoordTrans+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.11 (Coordinate Transformations) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.CoordTrans (+   -- * Controlling the Viewport+   depthRange,+   Position(..), Size(..), viewport, maxViewportDims,++   -- * Matrices+   MatrixMode(..), matrixMode,+   MatrixOrder(..), MatrixComponent(rotate,translate,scale), Matrix(..),+   matrix, multMatrix, GLmatrix, loadIdentity,+   ortho, frustum, depthClamp,+   activeTexture,+   preservingMatrix, unsafePreservingMatrix,+   stackDepth, maxStackDepth,++   -- * Normal Transformation+   rescaleNormal, normalize,++   -- * Generating Texture Coordinates+   Plane(..), TextureCoordName(..), TextureGenMode(..), textureGenMode+) where++import Data.StateVar+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.MatrixComponent+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++-- | After clipping and division by /w/, depth coordinates range from -1 to 1,+-- corresponding to the near and far clipping planes. 'depthRange' specifies a+-- linear mapping of the normalized depth coordinates in this range to window+-- depth coordinates. Regardless of the actual depth buffer implementation,+-- window coordinate depth values are treated as though they range from 0+-- through 1 (like color components). Thus, the values accepted by 'depthRange'+-- are both clamped to this range before they are accepted.+--+-- The initial setting of (0, 1) maps the near plane to 0 and the far plane to+-- 1. With this mapping, the depth buffer range is fully utilized.+--+-- It is not necessary that the near value be less than the far value. Reverse+-- mappings such as (1, 0) are acceptable.++depthRange :: StateVar (GLclampd, GLclampd)+depthRange = makeStateVar (getClampd2 (,) GetDepthRange) (uncurry glDepthRange)++--------------------------------------------------------------------------------++-- | A 2-dimensional position, measured in pixels.+data Position = Position !GLint !GLint+   deriving ( Eq, Ord, Show )++-- | A 2-dimensional size, measured in pixels.+data Size = Size !GLsizei !GLsizei+   deriving ( Eq, Ord, Show )++-- | Controls the affine transformation from normalized device coordinates to+-- window coordinates. The viewport state variable consists of the coordinates+-- (/x/, /y/) of the lower left corner of the viewport rectangle, (in pixels,+-- initial value (0,0)), and the size (/width/, /height/) of the viewport. When+-- a GL context is first attached to a window, /width/ and /height/ are set to+-- the dimensions of that window.+--+-- Let (/xnd/, /ynd/) be normalized device coordinates. Then the window+-- coordinates (/xw/, /yw/) are computed as follows:+--+-- /xw/ = (/xnd/ + 1) (/width/  \/ 2) + /x/+--+-- /yw/ = (/ynd/ + 1) (/heigth/ \/ 2) + /y/+--+-- Viewport width and height are silently clamped to a range that depends on the+-- implementation, see 'maxViewportDims'.++viewport :: StateVar (Position, Size)+viewport = makeStateVar (getInteger4 makeVp GetViewport)+                        (\(Position x y, Size w h) -> glViewport x y w h)+   where makeVp x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))++-- | The implementation-dependent maximum viewport width and height.++maxViewportDims :: GettableStateVar Size+maxViewportDims = makeGettableStateVar (getSizei2 Size GetMaxViewportDims)++--------------------------------------------------------------------------------++-- | A matrix stack.++data MatrixMode =+     Modelview GLsizei  -- ^ The modelview matrix stack of the specified vertex unit.+   | Projection         -- ^ The projection matrix stack.+   | Texture            -- ^ The texture matrix stack.+   | Color              -- ^ The color matrix stack.+   | MatrixPalette      -- ^ The matrix palette stack.+   deriving ( Eq, Ord, Show )++marshalMatrixMode :: MatrixMode -> Maybe GLenum+marshalMatrixMode x = case x of+   Modelview i -> modelviewIndexToEnum i+   Projection -> Just GL_PROJECTION+   Texture -> Just GL_TEXTURE+   Color -> Just GL_COLOR+   MatrixPalette -> Just GL_MATRIX_PALETTE_ARB++unmarshalMatrixMode :: GLenum -> MatrixMode+unmarshalMatrixMode x+   | x == GL_PROJECTION = Projection+   | x == GL_TEXTURE = Texture+   | x == GL_COLOR = Color+   | x == GL_MATRIX_PALETTE_ARB = MatrixPalette+   | otherwise =+        case modelviewEnumToIndex x of+           Just i -> Modelview i+           Nothing -> error ("unmarshalMatrixMode: illegal value " ++ show x)++matrixModeToGetMatrix :: MatrixMode -> PNameMatrix+matrixModeToGetMatrix x = case x of+   Modelview _   -> GetModelviewMatrix -- ???+   Projection    -> GetProjectionMatrix+   Texture       -> GetTextureMatrix+   Color         -> GetColorMatrix+   MatrixPalette -> GetMatrixPalette++matrixModeToGetStackDepth :: MatrixMode -> PName1I+matrixModeToGetStackDepth x =  case x of+   Modelview _   -> GetModelviewStackDepth+   Projection    -> GetProjectionStackDepth+   Texture       -> GetTextureStackDepth+   Color         -> GetColorMatrixStackDepth+   MatrixPalette -> error "matrixModeToGetStackDepth: impossible"++matrixModeToGetMaxStackDepth :: MatrixMode -> PName1I+matrixModeToGetMaxStackDepth x = case x of+   Modelview _    -> GetMaxModelviewStackDepth+   Projection     -> GetMaxProjectionStackDepth+   Texture        -> GetMaxTextureStackDepth+   Color          -> GetMaxColorMatrixStackDepth+   MatrixPalette  -> GetMaxMatrixPaletteStackDepth++--------------------------------------------------------------------------------++-- | Controls which matrix stack is the target for subsequent matrix operations.+-- The initial value is ('Modelview' 0).++matrixMode :: StateVar MatrixMode+matrixMode =+   makeStateVar (getEnum1 unmarshalMatrixMode GetMatrixMode)+                (maybe recordInvalidValue glMatrixMode . marshalMatrixMode)++--------------------------------------------------------------------------------++data MatrixOrder = ColumnMajor | RowMajor+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++class Matrix m where+   -- | Create a new matrix of the given order (containing undefined elements)+   -- and call the action to fill it with 4x4 elements.+   withNewMatrix ::+      MatrixComponent c => MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)++   -- | Call the action with the given matrix. /Note:/ The action is /not/+   -- allowed to modify the matrix elements!+   withMatrix ::+      MatrixComponent c => m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a++   newMatrix :: MatrixComponent c => MatrixOrder -> [c] -> IO (m c)+   getMatrixComponents :: MatrixComponent c => MatrixOrder -> m c -> IO [c]++   withNewMatrix order act =+      allocaArray 16 $ \p -> do+         act p+         components <- peekArray 16 p+         newMatrix order components++   withMatrix mat act = do+      components <- getMatrixComponents ColumnMajor mat+      withArray components $ act ColumnMajor++   newMatrix order components =+      withNewMatrix order $ flip pokeArray (take 16 components)++   getMatrixComponents desiredOrder mat =+      withMatrix mat $ \order p ->+        if desiredOrder == order+           then peekArray 16 p+           else mapM (peekElemOff p) [ 0, 4,  8, 12,+                                       1, 5,  9, 13,+                                       2, 6, 10, 14,+                                       3, 7, 11, 15 ]++--------------------------------------------------------------------------------++matrix :: (Matrix m, MatrixComponent c) => Maybe MatrixMode -> StateVar (m c)+matrix maybeMode =+   makeStateVar+      (maybe (get matrixMode) return maybeMode >>= (getMatrix' . matrixModeToGetMatrix))+      (maybe id withMatrixMode maybeMode . setMatrix)++withMatrixMode :: MatrixMode -> IO a -> IO a+withMatrixMode mode act =+   preservingMatrixMode $ do+      matrixMode $= mode+      act++getMatrix' :: (Matrix m, MatrixComponent c) => PNameMatrix -> IO (m c)+getMatrix' = withNewMatrix ColumnMajor . getMatrix++setMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()+setMatrix mat =+   withMatrix mat $ \order ->+      case order of+         ColumnMajor -> loadMatrix+         RowMajor    -> loadTransposeMatrix++multMatrix :: (Matrix m, MatrixComponent c) => m c -> IO ()+multMatrix mat =+   withMatrix mat $ \order ->+      case order of+         ColumnMajor -> multMatrix_+         RowMajor    -> multTransposeMatrix++--------------------------------------------------------------------------------++data GLmatrix a = GLmatrix MatrixOrder (ForeignPtr a)+   deriving ( Eq, Ord, Show )++instance Matrix GLmatrix where+   withNewMatrix order f = do+      fp <- mallocForeignPtrArray 16+      withForeignPtr fp f+      return $ GLmatrix order fp++   withMatrix (GLmatrix order fp) f = withForeignPtr fp (f order)++--------------------------------------------------------------------------------++loadIdentity :: IO ()+loadIdentity = glLoadIdentity++--------------------------------------------------------------------------------++ortho :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()+ortho = glOrtho++frustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()+frustum = glFrustum++--------------------------------------------------------------------------------++depthClamp :: StateVar Capability+depthClamp = makeCapability CapDepthClamp++--------------------------------------------------------------------------------++activeTexture :: StateVar TextureUnit+activeTexture = makeStateVar (getEnum1 unmarshalTextureUnit GetActiveTexture)+                             (glActiveTexture . marshalTextureUnit)++--------------------------------------------------------------------------------++-- | Push the current matrix stack down by one, duplicating the current matrix,+-- excute the given action, and pop the current matrix stack, replacing the+-- current matrix with the one below it on the stack (i.e. restoring it to its+-- previous state). The returned value is that of the given action. Note that+-- a round-trip to the server is probably required. For a more efficient+-- version, see 'unsafePreservingMatrix'.++preservingMatrix :: IO a -> IO a+preservingMatrix = unsafePreservingMatrix . preservingMatrixMode++-- performance paranoia: No (un-)marshaling by avoiding matrixMode+preservingMatrixMode :: IO a -> IO a+preservingMatrixMode = bracket (getEnum1 id GetMatrixMode) glMatrixMode . const++-- | A more efficient, but potentially dangerous version of 'preservingMatrix':+-- The given action is not allowed to throw an exception or change the+-- current matrix mode permanently.++unsafePreservingMatrix :: IO a -> IO a+unsafePreservingMatrix = unsafeBracket_ glPushMatrix glPopMatrix++--------------------------------------------------------------------------------++stackDepth :: Maybe MatrixMode -> GettableStateVar GLsizei+stackDepth maybeMode =+   makeGettableStateVar $+      case maybeMode of+         Nothing -> getSizei1 id GetCurrentMatrixStackDepth -- only with ARB_fragment_program+         Just MatrixPalette -> do recordInvalidEnum ; return 0+         Just mode -> getSizei1 id (matrixModeToGetStackDepth mode)++maxStackDepth :: MatrixMode -> GettableStateVar GLsizei+maxStackDepth =+   makeGettableStateVar . getSizei1 id . matrixModeToGetMaxStackDepth++--------------------------------------------------------------------------------++-- | If 'rescaleNormal' contains 'Enabled', normal vectors specified with+-- 'Graphics.Rendering.OpenGL.GL.VertexSpec.normal' are scaled by a scaling+-- factor derived from the modelview matrix. 'rescaleNormal' requires that the+-- originally specified normals were of unit length, and that the modelview+-- matrix contains only uniform scales for proper results. The initial value of+-- 'rescaleNormal' is 'Disabled'.++rescaleNormal :: StateVar Capability+rescaleNormal = makeCapability CapRescaleNormal++-- | If 'normalize' contains 'Enabled', normal vectors specified with+-- 'Graphics.Rendering.OpenGL.GL.VertexSpec.normal' are scaled to unit length+-- after transformation. The initial value of 'normalize' is 'Disabled'.++normalize :: StateVar Capability+normalize = makeCapability CapNormalize++--------------------------------------------------------------------------------++data Plane a = Plane !a !a !a !a+   deriving ( Eq, Ord, Show )++instance Storable a => Storable (Plane a) where+   sizeOf    ~(Plane a _ _ _) = 4 * sizeOf a+   alignment ~(Plane a _ _ _) = alignment a+   peek                       = peek4 Plane . castPtr+   poke ptr   (Plane a b c d) = poke4 (castPtr ptr) a b c d++--------------------------------------------------------------------------------++data TextureCoordName =+     S+   | T+   | R+   | Q+   deriving ( Eq, Ord, Show )++marshalTextureCoordName :: TextureCoordName -> GLenum+marshalTextureCoordName x = case x of+   S -> GL_S+   T -> GL_T+   R -> GL_R+   Q -> GL_Q++--------------------------------------------------------------------------------++data TextureGenParameter =+     TextureGenMode+   | ObjectPlane+   | EyePlane++marshalTextureGenParameter :: TextureGenParameter -> GLenum+marshalTextureGenParameter x = case x of+   TextureGenMode -> GL_TEXTURE_GEN_MODE+   ObjectPlane -> GL_OBJECT_PLANE+   EyePlane -> GL_EYE_PLANE++--------------------------------------------------------------------------------++data TextureGenMode' =+     EyeLinear'+   | ObjectLinear'+   | SphereMap'+   | NormalMap'+   | ReflectionMap'++marshalTextureGenMode' :: TextureGenMode' -> GLint+marshalTextureGenMode' x = fromIntegral $ case x of+   EyeLinear' -> GL_EYE_LINEAR+   ObjectLinear' -> GL_OBJECT_LINEAR+   SphereMap' -> GL_SPHERE_MAP+   NormalMap' -> GL_NORMAL_MAP+   ReflectionMap' -> GL_REFLECTION_MAP++unmarshalTextureGenMode' :: GLint -> TextureGenMode'+unmarshalTextureGenMode' x+   | y == GL_EYE_LINEAR = EyeLinear'+   | y == GL_OBJECT_LINEAR = ObjectLinear'+   | y == GL_SPHERE_MAP = SphereMap'+   | y == GL_NORMAL_MAP = NormalMap'+   | y == GL_REFLECTION_MAP = ReflectionMap'+   | otherwise = error ("unmarshalTextureGenMode': illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++data TextureGenMode =+     EyeLinear    (Plane GLdouble)+   | ObjectLinear (Plane GLdouble)+   | SphereMap+   | NormalMap+   | ReflectionMap+   deriving ( Eq, Ord, Show )++marshalTextureGenMode :: TextureGenMode -> GLint+marshalTextureGenMode = marshalTextureGenMode' . convertMode+   where convertMode (EyeLinear    _) = EyeLinear'+         convertMode (ObjectLinear _) = ObjectLinear'+         convertMode SphereMap        = SphereMap'+         convertMode NormalMap        = NormalMap'+         convertMode ReflectionMap    = ReflectionMap'++--------------------------------------------------------------------------------++textureGenMode :: TextureCoordName -> StateVar (Maybe TextureGenMode)+textureGenMode coord =+   makeStateVarMaybe+      (return $ textureCoordNameToEnableCap coord)+      (do mode <- getMode coord+          case mode of+             EyeLinear'     -> fmap EyeLinear $ getPlane coord EyePlane+             ObjectLinear'  -> fmap ObjectLinear $ getPlane coord ObjectPlane+             SphereMap'     -> return SphereMap+             NormalMap'     -> return NormalMap+             ReflectionMap' -> return ReflectionMap)+      (\mode -> do+         setMode coord mode+         case mode of+            EyeLinear    plane -> setPlane coord EyePlane    plane+            ObjectLinear plane -> setPlane coord ObjectPlane plane+            _ -> return ())++--------------------------------------------------------------------------------++textureCoordNameToEnableCap :: TextureCoordName -> EnableCap+textureCoordNameToEnableCap coord = case coord of+   S -> CapTextureGenS+   T -> CapTextureGenT+   R -> CapTextureGenR+   Q -> CapTextureGenQ++--------------------------------------------------------------------------------++getMode :: TextureCoordName -> IO TextureGenMode'+getMode coord = alloca $ \buf -> do+   glGetTexGeniv (marshalTextureCoordName coord)+                 (marshalTextureGenParameter TextureGenMode)+                 buf+   peek1 unmarshalTextureGenMode' buf++setMode :: TextureCoordName -> TextureGenMode -> IO ()+setMode coord mode =+   glTexGeni (marshalTextureCoordName coord)+             (marshalTextureGenParameter TextureGenMode)+             (marshalTextureGenMode mode)++--------------------------------------------------------------------------------++getPlane :: TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)+getPlane coord param = alloca $ \planeBuffer -> do+   glGetTexGendv (marshalTextureCoordName coord)+                 (marshalTextureGenParameter param)+                 (castPtr planeBuffer)+   peek planeBuffer++setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()+setPlane coord param plane =+   with plane $ \planeBuffer ->+      glTexGendv (marshalTextureCoordName coord)+                 (marshalTextureGenParameter param)+                 (castPtr planeBuffer)
+ src/Graphics/Rendering/OpenGL/GL/DataType.hs view
@@ -0,0 +1,145 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.DataType+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling DataType.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.DataType (+   DataType(..), marshalDataType, unmarshalDataType,+   DataRepresentation(..), unmarshalDataRepresentation+) where++import Graphics.GL++--------------------------------------------------------------------------------++-- basically table 8.7 (pixel data type parameter) plus a few additions+data DataType =+     UnsignedByte+   | Byte+   | UnsignedShort+   | Short+   | UnsignedInt+   | Int+   | HalfFloat+   | Float+   | UnsignedByte332+   | UnsignedByte233Rev+   | UnsignedShort565+   | UnsignedShort565Rev+   | UnsignedShort4444+   | UnsignedShort4444Rev+   | UnsignedShort5551+   | UnsignedShort1555Rev+   | UnsignedInt8888+   | UnsignedInt8888Rev+   | UnsignedInt1010102+   | UnsignedInt2101010Rev+   | UnsignedInt248+   | UnsignedInt10f11f11fRev+   | UnsignedInt5999Rev+   | Float32UnsignedInt248Rev+   | Bitmap                    -- pixel data, deprecated in 3.1+   | UnsignedShort88           -- MESA_ycbcr_texture/APPLE_ycbcr_422+   | UnsignedShort88Rev        -- MESA_ycbcr_texture/APPLE_ycbcr_422+   | Double                    -- vertex arrays (EXT_vertex_array, now core)+   | TwoBytes                  -- CallLists+   | ThreeBytes                -- CallLists+   | FourBytes                 -- CallLists+   deriving ( Eq, Ord, Show )++marshalDataType :: DataType -> GLenum+marshalDataType x = case x of+   UnsignedByte -> GL_UNSIGNED_BYTE+   Byte -> GL_BYTE+   UnsignedShort -> GL_UNSIGNED_SHORT+   Short -> GL_SHORT+   UnsignedInt -> GL_UNSIGNED_INT+   Int -> GL_INT+   HalfFloat -> GL_HALF_FLOAT+   Float -> GL_FLOAT+   UnsignedByte332 -> GL_UNSIGNED_BYTE_3_3_2+   UnsignedByte233Rev -> GL_UNSIGNED_BYTE_2_3_3_REV+   UnsignedShort565 -> GL_UNSIGNED_SHORT_5_6_5+   UnsignedShort565Rev -> GL_UNSIGNED_SHORT_5_6_5_REV+   UnsignedShort4444 -> GL_UNSIGNED_SHORT_4_4_4_4+   UnsignedShort4444Rev -> GL_UNSIGNED_SHORT_4_4_4_4_REV+   UnsignedShort5551 -> GL_UNSIGNED_SHORT_5_5_5_1+   UnsignedShort1555Rev -> GL_UNSIGNED_SHORT_1_5_5_5_REV+   UnsignedInt8888 -> GL_UNSIGNED_INT_8_8_8_8+   UnsignedInt8888Rev -> GL_UNSIGNED_INT_8_8_8_8_REV+   UnsignedInt1010102 -> GL_UNSIGNED_INT_10_10_10_2+   UnsignedInt2101010Rev -> GL_UNSIGNED_INT_2_10_10_10_REV+   UnsignedInt248 -> GL_UNSIGNED_INT_24_8+   UnsignedInt10f11f11fRev -> GL_UNSIGNED_INT_10F_11F_11F_REV+   UnsignedInt5999Rev -> GL_UNSIGNED_INT_5_9_9_9_REV+   Float32UnsignedInt248Rev -> GL_FLOAT_32_UNSIGNED_INT_24_8_REV+   Bitmap -> GL_BITMAP+   UnsignedShort88 -> GL_UNSIGNED_SHORT_8_8_APPLE+   UnsignedShort88Rev -> GL_UNSIGNED_SHORT_8_8_REV_APPLE+   Double -> GL_DOUBLE+   TwoBytes -> GL_2_BYTES+   ThreeBytes -> GL_3_BYTES+   FourBytes -> GL_4_BYTES++unmarshalDataType :: GLenum -> DataType+unmarshalDataType x+   | x == GL_UNSIGNED_BYTE = UnsignedByte+   | x == GL_BYTE = Byte+   | x == GL_UNSIGNED_SHORT = UnsignedShort+   | x == GL_SHORT = Short+   | x == GL_UNSIGNED_INT = UnsignedInt+   | x == GL_INT = Int+   | x == GL_HALF_FLOAT = HalfFloat+   | x == GL_FLOAT = Float+   | x == GL_UNSIGNED_BYTE_3_3_2 = UnsignedByte332+   | x == GL_UNSIGNED_BYTE_2_3_3_REV = UnsignedByte233Rev+   | x == GL_UNSIGNED_SHORT_5_6_5 = UnsignedShort565+   | x == GL_UNSIGNED_SHORT_5_6_5_REV = UnsignedShort565Rev+   | x == GL_UNSIGNED_SHORT_4_4_4_4 = UnsignedShort4444+   | x == GL_UNSIGNED_SHORT_4_4_4_4_REV = UnsignedShort4444Rev+   | x == GL_UNSIGNED_SHORT_5_5_5_1 = UnsignedShort5551+   | x == GL_UNSIGNED_SHORT_1_5_5_5_REV = UnsignedShort1555Rev+   | x == GL_UNSIGNED_INT_8_8_8_8 = UnsignedInt8888+   | x == GL_UNSIGNED_INT_8_8_8_8_REV = UnsignedInt8888Rev+   | x == GL_UNSIGNED_INT_10_10_10_2 = UnsignedInt1010102+   | x == GL_UNSIGNED_INT_2_10_10_10_REV = UnsignedInt2101010Rev+   | x == GL_UNSIGNED_INT_24_8 = UnsignedInt248+   | x == GL_UNSIGNED_INT_10F_11F_11F_REV = UnsignedInt10f11f11fRev+   | x == GL_UNSIGNED_INT_5_9_9_9_REV = UnsignedInt5999Rev+   | x == GL_FLOAT_32_UNSIGNED_INT_24_8_REV = Float32UnsignedInt248Rev+   | x == GL_BITMAP = Bitmap+   | x == GL_UNSIGNED_SHORT_8_8_APPLE = UnsignedShort88+   | x == GL_UNSIGNED_SHORT_8_8_REV_APPLE = UnsignedShort88Rev+   | x == GL_DOUBLE = Double+   | x == GL_2_BYTES = TwoBytes+   | x == GL_3_BYTES = ThreeBytes+   | x == GL_4_BYTES = FourBytes+   | otherwise = error ("unmarshalDataType: illegal value " ++ show x)++data DataRepresentation+   = SignedNormalizedRepresentation+   | UnsignedNormalizedRepresentation+   | FloatRepresentation+   | IntRepresentation+   | UnsignedIntRepresentation+   deriving ( Eq, Ord, Show )++unmarshalDataRepresentation :: GLenum -> Maybe DataRepresentation+unmarshalDataRepresentation x+   | x == GL_SIGNED_NORMALIZED = Just SignedNormalizedRepresentation+   | x == GL_UNSIGNED_NORMALIZED = Just UnsignedNormalizedRepresentation+   | x == GL_FLOAT = Just FloatRepresentation+   | x == GL_INT = Just IntRepresentation+   | x == GL_UNSIGNED_INT = Just UnsignedIntRepresentation+   | x == GL_NONE = Nothing+   | otherwise = error $ "unmarshalDataRepresentation: illegal value " ++ show x
+ src/Graphics/Rendering/OpenGL/GL/DebugOutput.hs view
@@ -0,0 +1,327 @@+{-# LANGUAGE CPP #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.DebugOutput+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 20 (Debug Output) of the OpenGL 4.5+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.DebugOutput (+  -- * Debug Messages+  debugOutput, DebugMessage(..), DebugSource(..), DebugType(..),+  DebugMessageID(DebugMessageID), DebugSeverity(..), maxDebugMessageLength,++  -- * Debug Message Callback+  debugMessageCallback,++  -- * Debug Message Log+  maxDebugLoggedMessages, debugLoggedMessages,++  -- * Controlling Debug Messages+  MessageGroup(..), debugMessageControl,++  -- * Externally Generated Messages+  debugMessageInsert,++  -- * Debug Groups+  DebugGroup(..), pushDebugGroup, popDebugGroup, withDebugGroup,+  maxDebugGroupStackDepth,++  -- * Debug Labels+  CanBeLabeled(..), maxLabelLength,++  -- * Asynchronous and Synchronous Debug Output+  debugOutputSynchronous+) where++import Control.Monad ( unless, replicateM )+import Data.StateVar+import Foreign.C.String ( peekCStringLen, withCStringLen )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( allocaArray, withArrayLen )+import Foreign.Ptr (+  nullPtr, castPtrToFunPtr, FunPtr, nullFunPtr, freeHaskellFunPtr )+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++debugOutput :: StateVar Capability+debugOutput = makeCapability CapDebugOutput++--------------------------------------------------------------------------------++data DebugMessage =+  DebugMessage DebugSource DebugType DebugMessageID DebugSeverity String+  deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data DebugSource =+    DebugSourceAPI+  | DebugSourceShaderCompiler+  | DebugSourceWindowSystem+  | DebugSourceThirdParty+  | DebugSourceApplication+  | DebugSourceOther+  deriving ( Eq, Ord, Show )++marshalDebugSource :: DebugSource -> GLenum+marshalDebugSource x = case x of+  DebugSourceAPI -> GL_DEBUG_SOURCE_API+  DebugSourceShaderCompiler -> GL_DEBUG_SOURCE_SHADER_COMPILER+  DebugSourceWindowSystem -> GL_DEBUG_SOURCE_WINDOW_SYSTEM+  DebugSourceThirdParty -> GL_DEBUG_SOURCE_THIRD_PARTY+  DebugSourceApplication -> GL_DEBUG_SOURCE_APPLICATION+  DebugSourceOther -> GL_DEBUG_SOURCE_OTHER++unmarshalDebugSource :: GLenum -> DebugSource+unmarshalDebugSource x+  | x == GL_DEBUG_SOURCE_API = DebugSourceAPI+  | x == GL_DEBUG_SOURCE_SHADER_COMPILER = DebugSourceShaderCompiler+  | x == GL_DEBUG_SOURCE_WINDOW_SYSTEM = DebugSourceWindowSystem+  | x == GL_DEBUG_SOURCE_THIRD_PARTY = DebugSourceThirdParty+  | x == GL_DEBUG_SOURCE_APPLICATION = DebugSourceApplication+  | x == GL_DEBUG_SOURCE_OTHER = DebugSourceOther+  | otherwise = error ("unmarshalDebugSource: illegal value " ++ show x)++--------------------------------------------------------------------------------++data DebugType =+    DebugTypeError+  | DebugTypeDeprecatedBehavior+  | DebugTypeUndefinedBehavior+  | DebugTypePerformance+  | DebugTypePortability+  | DebugTypeMarker+  | DebugTypePushGroup+  | DebugTypePopGroup+  | DebugTypeOther+  deriving ( Eq, Ord, Show )++marshalDebugType :: DebugType -> GLenum+marshalDebugType x = case x of+  DebugTypeError -> GL_DEBUG_TYPE_ERROR+  DebugTypeDeprecatedBehavior -> GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR+  DebugTypeUndefinedBehavior -> GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR+  DebugTypePerformance -> GL_DEBUG_TYPE_PERFORMANCE+  DebugTypePortability -> GL_DEBUG_TYPE_PORTABILITY+  DebugTypeMarker -> GL_DEBUG_TYPE_MARKER+  DebugTypePushGroup -> GL_DEBUG_TYPE_PUSH_GROUP+  DebugTypePopGroup -> GL_DEBUG_TYPE_POP_GROUP+  DebugTypeOther -> GL_DEBUG_TYPE_OTHER++unmarshalDebugType :: GLenum -> DebugType+unmarshalDebugType x+  | x == GL_DEBUG_TYPE_ERROR = DebugTypeError+  | x == GL_DEBUG_TYPE_DEPRECATED_BEHAVIOR = DebugTypeDeprecatedBehavior+  | x == GL_DEBUG_TYPE_UNDEFINED_BEHAVIOR = DebugTypeUndefinedBehavior+  | x == GL_DEBUG_TYPE_PERFORMANCE = DebugTypePerformance+  | x == GL_DEBUG_TYPE_PORTABILITY = DebugTypePortability+  | x == GL_DEBUG_TYPE_MARKER = DebugTypeMarker+  | x == GL_DEBUG_TYPE_PUSH_GROUP = DebugTypePushGroup+  | x == GL_DEBUG_TYPE_POP_GROUP = DebugTypePopGroup+  | x == GL_DEBUG_TYPE_OTHER = DebugTypeOther+  | otherwise = error ("unmarshalDebugType: illegal value " ++ show x)++--------------------------------------------------------------------------------++newtype DebugMessageID = DebugMessageID { debugMessageID :: GLuint }+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data DebugSeverity =+    DebugSeverityHigh+  | DebugSeverityMedium+  | DebugSeverityLow+  | DebugSeverityNotification+  deriving ( Eq, Ord, Show )++marshalDebugSeverity :: DebugSeverity -> GLenum+marshalDebugSeverity x = case x of+  DebugSeverityHigh -> GL_DEBUG_SEVERITY_HIGH+  DebugSeverityMedium -> GL_DEBUG_SEVERITY_MEDIUM+  DebugSeverityLow -> GL_DEBUG_SEVERITY_LOW+  DebugSeverityNotification -> GL_DEBUG_SEVERITY_NOTIFICATION++unmarshalDebugSeverity :: GLenum -> DebugSeverity+unmarshalDebugSeverity x+  | x == GL_DEBUG_SEVERITY_HIGH = DebugSeverityHigh+  | x == GL_DEBUG_SEVERITY_MEDIUM = DebugSeverityMedium+  | x == GL_DEBUG_SEVERITY_LOW = DebugSeverityLow+  | x == GL_DEBUG_SEVERITY_NOTIFICATION = DebugSeverityNotification+  | otherwise = error ("unmarshalDebugSeverity: illegal value " ++ show x)++--------------------------------------------------------------------------------++maxDebugMessageLength :: GettableStateVar GLsizei+maxDebugMessageLength =+  makeGettableStateVar (getSizei1 id GetMaxDebugMessageLength)++--------------------------------------------------------------------------------++debugMessageCallback :: StateVar (Maybe (DebugMessage -> IO ()))+debugMessageCallback =+  makeStateVar getDebugMessageCallback setDebugMessageCallback++getDebugMessageCallback :: IO (Maybe (DebugMessage -> IO ()))+getDebugMessageCallback = do+  cb <- getDebugCallbackFunction+  return $ if (cb == nullFunPtr)+             then Nothing+             else Just . toDebugProc . dyn_debugProc $ cb++foreign import CALLCONV "dynamic" dyn_debugProc+  :: FunPtr GLDEBUGPROCFunc -> GLDEBUGPROCFunc++toDebugProc:: GLDEBUGPROCFunc -> DebugMessage -> IO ()+toDebugProc debugFunc (DebugMessage source typ msgID severity message) =+  withCStringLen message $ \(msg, len) -> do+    debugFunc (marshalDebugSource source)+              (marshalDebugType typ)+              (marshalDebugSeverity severity)+              (debugMessageID msgID)+              (fromIntegral len)+              msg+              nullPtr++setDebugMessageCallback :: Maybe (DebugMessage -> IO ()) -> IO ()+setDebugMessageCallback maybeDebugProc = do+  oldCB <- getDebugCallbackFunction+  unless (oldCB == nullFunPtr) $+    freeHaskellFunPtr oldCB+  newCB <-+    maybe (return nullFunPtr) (makeGLDEBUGPROC . fromDebugProc) maybeDebugProc+  glDebugMessageCallbackARB newCB  nullPtr++fromDebugProc:: (DebugMessage -> IO ()) -> GLDEBUGPROCFunc+fromDebugProc debugProc source typ msgID severity len message _userParam = do+  msg <- peekCStringLen (message, fromIntegral len)+  debugProc (DebugMessage (unmarshalDebugSource source)+                          (unmarshalDebugType typ)+                          (DebugMessageID msgID)+                          (unmarshalDebugSeverity severity)+                          msg)++getDebugCallbackFunction :: IO (FunPtr GLDEBUGPROCFunc)+getDebugCallbackFunction =+  castPtrToFunPtr `fmap` getPointer DebugCallbackFunction++--------------------------------------------------------------------------------++maxDebugLoggedMessages :: GettableStateVar GLsizei+maxDebugLoggedMessages =+  makeGettableStateVar (getSizei1 id GetMaxDebugLoggedMessages)++debugLoggedMessages :: IO [DebugMessage]+debugLoggedMessages = do+  count <- getSizei1 fromIntegral GetDebugLoggedMessages+  replicateM count debugNextLoggedMessage++debugNextLoggedMessage :: IO DebugMessage+debugNextLoggedMessage = do+  len <- getSizei1 id GetDebugNextLoggedMessageLength+  alloca $ \sourceBuf ->+    alloca $ \typeBuf ->+      alloca $ \idBuf ->+        alloca $ \severityBuf ->+          allocaArray (fromIntegral len) $ \messageBuf -> do+            _ <- glGetDebugMessageLog 1 len sourceBuf typeBuf idBuf+                                      severityBuf nullPtr messageBuf+            source <- peek1 unmarshalDebugSource sourceBuf+            typ <- peek1 unmarshalDebugType typeBuf+            msgID <- peek1 DebugMessageID idBuf+            severity <- peek1 unmarshalDebugSeverity severityBuf+            message <- peekCStringLen (messageBuf, fromIntegral len)+            return $ DebugMessage source typ msgID severity message++--------------------------------------------------------------------------------++data MessageGroup =+    MessageGroup (Maybe DebugSource) (Maybe DebugType) (Maybe DebugSeverity)+  | MessageGroupWithIDs DebugSource DebugType [DebugMessageID]+  deriving ( Eq, Ord, Show )++debugMessageControl :: MessageGroup -> SettableStateVar Capability+debugMessageControl x = case x of+  MessageGroup maybeSource maybeType maybeSeverity ->+    doDebugMessageControl maybeSource maybeType maybeSeverity []+  MessageGroupWithIDs source typ messageIDs ->+    doDebugMessageControl (Just source) (Just typ) Nothing messageIDs++doDebugMessageControl :: Maybe DebugSource+                      -> Maybe DebugType+                      -> Maybe DebugSeverity+                      -> [DebugMessageID]+                      -> SettableStateVar Capability+doDebugMessageControl maybeSource maybeType maybeSeverity messageIDs =+  makeSettableStateVar $ \cap ->+    withArrayLen (map debugMessageID messageIDs) $ \len idsBuf ->+      glDebugMessageControl (maybe GL_DONT_CARE marshalDebugSource maybeSource)+                            (maybe GL_DONT_CARE marshalDebugType maybeType)+                            (maybe GL_DONT_CARE marshalDebugSeverity maybeSeverity)+                            (fromIntegral len)+                            idsBuf+                            (marshalCapability cap)++--------------------------------------------------------------------------------++debugMessageInsert :: DebugMessage -> IO ()+debugMessageInsert (DebugMessage source typ msgID severity message) =+  withCStringLen message $ \(msg, len) ->+    glDebugMessageInsert (marshalDebugSource source)+                         (marshalDebugType typ)+                         (debugMessageID msgID)+                         (marshalDebugSeverity severity)+                         (fromIntegral len)+                         msg++--------------------------------------------------------------------------------++data DebugGroup = DebugGroup DebugSource DebugMessageID String++pushDebugGroup :: DebugSource -> DebugMessageID -> String -> IO ()+pushDebugGroup source msgID message =+  withCStringLen message $ \(msg, len) ->+    glPushDebugGroup (marshalDebugSource source)+                     (debugMessageID msgID)+                     (fromIntegral len)+                     msg++popDebugGroup :: IO ()+popDebugGroup = glPopDebugGroup++withDebugGroup :: DebugSource -> DebugMessageID -> String -> IO a -> IO a+withDebugGroup source msgID message =+  bracket_ (pushDebugGroup source msgID message) popDebugGroup++maxDebugGroupStackDepth :: GettableStateVar GLsizei+maxDebugGroupStackDepth =+  makeGettableStateVar (getSizei1 id GetMaxDebugGroupStackDepth)++--------------------------------------------------------------------------------++-- TODO: Make instances for the following features when we have them:+--   * PROGRAM_PIPELINE / glGenProgramPipelines+--   * SAMPLER / glGenSamplers+--   * TRANSFORM_FEEDBACK / glGenTransformFeedbacks++class CanBeLabeled a where+  objectLabel :: a -> StateVar (Maybe String)++--------------------------------------------------------------------------------++debugOutputSynchronous :: StateVar Capability+debugOutputSynchronous = makeCapability CapDebugOutputSynchronous
+ src/Graphics/Rendering/OpenGL/GL/DisplayLists.hs view
@@ -0,0 +1,131 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.DisplayLists+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 5.4 (Display Lists) of the OpenGL 2.1+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.DisplayLists (+   -- * Defining Display Lists+   DisplayList(DisplayList), ListMode(..), defineList, defineNewList, listIndex,+   listMode, maxListNesting,++   -- * Calling Display Lists+   callList, callLists, listBase+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Data.StateVar+import Foreign.Ptr ( Ptr )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.DataType+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++newtype DisplayList = DisplayList { displayListID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName DisplayList where+   isObjectName = liftIO . fmap unmarshalGLboolean . glIsList . displayListID+   deleteObjectNames =+     liftIO . mapM_ (uncurry glDeleteLists) . combineConsecutive++instance CanBeLabeled DisplayList where+   objectLabel = objectNameLabel GL_DISPLAY_LIST . displayListID++combineConsecutive :: [DisplayList] -> [(GLuint, GLsizei)]+combineConsecutive [] = []+combineConsecutive (z:zs) = (displayListID z, len) : combineConsecutive rest+   where (len, rest) = run (0 :: GLsizei) z zs+         run n x xs = case n + 1 of+                         m -> case xs of+                                 []                          -> (m, [])+                                 (y:ys) | x `isFollowedBy` y -> run m y ys+                                        | otherwise          -> (m, xs)+         DisplayList x `isFollowedBy` DisplayList y = x + 1 == y++instance GeneratableObjectName DisplayList where+   genObjectNames n = liftIO $ do+      first <- glGenLists (fromIntegral n)+      if DisplayList first == noDisplayList+         then do recordOutOfMemory+                 return []+         else return [ DisplayList l+                     | l <- [ first .. first + fromIntegral n - 1 ] ]++--------------------------------------------------------------------------------++data ListMode =+     Compile+   | CompileAndExecute+   deriving ( Eq, Ord, Show )++marshalListMode :: ListMode -> GLenum+marshalListMode x = case x of+   Compile -> GL_COMPILE+   CompileAndExecute -> GL_COMPILE_AND_EXECUTE++unmarshalListMode :: GLenum -> ListMode+unmarshalListMode x+   | x == GL_COMPILE = Compile+   | x == GL_COMPILE_AND_EXECUTE = CompileAndExecute+   | otherwise = error ("unmarshalListMode: illegal value " ++ show x)++--------------------------------------------------------------------------------++defineList :: DisplayList -> ListMode -> IO a -> IO a+defineList dl mode =+   bracket_ (glNewList (displayListID dl) (marshalListMode mode)) glEndList++defineNewList :: ListMode -> IO a -> IO DisplayList+defineNewList mode action = do+   lst <- genObjectName+   _ <- defineList lst mode action+   return lst++--------------------------------------------------------------------------------++listIndex :: GettableStateVar (Maybe DisplayList)+listIndex =+   makeGettableStateVar+      (do l <- getEnum1 (DisplayList . fromIntegral) GetListIndex+          return $ if l == noDisplayList then Nothing else Just l)++noDisplayList :: DisplayList+noDisplayList = DisplayList 0++listMode :: GettableStateVar ListMode+listMode = makeGettableStateVar (getEnum1 unmarshalListMode GetListMode)++maxListNesting :: GettableStateVar GLsizei+maxListNesting = makeGettableStateVar (getSizei1 id GetMaxListNesting)++--------------------------------------------------------------------------------++callList :: DisplayList -> IO ()+callList = glCallList . displayListID++callLists :: GLsizei -> DataType -> Ptr a -> IO ()+callLists n = glCallLists n . marshalDataType++--------------------------------------------------------------------------------++listBase :: StateVar DisplayList+listBase =+   makeStateVar+      (getEnum1 (DisplayList . fromIntegral) GetListBase)+      (glListBase . displayListID)
+ src/Graphics/Rendering/OpenGL/GL/Domain.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Domain+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling evaluator domains.+--+--------------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++module Graphics.Rendering.OpenGL.GL.Domain (+   Domain(..)+) where++import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++class Storable d => Domain d where+   glMap1      :: GLenum -> d -> d -> GLint -> GLint -> Ptr d -> IO ()+   glMap2      :: GLenum -> d -> d -> GLint -> GLint -> d -> d -> GLint -> GLint -> Ptr d -> IO ()+   glGetMapv   :: GLenum -> GLenum -> Ptr d -> IO ()+   evalCoord1  :: d -> IO ()+   evalCoord1v :: Ptr d -> IO ()+   evalCoord2  :: (d, d) -> IO ()+   evalCoord2v :: Ptr d -> IO ()+   glMapGrid1  :: GLint -> d -> d -> IO ()+   glMapGrid2  :: GLint -> d -> d -> GLint -> d -> d -> IO ()+   get2        :: GetPName2F p => (d -> d -> a) -> p -> IO a+   get4        :: GetPName4F p => (d -> d -> d -> d -> a) -> p -> IO a++--------------------------------------------------------------------------------++instance Domain GLfloat where+   glMap1      = glMap1f+   glMap2      = glMap2f+   glGetMapv   = glGetMapfv+   evalCoord1  = glEvalCoord1f+   evalCoord1v = glEvalCoord1fv+   evalCoord2  = uncurry glEvalCoord2f+   evalCoord2v = glEvalCoord2fv+   glMapGrid1  = glMapGrid1f+   glMapGrid2  = glMapGrid2f+   get2        = getFloat2+   get4        = getFloat4++instance Domain GLdouble where+   glMap1      = glMap1d+   glMap2      = glMap2d+   glGetMapv   = glGetMapdv+   evalCoord1  = glEvalCoord1d+   evalCoord1v = glEvalCoord1dv+   evalCoord2  = uncurry glEvalCoord2d+   evalCoord2v = glEvalCoord2dv+   glMapGrid1  = glMapGrid1d+   glMapGrid2  = glMapGrid2d+   get2        = getDouble2+   get4        = getDouble4
+ src/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.EdgeFlag+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling EdgeFlag.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.EdgeFlag (+   EdgeFlag(..), marshalEdgeFlag, unmarshalEdgeFlag+) where++import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.GL++--------------------------------------------------------------------------------++-- | A vertex can begin an edge which lies in the interior of its polygon or on+-- the polygon\'s boundary.++data EdgeFlag = BeginsInteriorEdge | BeginsBoundaryEdge+   deriving ( Eq, Ord, Show )++marshalEdgeFlag :: EdgeFlag -> GLboolean+marshalEdgeFlag = marshalGLboolean . (BeginsBoundaryEdge ==)++unmarshalEdgeFlag :: GLboolean -> EdgeFlag+unmarshalEdgeFlag f =+   if unmarshalGLboolean f then BeginsBoundaryEdge else BeginsInteriorEdge
+ src/Graphics/Rendering/OpenGL/GL/Evaluators.hs view
@@ -0,0 +1,367 @@+{-# LANGUAGE KindSignatures #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Evaluators+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 5.1 (Evaluators) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Evaluators (+   -- * Evaluator-related Types+   Order, maxOrder, Domain, MapDescriptor(..), ControlPoint,++   -- * Defining Evaluator Maps+   -- ** One-dimensional Evaluator Maps+   Map1(..), GLmap1, map1,++   -- ** Two-dimensional Evaluator Maps+   Map2(..), GLmap2, map2,++   -- * Using Evaluator Maps++   -- ** Evaluating an Arbitrary Coordinate Value+   evalCoord1, evalCoord1v, evalCoord2, evalCoord2v,++   -- ** Using Evenly Spaced Coordinate Values++   -- *** Defining a Grid+   mapGrid1, mapGrid2,++   -- *** Evaluating a Whole Mesh+   evalMesh1, evalMesh2,++   -- *** Evaluating a Single Point on a Mesh+   evalPoint1, evalPoint2,++   -- * Normal Generation+   autoNormal+) where++import Control.Monad+import Data.List+import Data.StateVar+import Foreign.ForeignPtr+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.ControlPoint+import Graphics.Rendering.OpenGL.GL.Domain+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PolygonMode+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexArrays+import Graphics.GL++--------------------------------------------------------------------------------++type Order = GLint++maxOrder :: GettableStateVar Order+maxOrder = makeGettableStateVar (getInteger1 id GetMaxEvalOrder)++--------------------------------------------------------------------------------++data MapDescriptor d =+   MapDescriptor (d, d) Stride Order NumComponents+   deriving ( Eq, Ord, Show )++totalComponents1 :: MapDescriptor d -> Int+totalComponents1 (MapDescriptor _ stride order numComp) =+   fromIntegral stride * (fromIntegral order - 1) + fromIntegral numComp++totalComponents2 :: MapDescriptor d -> MapDescriptor d -> Int+totalComponents2 uDescriptor vDescriptor@(MapDescriptor _ _ _ numComp) =+   totalComponents1 uDescriptor + totalComponents1 vDescriptor - fromIntegral numComp++--------------------------------------------------------------------------------++peekControlPoints1 ::+   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> IO [c d]+peekControlPoints1 descriptor ptr =+   mapM peekControlPoint (controlPointPtrs1 descriptor ptr)++peekControlPoints2 ::+      (ControlPoint c, Domain d)+   => MapDescriptor d -> MapDescriptor d -> Ptr d -> IO [[c d]]+peekControlPoints2 uDescriptor vDescriptor ptr =+   mapM (mapM peekControlPoint) (controlPointPtrs2 uDescriptor vDescriptor ptr)++pokeControlPoints1 ::+   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> [c d] -> IO ()+pokeControlPoints1 descriptor ptr =+   zipWithM_ pokeControlPoint (controlPointPtrs1 descriptor ptr)++pokeControlPoints2 ::+      (ControlPoint c, Domain d)+   => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[c d]] -> IO ()+pokeControlPoints2 uDescriptor vDescriptor ptr =+   zipWithM_ (zipWithM_ pokeControlPoint)+             (controlPointPtrs2 uDescriptor vDescriptor ptr)++controlPointPtrs1 :: Domain d => MapDescriptor d -> Ptr d -> [Ptr a]+controlPointPtrs1 (MapDescriptor _ stride order _) ptr =+   [ ptr `plusPtr` (o * s) | o <- [ 0 .. fromIntegral order - 1 ] ]+   where s = sizeOfPtr ptr * fromIntegral stride++controlPointPtrs2 ::+   Domain d => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[Ptr a]]+controlPointPtrs2 uDescriptor vDescriptor ptr =+   [ controlPointPtrs1 vDescriptor p | p <- controlPointPtrs1 uDescriptor ptr ]++sizeOfPtr :: Storable a => Ptr a -> Int+sizeOfPtr = sizeOf . (const undefined :: Ptr a -> a)++--------------------------------------------------------------------------------++class Map1 m where+   withNewMap1 :: (ControlPoint c, Domain d)+      => MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)++   withMap1 :: (ControlPoint c, Domain d)+      => m c d -> (MapDescriptor d -> Ptr d -> IO a) -> IO a++   newMap1 :: (ControlPoint c, Domain d)+      => (d, d) -> [c d] -> IO (m c d)++   getMap1Components :: (ControlPoint c, Domain d)+      => m c d -> IO ((d, d), [c d])++   withNewMap1 descriptor@(MapDescriptor domain _ _ _) act = do+      allocaArray (totalComponents1 descriptor) $ \ptr -> do+         act ptr+         controlPoints <- peekControlPoints1 descriptor ptr+         newMap1 domain controlPoints++   withMap1 m act = do+      (domain, controlPoints) <- getMap1Components m+      let stride = numComponents (head controlPoints)+          order = genericLength controlPoints+          descriptor = MapDescriptor domain stride order (fromIntegral stride)+      allocaArray (totalComponents1 descriptor) $ \ptr -> do+         pokeControlPoints1 descriptor ptr controlPoints+         act descriptor ptr++   newMap1 domain controlPoints = do+      let stride = numComponents (head controlPoints)+          order = genericLength controlPoints+          descriptor = MapDescriptor domain stride order (fromIntegral stride)+      withNewMap1 descriptor $ \ptr ->+         pokeControlPoints1 descriptor ptr controlPoints++   getMap1Components m =+      withMap1 m $ \descriptor@(MapDescriptor domain _ _ _) ptr -> do+         controlPoints <- peekControlPoints1 descriptor ptr+         return (domain, controlPoints)++--------------------------------------------------------------------------------++data GLmap1 (c :: * -> *) d =+   GLmap1 (MapDescriptor d) (ForeignPtr d)+   deriving ( Eq, Ord, Show )++instance Map1 GLmap1 where+   withNewMap1 descriptor act = do+      fp <- mallocForeignPtrArray (totalComponents1 descriptor)+      withForeignPtr fp act+      return $ GLmap1 descriptor fp++   withMap1 (GLmap1 descriptor fp) act =+      withForeignPtr fp $ act descriptor++--------------------------------------------------------------------------------++map1 :: (Map1 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))+map1 = makeMap1StateVar enableCap1 getMap1 setMap1++makeMap1StateVar ::+      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())+   -> StateVar (Maybe (m c d))+makeMap1StateVar getCap getAct setAct =+   makeStateVarMaybe+      (return (getCap undefined))+      (getAct undefined)+      (setAct undefined)++getMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> IO (m c d)+getMap1 dummyControlPoint = do+   let target = map1Target dummyControlPoint+       numComp = fromIntegral (numComponents dummyControlPoint)+   domain <- allocaArray 2 $ \ptr -> do+      glGetMapv target (marshalGetMapQuery Domain) ptr+      peek2 (,) ptr+   order <- with 0 $ \ptr -> do+      glGetMapiv target (marshalGetMapQuery Order) ptr+      fmap fromIntegral $ peek ptr+   withNewMap1 (MapDescriptor domain (numComponents dummyControlPoint) order numComp) $+      glGetMapv target (marshalGetMapQuery Coeff)++setMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()+setMap1 dummyControlPoint m =+   withMap1 m $ \(MapDescriptor (u1, u2) stride order _) ->+      glMap1 (map1Target dummyControlPoint) u1 u2+             (fromIntegral stride) (fromIntegral order)++--------------------------------------------------------------------------------++class Map2 m where+   withNewMap2 :: (ControlPoint c, Domain d)+      => MapDescriptor d -> MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)++   withMap2 :: (ControlPoint c, Domain d)+      => m c d -> (MapDescriptor d -> MapDescriptor d -> Ptr d -> IO a) -> IO a++   newMap2 :: (ControlPoint c, Domain d)+      => (d, d) -> (d, d) -> [[c d]] -> IO (m c d)++   getMap2Components :: (ControlPoint c, Domain d)+      => m c d -> IO ((d, d), (d, d), [[c d]])++   withNewMap2 uDescriptor@(MapDescriptor uDomain _ _ _)+               vDescriptor@(MapDescriptor vDomain _ _ _) act =+      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do+         act ptr+         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr+         newMap2 uDomain vDomain controlPoints++   withMap2 m act = do+      (uDomain, vDomain, controlPoints) <- getMap2Components m+      let vStride = numComponents (head (head controlPoints))+          vOrder = genericLength (head controlPoints)+          uStride = vStride * fromIntegral vOrder+          uOrder = genericLength controlPoints+          numComp = fromIntegral vStride+          uDescriptor = MapDescriptor uDomain uStride uOrder numComp+          vDescriptor = MapDescriptor vDomain vStride vOrder numComp+      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do+         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints+         act uDescriptor vDescriptor ptr++   newMap2 uDomain vDomain controlPoints = do+      let vStride = numComponents (head (head controlPoints))+          vOrder = genericLength (head controlPoints)+          uStride = vStride * fromIntegral vOrder+          uOrder = genericLength controlPoints+          numComp = fromIntegral vStride+          uDescriptor = MapDescriptor uDomain uStride uOrder numComp+          vDescriptor = MapDescriptor vDomain vStride vOrder numComp+      withNewMap2 uDescriptor vDescriptor $ \ptr ->+         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints++   getMap2Components m =+      withMap2 m $ \uDescriptor@(MapDescriptor uDomain _ _ _)+                    vDescriptor@(MapDescriptor vDomain _ _ _) ptr -> do+         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr+         return (uDomain, vDomain, controlPoints)++--------------------------------------------------------------------------------++data GLmap2 (c :: * -> *) d =+   GLmap2 (MapDescriptor d)  (MapDescriptor d) (ForeignPtr d)+   deriving ( Eq, Ord, Show )++instance Map2 GLmap2 where+   withNewMap2 uDescriptor vDescriptor act = do+      fp <- mallocForeignPtrArray (totalComponents2 uDescriptor vDescriptor)+      withForeignPtr fp act+      return $ GLmap2 uDescriptor vDescriptor fp++   withMap2 (GLmap2 uDescriptor vDescriptor fp) act =+      withForeignPtr fp $ act uDescriptor vDescriptor++--------------------------------------------------------------------------------++map2 :: (Map2 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))+map2 = makeMap2StateVar enableCap2 getMap2 setMap2++makeMap2StateVar ::+      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())+   -> StateVar (Maybe (m c d))+makeMap2StateVar getCap getAct setAct =+   makeStateVarMaybe+      (return (getCap undefined))+      (getAct undefined)+      (setAct undefined)++getMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> IO (m c d)+getMap2 dummyControlPoint = do+   let target = map2Target dummyControlPoint+   (uDomain, vDomain) <- allocaArray 4 $ \ptr -> do+      glGetMapv target (marshalGetMapQuery Domain) ptr+      peek4 (\u1 u2 v1 v2 -> ((u1, u2), (v1, v2))) ptr+   (uOrder, vOrder) <- withArray [0,0] $ \ptr -> do+      glGetMapiv target (marshalGetMapQuery Order) ptr+      peek2 (,) ptr+   let vStride = numComponents dummyControlPoint+       uStride = vStride * fromIntegral vOrder+   withNewMap2 (MapDescriptor uDomain uStride uOrder (fromIntegral vStride))+               (MapDescriptor vDomain vStride vOrder (fromIntegral vStride)) $+      glGetMapv target (marshalGetMapQuery Coeff)++setMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()+setMap2 dummyControlPoint m =+   withMap2 m $ \(MapDescriptor (u1, u2) uStride uOrder _)+                 (MapDescriptor (v1, v2) vStride vOrder _) ->+      glMap2 (map2Target dummyControlPoint)+             u1 u2 (fromIntegral uStride) (fromIntegral uOrder)+             v1 v2 (fromIntegral vStride) (fromIntegral vOrder)++--------------------------------------------------------------------------------++data GetMapQuery =+     Coeff+   | Order+   | Domain++marshalGetMapQuery :: GetMapQuery -> GLenum+marshalGetMapQuery x = case x of+   Coeff -> GL_COEFF+   Order -> GL_ORDER+   Domain -> GL_DOMAIN++--------------------------------------------------------------------------------++mapGrid1 :: Domain d => StateVar (GLint, (d, d))+mapGrid1 =+   makeStateVar+      (do n <- getInteger1 id GetMap1GridSegments+          domain <- get2 (,) GetMap1GridDomain+          return (n, domain))+      (\(n, (u1, u2)) -> glMapGrid1 n u1 u2)++mapGrid2 :: Domain d => StateVar ((GLint, (d, d)), (GLint, (d, d)))+mapGrid2 =+   makeStateVar+      (do (un, vn) <- getInteger2 (,) GetMap2GridSegments+          (u1, u2, v1, v2) <- get4 (,,,) GetMap2GridDomain+          return ((un, (u1, u2)), (vn, (v1, v2))))+      (\((un, (u1, u2)), (vn, (v1, v2))) -> glMapGrid2 un u1 u2 vn v1 v2)++--------------------------------------------------------------------------------++evalMesh1 :: PolygonMode -> (GLint, GLint) -> IO ()+evalMesh1 m (p1, p2) = glEvalMesh1 (marshalPolygonMode m) p1 p2++evalMesh2 :: PolygonMode -> (GLint, GLint) -> (GLint, GLint) -> IO ()+evalMesh2 m (p1, p2) (q1, q2) = glEvalMesh2 (marshalPolygonMode m) p1 p2 q1 q2++--------------------------------------------------------------------------------++evalPoint1 :: GLint -> IO ()+evalPoint1 = glEvalPoint1++evalPoint2 :: (GLint, GLint) -> IO ()+evalPoint2 = uncurry glEvalPoint2++--------------------------------------------------------------------------------++autoNormal :: StateVar Capability+autoNormal = makeCapability CapAutoNormal
+ src/Graphics/Rendering/OpenGL/GL/Exception.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Exception+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module to compensate for differences between+-- Haskell implementations.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Exception (+   bracket, bracket_, unsafeBracket_, finallyRet+) where++import Data.IORef ( newIORef, readIORef, writeIORef )++#ifdef __NHC__+import qualified IO ( bracket, bracket_ )++{-# INLINE bracket #-}+bracket  :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c+bracket = IO.bracket++{-# INLINE bracket_ #-}+bracket_ :: IO a -> IO b -> IO c -> IO c+bracket_ before = IO.bracket_ before . const++finally :: IO a -> IO b -> IO a+finally = flip . bracket_ . return $ undefined+#else+import Control.Exception ( bracket, bracket_, finally )+#endif++{-# INLINE unsafeBracket_ #-}+unsafeBracket_ :: IO a -> IO b -> IO c -> IO c+unsafeBracket_ before after thing = do+   _ <- before+   r <- thing+   _ <- after+   return r++{-# INLINE finallyRet #-}+finallyRet :: IO a -> IO b -> IO (a, b)+a `finallyRet` sequel = do+   r2Ref <- newIORef undefined+   r1 <- a `finally` (sequel >>= writeIORef r2Ref)+   r2 <- readIORef r2Ref+   return (r1, r2)
+ src/Graphics/Rendering/OpenGL/GL/Face.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Face+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling Face.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Face (+   Face(..), marshalFace, unmarshalFace+) where++import Graphics.GL++--------------------------------------------------------------------------------++data Face =+     Front+   | Back+   | FrontAndBack+   deriving ( Eq, Ord, Show )++marshalFace :: Face -> GLenum+marshalFace x = case x of+   Front -> GL_FRONT+   Back -> GL_BACK+   FrontAndBack -> GL_FRONT_AND_BACK++unmarshalFace :: GLenum -> Face+unmarshalFace x+   | x == GL_FRONT = Front+   | x == GL_BACK = Back+   | x == GL_FRONT_AND_BACK = FrontAndBack+   | otherwise = error ("unmarshalFace: illegal value " ++ show x)
+ src/Graphics/Rendering/OpenGL/GL/Feedback.hs view
@@ -0,0 +1,196 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Feedback+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 5.3 (Feedback) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Feedback (+   FeedbackToken(..), VertexInfo(..), ColorInfo, FeedbackType(..),+   getFeedbackTokens, PassThroughValue(..), passThrough+) where++import Control.Monad+import Data.StateVar+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.IOState+import Graphics.Rendering.OpenGL.GL.RenderMode+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++data FeedbackToken =+     PointToken VertexInfo+   | LineToken VertexInfo VertexInfo+   | LineResetToken VertexInfo VertexInfo+   | PolygonToken [VertexInfo]+   | BitmapToken VertexInfo+   | DrawPixelToken VertexInfo+   | CopyPixelToken VertexInfo+   | PassThroughToken PassThroughValue+   deriving ( Eq, Ord, Show )++data VertexInfo =+     Vertex2D             (Vertex2 GLfloat)+   | Vertex3D             (Vertex3 GLfloat)+   | Vertex3DColor        (Vertex3 GLfloat) ColorInfo+   | Vertex3DColorTexture (Vertex3 GLfloat) ColorInfo (TexCoord4 GLfloat)+   | Vertex4DColorTexture (Vertex4 GLfloat) ColorInfo (TexCoord4 GLfloat)+   deriving ( Eq, Ord, Show )++type ColorInfo = Either (Index1 GLint) (Color4 GLfloat)++--------------------------------------------------------------------------------++data FeedbackTag =+     PointTag+   | LineTag+   | LineResetTag+   | PolygonTag+   | BitmapTag+   | DrawPixelTag+   | CopyPixelTag+   | PassThroughTag++unmarshalFeedbackTag :: GLenum -> FeedbackTag+unmarshalFeedbackTag x+   | x == GL_POINT_TOKEN = PointTag+   | x == GL_LINE_TOKEN = LineTag+   | x == GL_LINE_RESET_TOKEN = LineResetTag+   | x == GL_POLYGON_TOKEN = PolygonTag+   | x == GL_BITMAP_TOKEN = BitmapTag+   | x == GL_DRAW_PIXEL_TOKEN = DrawPixelTag+   | x == GL_COPY_PIXEL_TOKEN = CopyPixelTag+   | x == GL_PASS_THROUGH_TOKEN = PassThroughTag+   | otherwise = error ("unmarshalFeedbackTag: illegal value " ++ show x)++--------------------------------------------------------------------------------++data FeedbackType =+     TwoD+   | ThreeD+   | ThreeDColor+   | ThreeDColorTexture+   | FourDColorTexture+   deriving ( Eq, Ord, Show )++marshalFeedbackType :: FeedbackType -> GLenum+marshalFeedbackType x = case x of+   TwoD -> GL_2D+   ThreeD -> GL_3D+   ThreeDColor -> GL_3D_COLOR+   ThreeDColorTexture -> GL_3D_COLOR_TEXTURE+   FourDColorTexture -> GL_4D_COLOR_TEXTURE++--------------------------------------------------------------------------------++getFeedbackTokens ::+   GLsizei -> FeedbackType -> IO a -> IO (a, Maybe [FeedbackToken])+getFeedbackTokens bufSize feedbackType action =+   allocaArray (fromIntegral bufSize) $ \buf -> do+      glFeedbackBuffer bufSize (marshalFeedbackType feedbackType) buf+      (value, numValues) <- withRenderMode Feedback action+      tokens <- parseFeedbackBuffer numValues buf feedbackType+      return (value, tokens)++--------------------------------------------------------------------------------++parseFeedbackBuffer ::+   GLint -> Ptr GLfloat -> FeedbackType -> IO (Maybe [FeedbackToken])+parseFeedbackBuffer numValues buf feedbackType+   | numValues < 0 = return Nothing+   | otherwise     = do+      rgba <- get rgbaMode+      let end = buf `plusPtr`+                  (sizeOf (undefined :: GLfloat) * fromIntegral numValues)+          infoParser = calcInfoParser feedbackType (calcColorParser rgba)+          loop tokens = do+             ptr <- getIOState+             if ptr == end+                then return (reverse tokens)+                else do token <- tokenParser infoParser+                        loop (token : tokens)+      fmap Just $ evalIOState (loop []) buf++type Parser a = IOState GLfloat a++tokenParser :: Parser VertexInfo -> Parser FeedbackToken+tokenParser infoParser = do+   tag <- parseGLenum+   case unmarshalFeedbackTag tag of+      PointTag -> fmap PointToken infoParser+      LineTag -> liftM2 LineToken infoParser infoParser+      LineResetTag -> liftM2 LineResetToken infoParser infoParser+      PolygonTag -> do n <- parseGLint; fmap PolygonToken (nTimes n infoParser)+      BitmapTag -> fmap BitmapToken infoParser+      DrawPixelTag -> fmap DrawPixelToken infoParser+      CopyPixelTag -> fmap CopyPixelToken infoParser+      PassThroughTag -> fmap PassThroughToken parsePassThroughValue++calcInfoParser :: FeedbackType -> Parser ColorInfo -> Parser VertexInfo+calcInfoParser feedbackType colorParser = case feedbackType of+   TwoD ->+      fmap Vertex2D parseVertex2+   ThreeD ->+      fmap Vertex3D parseVertex3+   ThreeDColor ->+      liftM2 Vertex3DColor parseVertex3 colorParser+   ThreeDColorTexture ->+      liftM3 Vertex3DColorTexture parseVertex3 colorParser parseTexCoord4+   FourDColorTexture ->+      liftM3 Vertex4DColorTexture parseVertex4 colorParser parseTexCoord4++parseVertex2 :: Parser (Vertex2 GLfloat)+parseVertex2 = liftM2 Vertex2 parseGLfloat parseGLfloat++parseVertex3 :: Parser (Vertex3 GLfloat)+parseVertex3 = liftM3 Vertex3 parseGLfloat parseGLfloat parseGLfloat++parseVertex4 :: Parser (Vertex4 GLfloat)+parseVertex4 =+   liftM4 Vertex4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat++calcColorParser :: Bool -> Parser ColorInfo+calcColorParser False = fmap Left parseIndex1+calcColorParser True  = fmap Right parseColor4++parseIndex1 :: Parser (Index1 GLint)+parseIndex1 = fmap Index1 parseGLint++parseColor4 :: Parser (Color4 GLfloat)+parseColor4 = liftM4 Color4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat++parseTexCoord4 :: Parser (TexCoord4 GLfloat)+parseTexCoord4 =+   liftM4 TexCoord4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat++parsePassThroughValue :: Parser PassThroughValue+parsePassThroughValue = fmap PassThroughValue parseGLfloat++parseGLenum :: Parser GLenum+parseGLenum = fmap round parseGLfloat++parseGLint :: Parser GLint+parseGLint = fmap round parseGLfloat++parseGLfloat :: Parser GLfloat+parseGLfloat = peekIOState++--------------------------------------------------------------------------------++newtype PassThroughValue = PassThroughValue GLfloat+   deriving ( Eq, Ord, Show )++passThrough :: PassThroughValue -> IO ()+passThrough (PassThroughValue ptv) = glPassThrough ptv
+ src/Graphics/Rendering/OpenGL/GL/FlushFinish.hs view
@@ -0,0 +1,50 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FlushFinish+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.3.2 (Flush and Finish) of the OpenGL 4.4+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FlushFinish (+   flush, finish      +) where++import Graphics.GL++--------------------------------------------------------------------------------++-- | Different GL implementations buffer commands in several different+-- locations, including network buffers and the graphics accelerator itself.+-- 'flush' empties all of these buffers, causing all issued commands to be+-- executed as quickly as they are accepted by the actual rendering engine.+-- Though this execution may not be completed in any particular time period, it+-- does complete in finite time.+-- +-- Because any GL program might be executed over a network, or on an accelerator+-- that buffers commands, all programs should call 'flush' whenever they count+-- on having all of their previously issued commands completed. For example,+-- call 'flush' before waiting for user input that depends on the generated+-- image.+-- +-- Note that 'flush' can return at any time. It does not wait until the+-- execution of all previously issued GL commands is complete.++flush :: IO ()+flush = glFlush++-- | 'finish' does not return until the effects of all previously called GL+-- commands are complete. Such effects include all changes to GL state, all+-- changes to connection state, and all changes to the frame buffer contents.+-- +-- Note that 'finish' requires a round trip to the server.++finish :: IO ()+finish = glFinish
+ src/Graphics/Rendering/OpenGL/GL/Fog.hs view
@@ -0,0 +1,198 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Fog+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.10 (Fog) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Fog (+   fog,+   FogMode(..), fogMode,+   fogColor, fogIndex,+   FogCoordSrc(..), fogCoordSrc,+   FogDistanceMode(..), fogDistanceMode+) where++import Data.StateVar+import Foreign.Marshal.Utils+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++fog :: StateVar Capability+fog = makeCapability CapFog++--------------------------------------------------------------------------------++data FogParameter =+     FogIndex+   | FogDensity+   | FogStart+   | FogEnd+   | FogMode+   | FogColor+   | FogCoordSrc+   | FogDistanceMode++marshalFogParameter :: FogParameter -> GLenum+marshalFogParameter x = case x of+   FogIndex -> GL_FOG_INDEX+   FogDensity -> GL_FOG_DENSITY+   FogStart -> GL_FOG_START+   FogEnd -> GL_FOG_END+   FogMode -> GL_FOG_MODE+   FogColor -> GL_FOG_COLOR+   FogCoordSrc -> GL_FOG_COORD_SRC+   FogDistanceMode -> GL_FOG_DISTANCE_MODE_NV++--------------------------------------------------------------------------------++data FogMode' =+     Linear'+   | Exp'+   | Exp2'++marshalFogMode' :: FogMode' -> GLint+marshalFogMode' x = fromIntegral $ case x of+   Linear' -> GL_LINEAR+   Exp' -> GL_EXP+   Exp2' -> GL_EXP2++unmarshalFogMode' :: GLint -> FogMode'+unmarshalFogMode' x+   | y == GL_LINEAR = Linear'+   | y == GL_EXP = Exp'+   | y == GL_EXP2 = Exp2'+   | otherwise = error ("unmarshalFogMode': illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++data FogMode =+     Linear GLfloat GLfloat+   | Exp GLfloat+   | Exp2 GLfloat+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++fogMode :: StateVar FogMode+fogMode = makeStateVar getFogMode setFogMode++getFogMode :: IO FogMode+getFogMode = do+   mode <- getInteger1 unmarshalFogMode' GetFogMode+   case mode of+      Linear' -> do+         start <- getFloat1 id GetFogStart+         end <- getFloat1 id GetFogEnd+         return $ Linear start end+      Exp' -> getFloat1 Exp GetFogDensity+      Exp2' -> getFloat1 Exp2 GetFogDensity++setFogMode :: FogMode -> IO ()+setFogMode (Linear start end) = do+   fogi FogMode (marshalFogMode' Linear')+   fogf FogStart start+   fogf FogEnd end+setFogMode (Exp density) = do+   fogi FogMode (marshalFogMode' Exp')+   fogf FogDensity density+setFogMode (Exp2 density) = do+   fogi FogMode (marshalFogMode' Exp2')+   fogf FogDensity density++--------------------------------------------------------------------------------++fogi :: FogParameter -> GLint -> IO ()+fogi = glFogi . marshalFogParameter++fogf :: FogParameter -> GLfloat -> IO ()+fogf = glFogf . marshalFogParameter++fogfv :: FogParameter -> Ptr (Color4 GLfloat) -> IO ()+fogfv param ptr = glFogfv (marshalFogParameter param) (castPtr ptr)++--------------------------------------------------------------------------------++fogColor :: StateVar (Color4 GLclampf)+fogColor =+   makeStateVar+      (getClampf4 Color4 GetFogColor)+      (\c -> with c $ (fogfv FogColor . castPtr))++--------------------------------------------------------------------------------++fogIndex :: StateVar (Index1 GLint)+fogIndex =+   makeStateVar+      (getInteger1 Index1 GetFogIndex)+      (\(Index1 i) -> fogi FogIndex i)++--------------------------------------------------------------------------------++data FogCoordSrc =+     FogCoord+   | FragmentDepth+   deriving ( Eq, Ord, Show )++marshalFogCoordSrc :: FogCoordSrc -> GLint+marshalFogCoordSrc x = fromIntegral $ case x of+   FogCoord -> GL_FOG_COORD+   FragmentDepth -> GL_FRAGMENT_DEPTH++unmarshalFogCoordSrc :: GLint -> FogCoordSrc+unmarshalFogCoordSrc x+   | y == GL_FOG_COORD = FogCoord+   | y == GL_FRAGMENT_DEPTH = FragmentDepth+   | otherwise = error ("unmarshalFogCoordSrc: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++fogCoordSrc :: StateVar FogCoordSrc+fogCoordSrc =+   makeStateVar+      (getInteger1 unmarshalFogCoordSrc GetFogCoordSrc)+      (fogi FogCoordSrc . marshalFogCoordSrc)++--------------------------------------------------------------------------------++data FogDistanceMode =+     EyeRadial+   | EyePlaneSigned+   | EyePlaneAbsolute+   deriving ( Eq, Ord, Show )++marshalFogDistanceMode :: FogDistanceMode -> GLint+marshalFogDistanceMode x = fromIntegral $ case x of+   EyeRadial -> GL_EYE_RADIAL_NV+   EyePlaneSigned -> GL_EYE_PLANE+   EyePlaneAbsolute -> GL_EYE_PLANE_ABSOLUTE_NV++unmarshalFogDistanceMode :: GLint -> FogDistanceMode+unmarshalFogDistanceMode x+   | y == GL_EYE_RADIAL_NV = EyeRadial+   | y == GL_EYE_PLANE = EyePlaneSigned+   | y == GL_EYE_PLANE_ABSOLUTE_NV = EyePlaneAbsolute+   | otherwise = error ("unmarshalFogDistanceMode: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++fogDistanceMode :: StateVar FogDistanceMode+fogDistanceMode =+   makeStateVar+      (getInteger1 unmarshalFogDistanceMode GetFogDistanceMode)+      (fogi FogDistanceMode . marshalFogDistanceMode)
+ src/Graphics/Rendering/OpenGL/GL/Framebuffer.hs view
@@ -0,0 +1,557 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Framebuffer+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 17.4 (Whole Framebuffer Operations) of the+-- OpenGL 4.5 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Framebuffer (+   -- * Selecting a Buffer for Writing+   BufferMode(..),+   drawBuffer, namedFramebufferDrawBuffer,+   drawBuffers, namedFramebufferDrawBuffers,+   DrawBufferIndex, drawBufferi,+   maxDrawBuffers,++   -- * Fine Control of Buffer Updates+   indexMask, colorMask, colorMaski, depthMask,+   stencilMask, stencilMaskSeparate,++   -- * Clearing the Buffers+   ClearBuffer(..), clear,+   clearColor, clearIndex, clearDepth, clearDepthf, clearStencil, clearAccum,++   ClearBufferCommand(..), clearBuffer, clearNamedFramebuffer,++   -- * Invalidating Framebuffer Contents+   invalidateSubFramebuffer, invalidateNamedFramebufferSubData,+   invalidateFramebuffer, invalidateNamedFramebufferData,++   -- * The Accumulation Buffer+   AccumOp(..), accum,++   -- * Querying the Buffer Configuration+   auxBuffers, doubleBuffer, stereoBuffer,+   rgbaBits, stencilBits, depthBits, accumBits, rgbaSignedComponents,+) where++import Control.Monad+import Data.Maybe+import Data.StateVar+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.BufferMode+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.Face+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++-- | When colors are written to the framebuffer, they are written into the color+-- buffers specified by 'drawBuffer'.+--+-- If more than one color buffer is selected for drawing, then blending or+-- logical operations are computed and applied independently for each color+-- buffer and can produce different results in each buffer.+--+-- Monoscopic contexts include only left buffers, and stereoscopic contexts+-- include both left and right buffers. Likewise, single-buffered contexts+-- include only front buffers, and double-buffered contexts include both front+-- and back buffers. The context is selected at GL initialization.+--+-- The initial value is 'FrontBuffers' for single-buffered contexts, and+-- 'BackBuffers' for double-buffered contexts.++drawBuffer :: StateVar BufferMode+drawBuffer = makeStateVar getDrawBuffer setDrawBuffer++getDrawBuffer :: IO BufferMode+getDrawBuffer = getDrawBufferi 0++setDrawBuffer :: BufferMode -> IO ()+setDrawBuffer mode =+   withBufferModes [mode] $ \[m] ->+      glDrawBuffer m++-- | The direct-state-access version of 'drawBuffer'.++namedFramebufferDrawBuffer :: FramebufferObject -> SettableStateVar BufferMode+namedFramebufferDrawBuffer fbo =+   makeSettableStateVar $ \mode ->+      withBufferModes [mode] $ \[m] ->+         glNamedFramebufferDrawBuffer (framebufferID fbo) m++-- | 'drawBuffers' defines the draw buffers to which all fragment colors are+-- written. The draw buffers being defined correspond in order to the respective+-- fragment colors. The draw buffer for fragment colors beyond those specified+-- is set to 'NoBuffers'.+--+-- Except for 'NoBuffers', a buffer may not appear more then once in the given+-- list. Specifying a buffer more then once will result in an+-- 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation'.+--+-- If fixed-function fragment shading is being performed, 'drawBuffers'+-- specifies a set of draw buffers into which the fragment color is written.+--+-- If a fragment shader writes to @gl_FragColor@, 'drawBuffers' specifies a set+-- of draw buffers into which the single fragment color defined by+-- @gl_FragColor@ is written. If a fragment shader writes to @gl_FragData@,+-- 'drawBuffers' specifies a set of draw buffers into which each of the multiple+-- fragment colors defined by @gl_FragData@ are separately written. If a+-- fragment shader writes to neither @gl_FragColor@ nor @gl_FragData@, the+-- values of the fragment colors following shader execution are undefined, and+-- may differ for each fragment color.++drawBuffers :: StateVar [BufferMode]+drawBuffers = makeStateVar getDrawBuffers setDrawBuffers++getDrawBuffers :: IO [BufferMode]+getDrawBuffers = do+   n <- get maxDrawBuffers+   mapM getDrawBufferi [ 0 .. n-1 ]++setDrawBuffers :: [BufferMode] -> IO ()+setDrawBuffers modes =+   withBufferModes modes $ \ms ->+      withArrayLen ms $ \len ->+         glDrawBuffers (fromIntegral len)++-- | The direct-state-access version of 'drawBuffers'.++namedFramebufferDrawBuffers :: FramebufferObject -> SettableStateVar [BufferMode]+namedFramebufferDrawBuffers fbo =+   makeSettableStateVar $ \modes ->+      withBufferModes modes $ \ms ->+         withArrayLen ms $ \len ->+            glNamedFramebufferDrawBuffers (framebufferID fbo) (fromIntegral len)++withBufferModes :: [BufferMode] -> ([GLenum] -> IO ()) -> IO ()+withBufferModes modes success+   | all isJust ms = success (catMaybes ms)+   | otherwise = recordInvalidValue+   where ms = map marshalBufferMode modes++-- | The index of the draw buffer.++type DrawBufferIndex = GLuint++-- | 'drawBufferi' is a fast query function. For indices in the range+-- 0..'maxDrawBuffers'-1 its results is the same as selecting the corresponding+-- element from the list returned by 'drawBuffers', but this function uses only+-- one GL function call instead of 'maxDrawBuffers' ones.++drawBufferi :: DrawBufferIndex -> GettableStateVar BufferMode+drawBufferi = makeGettableStateVar . getDrawBufferi . fromIntegral++getDrawBufferi :: GLsizei -> IO BufferMode+getDrawBufferi = getEnum1 unmarshalBufferMode . GetDrawBufferN++-- | Contains the maximum number of buffers that can activated via 'drawBuffers'+-- or which can be simultaneously written into from within a fragment shader+-- using the special output variable array @gl_FragData@. This constant+-- effectively defines the size of the @gl_FragData@ array. The minimum legal+-- value is 1.++maxDrawBuffers :: GettableStateVar GLsizei+maxDrawBuffers = makeGettableStateVar $ getSizei1 id GetMaxDrawBuffers++--------------------------------------------------------------------------------++-- | Controls the writing of individual bits in the color index buffers. The+-- least significant /n/ bits of its value, where /n/ is the number of bits in a+-- color index buffer, specify a mask. Where a 1 appears in the mask, it is+-- possible to write to the corresponding bit in the color index buffer (or+-- buffers). Where a 0 appears, the corresponding bit is write-protected.+--+-- This mask is used only in color index mode, and it affects only the buffers+-- currently selected for writing (see 'drawBuffer'). Initially, all bits are+-- enabled for writing.++indexMask :: StateVar GLuint+indexMask =+   makeStateVar (getInteger1 fromIntegral GetIndexWritemask) glIndexMask++-- | Controls whether the individual color components in the framebuffer can or+-- cannot be written. If the red flag is 'Disabled', for example, no change is+-- made to the red component of any pixel in any of the color buffers,+-- regardless of the drawing operation attempted. Initially, all color+-- components can be written.+--+-- Changes to individual bits of components cannot be controlled. Rather,+-- changes are either enabled or disabled for entire color components.+-- Furthermore, this mask is used only in RGBA mode.++colorMask :: StateVar (Color4 Capability)+colorMask =+   makeStateVar+      (getBoolean4 (\r g b a -> Color4 (unmarshalCapability r)+                                       (unmarshalCapability g)+                                       (unmarshalCapability b)+                                       (unmarshalCapability a))+                                       GetColorWritemask)+      (\(Color4 r g b a) -> glColorMask (marshalCapability r)+                                        (marshalCapability g)+                                        (marshalCapability b)+                                        (marshalCapability a))++-- | 'colorMaski' is a version of 'colorMask' that only applies to the specified+-- draw buffer.++colorMaski :: DrawBufferIndex -> StateVar (Color4 Capability)+colorMaski idx =+   makeStateVar+      (getBoolean4i (\r g b a -> Color4 (unmarshalCapability r)+                                        (unmarshalCapability g)+                                        (unmarshalCapability b)+                                        (unmarshalCapability a))+                    GetColorWritemask idx)+      (\(Color4 r g b a) -> glColorMaski idx+                                         (marshalCapability r)+                                         (marshalCapability g)+                                         (marshalCapability b)+                                         (marshalCapability a))++-- | Controls whether the depth buffer is enabled for writing. The initial state+-- is 'Enabled'.++depthMask :: StateVar Capability+depthMask = makeStateVar (getBoolean1 unmarshalCapability GetDepthWritemask)+                         (glDepthMask . marshalCapability)++-- | Controls the writing of individual bits in the stencil planes. The least+-- significant /n/ bits of its value, where /n/ is the number of bits in the+-- stencil buffer, specify a mask. Where a 1 appears in the mask, it is possible+-- to write to the corresponding bit in the stencil buffer. Where a 0 appears,+-- the corresponding bit is write-protected. Initially, all bits are enabled for+-- writing.++stencilMask :: StateVar GLuint+stencilMask =+   makeStateVar (get (stencilMaskSeparate Front)) glStencilMask++-- | A per-face version of 'stencilMask'.++stencilMaskSeparate :: Face -> StateVar GLuint+stencilMaskSeparate face =+   makeStateVar+      (case face of+          Front -> getInteger1 fromIntegral GetStencilWritemask+          Back -> getInteger1 fromIntegral GetStencilBackWritemask+          FrontAndBack -> do recordInvalidEnum; return 0)+      (glStencilMaskSeparate (marshalFace face))++--------------------------------------------------------------------------------++-- | The buffers which can be cleared with 'clear'.++data ClearBuffer =+     ColorBuffer   -- ^ The buffers currently enabled for color writing.+   | AccumBuffer   -- ^ The accumulation buffer.+   | StencilBuffer -- ^ The stencil buffer.+   | DepthBuffer   -- ^ The depth buffer.+   deriving ( Eq, Ord, Show )++marshalClearBuffer :: ClearBuffer -> GLbitfield+marshalClearBuffer x = case x of+   ColorBuffer -> GL_COLOR_BUFFER_BIT+   AccumBuffer -> GL_ACCUM_BUFFER_BIT+   StencilBuffer -> GL_STENCIL_BUFFER_BIT+   DepthBuffer -> GL_DEPTH_BUFFER_BIT++-- | Set the bitplane area of the window to values previously selected by+-- 'clearColor', 'clearIndex', 'clearDepth', 'clearStencil', and 'clearAccum'.+-- Multiple color buffers can be cleared simultaneously by selecting more than+-- one buffer at a time using 'drawBuffer'.+--+-- The pixel ownership test, the scissor test, dithering, and the buffer+-- writemasks affect the operation of 'clear'. The scissor box bounds the+-- cleared region. Alpha function, blend function, logical operation,+-- stenciling, texure mapping, and depth-buffering are ignored by 'clear'.+--+-- 'clear' takes a list of buffers, indicating which buffers are to be cleared.+-- If a buffer is not present, then a 'clear' directed at that buffer has no+-- effect.+--+-- The value to which each buffer is cleared depends on the setting of the clear+-- value for that buffer.++clear :: [ClearBuffer] -> IO ()+clear = glClear . sum . map marshalClearBuffer++-- | Controls the red, green, blue, and alpha values used by 'clear' to clear+-- the color buffers. Initially, all values are 0.++clearColor :: StateVar (Color4 GLfloat)+clearColor = makeStateVar (getFloat4 Color4 GetColorClearValue)+                          (\(Color4 r g b a) -> glClearColor r g b a)++-- | Controls the index /c/ used by 'clear' to clear the color index buffers.+-- /c/ is not clamped. Rather, /c/ is converted to a fixed-point value with+-- unspecified precision to the right of the binary point. The integer part of+-- this value is then masked with 2^/m/-1, where /m/ is the number of bits in a+-- color index stored in the framebuffer. Initially, the value is 0.++clearIndex :: StateVar (Index1 GLfloat)+clearIndex = makeStateVar (getFloat1 Index1 GetIndexClearValue)+                          (\(Index1 i) -> glClearIndex i)++-- | Controls the depth value used by 'clear' to clear the depth buffer. The+-- initial value is 1.++clearDepth :: StateVar GLdouble+clearDepth = makeStateVar (getDouble1 id GetDepthClearValue) glClearDepth++-- | A variant of 'clearDepth' with a 'GLfloat' argument.++clearDepthf :: StateVar GLfloat+clearDepthf = makeStateVar (getFloat1 id GetDepthClearValue) glClearDepthf++-- | Controls the value /s/ used by 'clear' to clear the stencil buffer. /s/ is+-- masked with 2^/m/-1, where /m/ is the number of bits in the stencil buffer.+-- Initially, the value is 0.++clearStencil :: StateVar GLint+clearStencil = makeStateVar (getInteger1 id GetStencilClearValue) glClearStencil++-- | Controls the red, green, blue, and alpha values used by 'clear' to clear+-- the accumulation buffer. Values written into 'clearAccum' are clamped to the+-- range [-1, 1]. The initial values are all 0.++clearAccum :: StateVar (Color4 GLfloat)+clearAccum =+   makeStateVar (getFloat4 Color4 GetAccumClearValue)+                (\(Color4 r g b a) -> glClearAccum r g b a)++-- | Describes which buffer(s) to clear and the value to use.++data ClearBufferCommand+   = ClearColorBufferInt DrawBufferIndex (Color4 GLint)+   -- ^ Clear the signed integer color buffer(s) at the given index.+   | ClearColorBufferFloat DrawBufferIndex (Color4 GLfloat)+   -- ^ Clear the fixed- or floating-point color buffer(s) at the given index.+   | ClearColorBufferUint DrawBufferIndex (Color4 GLuint)+   -- ^ Clear the unsigned color buffer(s) at the given index.+   | ClearDepthBuffer GLfloat+   -- ^ Clear the depth buffer.+   | ClearStencilBuffer GLint+   -- ^ Clear the stencil buffer.+   | ClearDepthAndStencilBuffers GLfloat GLint+   -- ^ Clear the depth buffer and the stencil buffer.+   deriving ( Eq, Ord, Show )++-- | Clear the given buffer(s).++clearBuffer :: ClearBufferCommand -> IO ()+clearBuffer cmd = case cmd of+   ClearColorBufferInt i c ->+      with c $ glClearBufferiv GL_COLOR (fromIntegral i) . castPtr+   ClearColorBufferFloat i c ->+      with c $ glClearBufferfv GL_COLOR (fromIntegral i) . castPtr+   ClearColorBufferUint i c ->+      with c $ glClearBufferuiv GL_COLOR (fromIntegral i) . castPtr+   ClearDepthBuffer d ->+      with d $ glClearBufferfv GL_DEPTH 0+   ClearStencilBuffer s ->+      with s $ glClearBufferiv GL_STENCIL 0+   ClearDepthAndStencilBuffers d s ->+      glClearBufferfi GL_DEPTH_STENCIL 0 d s++-- | The direct-state-access version of 'clearBuffer'.++clearNamedFramebuffer :: FramebufferObject -> ClearBufferCommand -> IO ()+clearNamedFramebuffer fbo cmd = case cmd of+   ClearColorBufferInt i c ->+      with c $ glClearNamedFramebufferiv f GL_COLOR (fromIntegral i) . castPtr+   ClearColorBufferFloat i c ->+      with c $ glClearNamedFramebufferfv f GL_COLOR (fromIntegral i) . castPtr+   ClearColorBufferUint i c ->+      with c $ glClearNamedFramebufferuiv f GL_COLOR (fromIntegral i) . castPtr+   ClearDepthBuffer d ->+      with d $ glClearNamedFramebufferfv f GL_DEPTH 0+   ClearStencilBuffer s ->+      with s $ glClearNamedFramebufferiv f GL_STENCIL 0+   ClearDepthAndStencilBuffers d s ->+      glClearNamedFramebufferfi f GL_DEPTH_STENCIL 0 d s+   where f = framebufferID fbo++--------------------------------------------------------------------------------++-- | Invalidate a region of the attachments bound to the given target.++invalidateSubFramebuffer :: FramebufferTarget -> [FramebufferObjectAttachment] -> (Position, Size) -> IO ()+invalidateSubFramebuffer target attachments (Position x y, Size w h) =+   withAttachments attachments $ \numAttachments atts ->+      glInvalidateSubFramebuffer (marshalFramebufferTarget target) numAttachments atts x y w h++-- | The direct-state-access version of 'invalidateSubFramebuffer'.++invalidateNamedFramebufferSubData :: FramebufferObject -> [FramebufferObjectAttachment] -> (Position, Size) -> IO ()+invalidateNamedFramebufferSubData fbo attachments (Position x y, Size w h) =+   withAttachments attachments $ \numAttachments atts ->+      glInvalidateNamedFramebufferSubData (framebufferID fbo) numAttachments atts x y w h++-- | A version of 'invalidateSubFramebuffer' affecting the whole viewport.++invalidateFramebuffer :: FramebufferTarget -> [FramebufferObjectAttachment] -> IO ()+invalidateFramebuffer target attachments =+   withAttachments attachments $+      glInvalidateFramebuffer (marshalFramebufferTarget target)++-- | The direct-state-access version of 'invalidateFramebuffer'.++invalidateNamedFramebufferData :: FramebufferObject -> [FramebufferObjectAttachment] -> IO ()+invalidateNamedFramebufferData fbo attachments =+   withAttachments attachments $+      glInvalidateNamedFramebufferData (framebufferID fbo)++withAttachments :: [FramebufferObjectAttachment] -> (GLsizei -> Ptr GLenum -> IO ()) -> IO ()+withAttachments attachments success+   | all isJust atts = withArrayLen (catMaybes atts) $ \len buf ->+                          success (fromIntegral len) buf+   | otherwise = recordInvalidEnum+   where atts = map marshalFramebufferObjectAttachment attachments++--------------------------------------------------------------------------------++-- | The implementation and context dependent number of auxiliary buffers.++auxBuffers :: GettableStateVar GLsizei+auxBuffers = makeGettableStateVar $ getSizei1 id GetAuxBuffers++-- | 'True' if front and back buffers exist.++doubleBuffer :: GettableStateVar Bool+doubleBuffer =+   makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetDoublebuffer++-- | 'True' if left and right buffers exist.++stereoBuffer :: GettableStateVar Bool+stereoBuffer =+    makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetStereo++rgbaBits :: GettableStateVar (Color4 GLsizei)+rgbaBits =+   makeGettableStateVar $+      liftM4 Color4 (getSizei1 id GetRedBits)+                    (getSizei1 id GetGreenBits)+                    (getSizei1 id GetBlueBits)+                    (getSizei1 id GetAlphaBits)++stencilBits :: GettableStateVar GLsizei+stencilBits = makeGettableStateVar $ getSizei1 id GetStencilBits++depthBits :: GettableStateVar GLsizei+depthBits = makeGettableStateVar $ getSizei1 id GetDepthBits++accumBits :: GettableStateVar (Color4 GLsizei)+accumBits =+   makeGettableStateVar $+      liftM4 Color4 (getSizei1 id GetAccumRedBits)+                    (getSizei1 id GetAccumGreenBits)+                    (getSizei1 id GetAccumBlueBits)+                    (getSizei1 id GetAccumAlphaBits)++rgbaSignedComponents :: GettableStateVar (Color4 Bool)+rgbaSignedComponents =+   makeGettableStateVar $+      getInteger4 (\r g b a -> Color4 (unmarshalGLboolean r)+                                      (unmarshalGLboolean g)+                                      (unmarshalGLboolean b)+                                      (unmarshalGLboolean a))+                  GetRGBASignedComponents++--------------------------------------------------------------------------------++-- | An operation on the accumulation buffer.++data AccumOp =+     Accum+     -- ^ Obtains /R/, /G/, /B/, and /A/ values from the buffer currently+     -- selected for reading (see+     -- 'Graphics.Rendering.OpenGL.GL.ReadCopyPixels.readBuffer'). Each+     -- component value is divided by 2^/n/-1, where /n/ is the number of bits+     -- allocated to each color component in the currently selected buffer. The+     -- result is a floating-point value in the range [0, 1], which is+     -- multiplied by the value given to 'accum' and added to the corresponding+     -- pixel component in the accumulation buffer, thereby updating the+     -- accumulation buffer.+   | Load+     -- ^ Similar to 'Accum', except that the current value in the accumulation+     -- buffer is not used in the calculation of the new value. That is, the+     -- /R/, /G/, /B/, and /A/ values from the currently selected buffer are+     -- divided by 2^/n/-1, multiplied by the value given to 'accum', and then+     -- stored in the corresponding accumulation buffer cell, overwriting the+     -- current value.+   | Return+     -- ^ Transfers accumulation buffer values to the color buffer or buffers+     -- currently selected for writing. Each /R/, /G/, /B/, and /A/ component+     -- is multiplied by the value given to 'accum', then multiplied by 2^/n/-1,+     -- clamped to the range [0, 2^/n/-1], and stored in the corresponding+     -- display buffer cell. The only fragment operations that are applied to+     -- this transfer are pixel ownership, scissor, dithering, and color+     -- writemasks.+   | Mult+     -- ^ Multiplies each /R/, /G/, /B/, and /A/ in the accumulation buffer by+     -- the value given to 'accum' and returns the scaled component to its+     -- corresponding accumulation buffer location.+   | Add+     -- ^ Adds the value given to 'accum' to each /R/, /G/, /B/, and /A/ in the+     -- accumulation buffer.+   deriving ( Eq, Ord, Show )++marshalAccumOp :: AccumOp -> GLenum+marshalAccumOp x = case x of+   Accum -> GL_ACCUM+   Load -> GL_LOAD+   Return -> GL_RETURN+   Mult -> GL_MULT+   Add -> GL_ADD++--------------------------------------------------------------------------------++-- | The accumulation buffer is an extended-range color buffer. Images are not+-- rendered into it. Rather, images rendered into one of the color buffers are+-- added to the contents of the accumulation buffer after rendering. Effects+-- such as antialiasing (of points, lines, and polygons), motion blur, and+-- depth of field can be created by accumulating images generated with different+-- transformation matrices.+--+-- Each pixel in the accumulation buffer consists of red, green, blue, and alpha+-- values. The number of bits per component in the accumulation buffer depends+-- on the implementation (see 'accumBits'). Regardless of the number of bits per+-- component, the range of values stored by each component is [-1, 1]. The+-- accumulation buffer pixels are mapped one-to-one with frame buffer pixels.+--+-- 'accum' operates on the accumulation buffer. The first argument selects an+-- accumulation buffer operation. The second argument, is a floating-point value+-- to be used in that operation, see 'AccumOp'.+--+-- All accumulation buffer operations are limited to the area of the current+-- scissor box and applied identically to the red, green, blue, and alpha+-- components of each pixel. If an 'accum' operation results in a value outside+-- the range [-1, 1], the contents of an accumulation buffer pixel component+-- are undefined.+--+-- To clear the accumulation buffer, use 'clearAccum' to specify the clear+-- value, then call 'clear' with the accumulation buffer enabled.++accum :: AccumOp -> GLfloat -> IO ()+accum = glAccum . marshalAccumOp
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- Framebuffer objects.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects (+   module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments,+   module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects,+   module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries,+   module Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects+) where+++import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs view
@@ -0,0 +1,67 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments+-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments (+   FramebufferObjectAttachment(..),++   fboaToBufferMode, fboaFromBufferMode,++   FramebufferAttachment(..),++   framebufferRenderbuffer, framebufferTexture1D, framebufferTexture2D,+   framebufferTexture3D, framebufferTextureLayer+) where++import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+import Graphics.Rendering.OpenGL.GL.Texturing.Specification+import Graphics.Rendering.OpenGL.GL.Texturing.TextureObject+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++-----------------------------------------------------------------------------++framebufferRenderbuffer :: FramebufferTarget -> FramebufferObjectAttachment+   -> RenderbufferTarget -> RenderbufferObject -> IO ()+framebufferRenderbuffer fbt fba rbt (RenderbufferObject rboi) =+   maybe recordInvalidValue (\mfba ->  glFramebufferRenderbuffer (marshalFramebufferTarget fbt)+      mfba (marshalRenderbufferTarget rbt) rboi) $ marshalFramebufferObjectAttachment fba++framebufferTexture1D :: FramebufferTarget -> FramebufferObjectAttachment+   -> TextureTarget1D -> TextureObject -> Level -> IO ()+framebufferTexture1D fbt fba tt (TextureObject t) l  =  maybe recordInvalidValue+   (\mfba -> glFramebufferTexture1D (marshalFramebufferTarget fbt) mfba+      (marshalQueryableTextureTarget tt) t l) $ marshalFramebufferObjectAttachment fba++-- Note: Typing is too permissive, no TEXTURE_1D_ARRAY allowed per 4.4. spec.+framebufferTexture2D :: FramebufferTarget -> FramebufferObjectAttachment+   -> TextureTarget2D -> TextureObject -> Level -> IO ()+framebufferTexture2D fbt fba tt (TextureObject t) l = maybe recordInvalidValue+   (\mfba -> glFramebufferTexture2D (marshalFramebufferTarget fbt) mfba+      (marshalQueryableTextureTarget tt) t l)+         $ marshalFramebufferObjectAttachment fba++-- Note: Typing is too permissive, no TEXTURE_2D_ARRAY or TEXTURE_2D_MULTISAMPLE_ARRAY allowed per 4.4. spec.+framebufferTexture3D :: FramebufferTarget -> FramebufferObjectAttachment+   -> TextureTarget3D -> TextureObject -> Level -> GLint -> IO ()+framebufferTexture3D fbt fba tt (TextureObject t) le la = maybe recordInvalidValue+   (\mfba -> glFramebufferTexture3D (marshalFramebufferTarget fbt) mfba+      (marshalQueryableTextureTarget tt) t le la) $ marshalFramebufferObjectAttachment fba++framebufferTextureLayer :: FramebufferTarget -> FramebufferObjectAttachment+   -> TextureObject -> Level -> GLint -> IO()+framebufferTextureLayer fbt fba (TextureObject t) le la = maybe recordInvalidValue+   (\mfba -> glFramebufferTextureLayer (marshalFramebufferTarget fbt)+      mfba t le la) $ marshalFramebufferObjectAttachment fba
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject+-- Copyright   :  (c) Sven Panne 2013-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling FramebufferObjects.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject (+   FramebufferObject(..)+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL+       +--------------------------------------------------------------------------------++newtype FramebufferObject = FramebufferObject { framebufferID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName FramebufferObject where+    isObjectName =+      liftIO . fmap unmarshalGLboolean . glIsFramebuffer . framebufferID++    deleteObjectNames objs =+       liftIO . withArrayLen (map framebufferID objs) $+          glDeleteFramebuffers . fromIntegral++instance GeneratableObjectName FramebufferObject where+    genObjectNames n =+       liftIO . allocaArray n $ \buf -> do+          glGenFramebuffers (fromIntegral n) buf+          fmap (map FramebufferObject) $ peekArray n buf++instance CanBeLabeled FramebufferObject where+   objectLabel = objectNameLabel GL_FRAMEBUFFER . framebufferID
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs view
@@ -0,0 +1,105 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment+-- Copyright   :  (c) Sven Panne 2013-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for marshaling FramebufferObjectAttachments.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment (+   FramebufferObjectAttachment(..),+   marshalFramebufferObjectAttachment,+   unmarshalFramebufferObjectAttachment,+   unmarshalFramebufferObjectAttachmentSafe,+   fboaToBufferMode, fboaFromBufferMode,++   FramebufferAttachment(..), getFBAParameteriv+) where++import Data.Maybe+import Foreign.Marshal+import Graphics.Rendering.OpenGL.GL.BufferMode+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.GL++--------------------------------------------------------------------------------++data FramebufferObjectAttachment =+     ColorAttachment !GLuint+   | DepthAttachment+   | StencilAttachment+   | DepthStencilAttachment+   deriving ( Eq, Ord, Show )++marshalFramebufferObjectAttachment :: FramebufferObjectAttachment -> Maybe GLenum+marshalFramebufferObjectAttachment x = case x of+   ColorAttachment c -> let ec = fromIntegral c in if ec >= maxColorAttachments+      then Nothing+      else Just $ GL_COLOR_ATTACHMENT0 + ec+   DepthAttachment -> Just GL_DEPTH_ATTACHMENT+   StencilAttachment -> Just GL_STENCIL_ATTACHMENT+   DepthStencilAttachment -> Just GL_DEPTH_STENCIL_ATTACHMENT++unmarshalFramebufferObjectAttachment :: GLenum -> FramebufferObjectAttachment+unmarshalFramebufferObjectAttachment x = maybe+   (error $ "unmarshalFramebufferObjectAttachment: unknown enum value " ++ show x) id $+      unmarshalFramebufferObjectAttachmentSafe x+--unmarshalFramebufferObjectAttachment x+--   | x == GL_DEPTH_ATTACHMENT = DepthAttachment+--   | x == GL_STENCIL_ATTACHMENT = StencilAttachment+--   | x == GL_DEPTH_STENCIL_ATTACHMENT = DepthStencilAttachment+--   | x >= gl_COLOR_ATTACHMENT0 && x <= gl_COLOR_ATTACHMENT15+--      = ColorAttachment . fromIntegral $ x - gl_COLOR_ATTACHMENT0+--   | otherwise = error $ "unmarshalFramebufferObjectAttachment: unknown enum value " ++ show x++unmarshalFramebufferObjectAttachmentSafe :: GLenum -> Maybe FramebufferObjectAttachment+unmarshalFramebufferObjectAttachmentSafe x+   | x == GL_DEPTH_ATTACHMENT = Just DepthAttachment+   | x == GL_STENCIL_ATTACHMENT = Just StencilAttachment+   | x == GL_DEPTH_STENCIL_ATTACHMENT = Just DepthStencilAttachment+   | x >= GL_COLOR_ATTACHMENT0 && x <= GL_COLOR_ATTACHMENT0 + maxColorAttachments+      = Just . ColorAttachment . fromIntegral $ x - GL_COLOR_ATTACHMENT0+   | otherwise = Nothing++fboaToBufferMode :: FramebufferObjectAttachment -> Maybe BufferMode+fboaToBufferMode (ColorAttachment i) = Just . FBOColorAttachment $ fromIntegral i+fboaToBufferMode _                   = Nothing++fboaFromBufferMode :: BufferMode -> Maybe FramebufferObjectAttachment+fboaFromBufferMode (FBOColorAttachment i) = Just . ColorAttachment $ fromIntegral i+fboaFromBufferMode _                      = Nothing++-----------------------------------------------------------------------------++class Show a => FramebufferAttachment a where+   marshalAttachment :: a -> Maybe GLenum+   unmarshalAttachment :: GLenum -> a+   unmarshalAttachmentSafe :: GLenum -> Maybe a++instance FramebufferAttachment FramebufferObjectAttachment where+   marshalAttachment = marshalFramebufferObjectAttachment+   unmarshalAttachment = unmarshalFramebufferObjectAttachment+   unmarshalAttachmentSafe = unmarshalFramebufferObjectAttachmentSafe++instance FramebufferAttachment BufferMode where+   marshalAttachment = marshalBufferMode+   unmarshalAttachment = unmarshalBufferMode+   unmarshalAttachmentSafe = unmarshalBufferModeSafe++-----------------------------------------------------------------------------++getFBAParameteriv :: FramebufferAttachment fba => FramebufferTarget -> fba+    -> (GLint -> a) -> GLenum -> IO a+getFBAParameteriv fbt fba f p = with 0 $ \buf -> do+   glGetFramebufferAttachmentParameteriv (marshalFramebufferTarget fbt)+      mfba p buf+   peek1 f buf+      where mfba = fromMaybe (error $ "invalid value" ++ show fba) (marshalAttachment fba)
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs view
@@ -0,0 +1,81 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects+-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects (+   FramebufferObject, defaultFramebufferObject,+   FramebufferTarget(..), bindFramebuffer,+   FramebufferStatus(..), framebufferStatus,+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++-----------------------------------------------------------------------------++defaultFramebufferObject :: FramebufferObject+defaultFramebufferObject = FramebufferObject 0++-----------------------------------------------------------------------------++bindFramebuffer :: FramebufferTarget -> StateVar FramebufferObject+bindFramebuffer fbt =+    makeStateVar (getBoundFramebuffer fbt) (setFramebuffer fbt)++marshalFramebufferTargetBinding :: FramebufferTarget -> PName1I+marshalFramebufferTargetBinding x = case x of+   DrawFramebuffer -> GetDrawFramebufferBinding+   ReadFramebuffer -> GetReadFramebufferBinding+   Framebuffer -> GetFramebufferBinding++getBoundFramebuffer :: FramebufferTarget -> IO FramebufferObject+getBoundFramebuffer =+   getInteger1 (FramebufferObject . fromIntegral) . marshalFramebufferTargetBinding++setFramebuffer :: FramebufferTarget -> FramebufferObject -> IO ()+setFramebuffer fbt =+   glBindFramebuffer (marshalFramebufferTarget fbt) . framebufferID++-----------------------------------------------------------------------------++data FramebufferStatus =+     Complete+   | Undefined+   | IncompleteMissingAttachment+   | IncompleteDrawBuffer+   | IncompleteReadBuffer+   | IncompleteMultiSample+   | Unsupported+   deriving ( Eq, Ord, Show )++unmarshalFramebufferStatus :: GLenum -> FramebufferStatus+unmarshalFramebufferStatus x+   | x == GL_FRAMEBUFFER_COMPLETE = Complete+   | x == GL_FRAMEBUFFER_UNDEFINED = Undefined+   | x == GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT+      = IncompleteMissingAttachment+   | x == GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER = IncompleteDrawBuffer+   | x == GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER = IncompleteReadBuffer+   | x == GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE = IncompleteMultiSample+   | x == GL_FRAMEBUFFER_UNSUPPORTED = Unsupported+   | otherwise = error $ "unmarshalFramebufferStatus: unknown value: "+      ++ show x++-----------------------------------------------------------------------------++framebufferStatus :: FramebufferTarget -> GettableStateVar FramebufferStatus+framebufferStatus t = makeGettableStateVar $ fmap unmarshalFramebufferStatus+   . glCheckFramebufferStatus . marshalFramebufferTarget $ t++-----------------------------------------------------------------------------
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+-- Copyright   :  (c) Sven Panne 2013-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for marshaling FramebufferTargets.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget (+   FramebufferTarget(..), marshalFramebufferTarget+) where++import Graphics.GL++--------------------------------------------------------------------------------++data FramebufferTarget =+     DrawFramebuffer+   | ReadFramebuffer+   | Framebuffer+   deriving ( Eq, Ord, Show )++marshalFramebufferTarget :: FramebufferTarget -> GLenum+marshalFramebufferTarget xs = case xs of+   DrawFramebuffer -> GL_DRAW_FRAMEBUFFER+   ReadFramebuffer -> GL_READ_FRAMEBUFFER+   Framebuffer -> GL_FRAMEBUFFER
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs view
@@ -0,0 +1,232 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries+-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries (+   AttachmentObjectType(..), attachmentObjectType, attachmentObject,+   attachmentTextureLayer, attachmentTextureLevel,+   attachmentTextureTextureTargetCubeMapFace,++   attachmentRedSize, attachmentBlueSize, attachmentGreenSize,+   attachmentAlphaSize, attachmentDepthSize, attachmentStencilSize,++   renderbufferWidth, renderbufferHeight,+   renderbufferInternalFormat, renderbufferSamples,++   renderbufferRedSize, renderbufferBlueSize, renderbufferGreenSize,+   renderbufferAlphaSize, renderbufferDepthSize, renderbufferStencilSize,+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.Texturing.Specification(Level)+import Graphics.Rendering.OpenGL.GL.Texturing.TextureObject+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.GL++-----------------------------------------------------------------------------++data GetFramebufferAttachmentPName =+     AttachmentObjectType+   | AttachmentObjectName+   | AttachmentTextureLevel+   | AttachmentTextureCubeMapFace+   | AttachmentTextureLayer+   | AttachmentComponentType+   | AttachmentColorEncoding+   | AttachmentRedSize+   | AttachmentBlueSize+   | AttachmentGreenSize+   | AttachmentAlphaSize+   | AttachmentDepthSize+   | AttachmentStencilSize++marshalGetFBAPName :: GetFramebufferAttachmentPName -> GLenum+marshalGetFBAPName x = case x of+   AttachmentObjectType -> GL_FRAMEBUFFER_ATTACHMENT_OBJECT_TYPE+   AttachmentObjectName -> GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME+   AttachmentTextureLevel -> GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LEVEL+   AttachmentTextureCubeMapFace -> GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_CUBE_MAP_FACE+   AttachmentTextureLayer -> GL_FRAMEBUFFER_ATTACHMENT_TEXTURE_LAYER+   AttachmentComponentType -> GL_FRAMEBUFFER_ATTACHMENT_COMPONENT_TYPE -- TODO impement usefull function+   AttachmentColorEncoding -> GL_FRAMEBUFFER_ATTACHMENT_COLOR_ENCODING -- TODO impement usefull function+   AttachmentRedSize -> GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE+   AttachmentBlueSize -> GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE+   AttachmentGreenSize -> GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE+   AttachmentAlphaSize -> GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE+   AttachmentDepthSize -> GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE+   AttachmentStencilSize -> GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE++getFBAPName :: FramebufferAttachment fba => FramebufferTarget -> fba+    -> (GLint -> a) -> GetFramebufferAttachmentPName -> IO a+getFBAPName fbt fba f p = getFBAParameteriv fbt fba f (marshalGetFBAPName p)++-----------------------------------------------------------------------------++data AttachmentObjectType =+     DefaultFramebufferAttachment+   | TextureAttachment+   | RenderbufferAttachment+   deriving ( Eq, Ord, Show )++unmarshalAttachmentObjectType :: GLenum -> Maybe AttachmentObjectType+unmarshalAttachmentObjectType x+   | x == GL_FRAMEBUFFER_DEFAULT = Just DefaultFramebufferAttachment+   | x == GL_TEXTURE = Just TextureAttachment+   | x == GL_RENDERBUFFER = Just RenderbufferAttachment+   | x == GL_NONE = Nothing+   | otherwise = error $ "unmarshalAttachmentObject: unknown value " ++ show x++attachmentObjectType :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar (Maybe AttachmentObjectType)+attachmentObjectType fbt fba = makeGettableStateVar $ getFBAPName fbt fba+   (unmarshalAttachmentObjectType . fromIntegral) AttachmentObjectType++-- | tries to retrieve the object that is bound to the attachment point of the+-- given framebuffertarget. If the object type of it is None or the default, then+-- `Nothing` is returned, otherwise the bound `RenderbufferObject` or `TextureObject`+attachmentObject :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar (Maybe (Either RenderbufferObject TextureObject))+attachmentObject fbt fba = makeGettableStateVar getter+   where getter = do+            objT <- get $ attachmentObjectType fbt fba+            case objT of+               Nothing                             -> return $ Nothing+               (Just DefaultFramebufferAttachment) -> return $ Nothing+               (Just TextureAttachment)            -> getObjectName (Right . TextureObject)+               (Just RenderbufferAttachment)       -> getObjectName (Left . RenderbufferObject)+         getObjectName :: Num n => (n -> Either RenderbufferObject TextureObject) -> IO (Maybe (Either RenderbufferObject TextureObject))+         getObjectName con = getFBAPName fbt fba (Just . con . fromIntegral) AttachmentObjectName++attachmentTextureLayer :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar GLint+attachmentTextureLayer fbt fba = makeGettableStateVar $+   getFBAPName fbt fba id AttachmentTextureLayer++attachmentTextureLevel :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar Level+attachmentTextureLevel fbt fba = makeGettableStateVar $+   getFBAPName fbt fba id AttachmentTextureLevel++attachmentTextureTextureTargetCubeMapFace :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar TextureTargetCubeMapFace+attachmentTextureTextureTargetCubeMapFace fbt fba = makeGettableStateVar $+   getFBAPName fbt fba (unmarshalTextureTargetCubeMapFace . fromIntegral) AttachmentTextureLevel++-----------------------------------------------------------------------------++attachmentRedSize :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar GLint+attachmentRedSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba+    id AttachmentRedSize++attachmentGreenSize :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar GLint+attachmentGreenSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba+    id AttachmentGreenSize++attachmentBlueSize :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar GLint+attachmentBlueSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba+    id AttachmentBlueSize++attachmentAlphaSize :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar GLint+attachmentAlphaSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba+    id AttachmentAlphaSize++attachmentDepthSize :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar GLint+attachmentDepthSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba+    id AttachmentDepthSize++attachmentStencilSize :: FramebufferAttachment fba => FramebufferTarget -> fba+   -> GettableStateVar GLint+attachmentStencilSize fbt fba = makeGettableStateVar $ getFBAPName fbt fba+    id AttachmentStencilSize++-----------------------------------------------------------------------------++data GetRenderbufferPName =+     RenderbufferWidth+   | RenderbufferHeight+   | RenderbufferInternalFormat+   | RenderbufferSamples+   | RenderbufferRedSize+   | RenderbufferBlueSize+   | RenderbufferGreenSize+   | RenderbufferAlphaSize+   | RenderbufferDepthSize+   | RenderbufferStencilSize++marshalGetRBPname :: GetRenderbufferPName -> GLenum+marshalGetRBPname x = case x of+    RenderbufferWidth -> GL_RENDERBUFFER_WIDTH+    RenderbufferHeight -> GL_RENDERBUFFER_HEIGHT+    RenderbufferInternalFormat -> GL_RENDERBUFFER_INTERNAL_FORMAT+    RenderbufferSamples -> GL_RENDERBUFFER_SAMPLES+    RenderbufferRedSize -> GL_RENDERBUFFER_RED_SIZE+    RenderbufferBlueSize -> GL_RENDERBUFFER_BLUE_SIZE+    RenderbufferGreenSize -> GL_RENDERBUFFER_GREEN_SIZE+    RenderbufferAlphaSize -> GL_RENDERBUFFER_ALPHA_SIZE+    RenderbufferDepthSize -> GL_RENDERBUFFER_DEPTH_SIZE+    RenderbufferStencilSize -> GL_RENDERBUFFER_STENCIL_SIZE++getRBPName :: RenderbufferTarget -> (GLint -> a) ->+   GetRenderbufferPName -> IO a+getRBPName rbt f = getRBParameteriv rbt f . marshalGetRBPname++-----------------------------------------------------------------------------++renderbufferWidth :: RenderbufferTarget -> GettableStateVar GLsizei+renderbufferWidth rbt = makeGettableStateVar $+   getRBPName rbt fromIntegral RenderbufferWidth++renderbufferHeight :: RenderbufferTarget -> GettableStateVar GLsizei+renderbufferHeight rbt = makeGettableStateVar $+   getRBPName rbt fromIntegral RenderbufferHeight++renderbufferInternalFormat :: RenderbufferTarget+   -> GettableStateVar PixelInternalFormat+renderbufferInternalFormat rbt = makeGettableStateVar $+   getRBPName rbt unmarshalPixelInternalFormat RenderbufferInternalFormat++renderbufferSamples :: RenderbufferTarget -> GettableStateVar Samples+renderbufferSamples rbt = makeGettableStateVar $+   getRBPName rbt (Samples . fromIntegral) RenderbufferSamples++renderbufferRedSize :: RenderbufferTarget -> GettableStateVar GLint+renderbufferRedSize rbt = makeGettableStateVar $+   getRBPName rbt id RenderbufferRedSize++renderbufferGreenSize :: RenderbufferTarget -> GettableStateVar GLint+renderbufferGreenSize rbt = makeGettableStateVar $+   getRBPName rbt id RenderbufferGreenSize++renderbufferBlueSize :: RenderbufferTarget -> GettableStateVar GLint+renderbufferBlueSize rbt = makeGettableStateVar $+   getRBPName rbt id RenderbufferBlueSize++renderbufferAlphaSize :: RenderbufferTarget -> GettableStateVar GLint+renderbufferAlphaSize rbt = makeGettableStateVar $+   getRBPName rbt id RenderbufferAlphaSize++renderbufferDepthSize :: RenderbufferTarget -> GettableStateVar GLint+renderbufferDepthSize rbt = makeGettableStateVar $+   getRBPName rbt id RenderbufferDepthSize++renderbufferStencilSize :: RenderbufferTarget -> GettableStateVar GLint+renderbufferStencilSize rbt = makeGettableStateVar $+   getRBPName rbt id RenderbufferStencilSize
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObject.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling RenderBufferObjects.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject (+   RenderbufferObject(..)+) where+++import Control.Monad.IO.Class+import Data.ObjectName+import Foreign.Marshal ( allocaArray, peekArray, withArrayLen )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL+       +--------------------------------------------------------------------------------++newtype RenderbufferObject = RenderbufferObject { renderbufferID :: GLuint}+   deriving ( Eq, Ord, Show )++instance ObjectName RenderbufferObject where+   isObjectName =+     liftIO . fmap unmarshalGLboolean . glIsRenderbuffer . renderbufferID++   deleteObjectNames objs =+      liftIO . withArrayLen (map renderbufferID objs) $+         glDeleteRenderbuffers . fromIntegral++instance GeneratableObjectName RenderbufferObject where+   genObjectNames n =+      liftIO . allocaArray n $ \buf -> do+         glGenRenderbuffers (fromIntegral n) buf+         fmap (map RenderbufferObject) $ peekArray n buf++instance CanBeLabeled RenderbufferObject where+   objectLabel = objectNameLabel GL_RENDERBUFFER . renderbufferID
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs view
@@ -0,0 +1,72 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects+-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects (+   RenderbufferObject,+   noRenderbufferObject,+   RenderbufferTarget(..),+   RenderbufferSize(..), Samples(..),++   bindRenderbuffer,++   renderbufferStorage, renderbufferStorageMultiSample,+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.GL++-----------------------------------------------------------------------------++noRenderbufferObject :: RenderbufferObject+noRenderbufferObject = RenderbufferObject 0++-----------------------------------------------------------------------------++data RenderbufferSize = RenderbufferSize !GLsizei !GLsizei+   deriving ( Eq, Ord, Show )++-----------------------------------------------------------------------------++bindRenderbuffer :: RenderbufferTarget -> StateVar RenderbufferObject+bindRenderbuffer rbt =+    makeStateVar (getBoundRenderbuffer rbt) (setRenderbuffer rbt)++marshalRenderbufferTargetBinding :: RenderbufferTarget -> PName1I+marshalRenderbufferTargetBinding x = case x of+    Renderbuffer -> GetRenderbufferBinding++getBoundRenderbuffer :: RenderbufferTarget -> IO RenderbufferObject+getBoundRenderbuffer =+   getInteger1 (RenderbufferObject . fromIntegral) . marshalRenderbufferTargetBinding++setRenderbuffer :: RenderbufferTarget -> RenderbufferObject -> IO ()+setRenderbuffer rbt = glBindRenderbuffer (marshalRenderbufferTarget rbt)+   . renderbufferID++-----------------------------------------------------------------------------++renderbufferStorageMultiSample :: RenderbufferTarget -> Samples+   -> PixelInternalFormat -> RenderbufferSize -> IO ()+renderbufferStorageMultiSample rbt (Samples s) pif (RenderbufferSize w h) =+   glRenderbufferStorageMultisample (marshalRenderbufferTarget rbt) s+       (marshalPixelInternalFormat' pif) w h+++renderbufferStorage :: RenderbufferTarget -> PixelInternalFormat+   -> RenderbufferSize -> IO ()+renderbufferStorage rbt pif (RenderbufferSize w h) =+    glRenderbufferStorage (marshalRenderbufferTarget rbt)+       (marshalPixelInternalFormat' pif) w h
+ src/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferTarget.hs view
@@ -0,0 +1,43 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling RenderbufferTargets.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget (+   RenderbufferTarget(..), marshalRenderbufferTarget, getRBParameteriv,+   Samples(..)+) where++import Foreign.Marshal+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.GL++--------------------------------------------------------------------------------++data RenderbufferTarget = Renderbuffer+   deriving ( Eq, Ord, Show )++marshalRenderbufferTarget :: RenderbufferTarget -> GLenum+marshalRenderbufferTarget x = case x of+    Renderbuffer -> GL_RENDERBUFFER++-----------------------------------------------------------------------------++getRBParameteriv :: RenderbufferTarget -> (GLint -> a) -> GLenum -> IO a+getRBParameteriv rbt f p =+   with 0 $ \buf -> do+      glGetRenderbufferParameteriv (marshalRenderbufferTarget rbt) p buf+      peek1 f buf+-----------------------------------------------------------------------------++newtype Samples = Samples GLsizei+   deriving ( Eq, Ord, Show )
+ src/Graphics/Rendering/OpenGL/GL/GLboolean.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.GLboolean+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling GLboolean.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.GLboolean (+   marshalGLboolean, unmarshalGLboolean+) where++import Graphics.GL++--------------------------------------------------------------------------------++marshalGLboolean :: Num a => Bool -> a+marshalGLboolean x = fromIntegral $ case x of+   False -> GL_FALSE+   True -> GL_TRUE++unmarshalGLboolean :: (Eq a, Num a) => a -> Bool+unmarshalGLboolean = (/= fromIntegral GL_FALSE)
+ src/Graphics/Rendering/OpenGL/GL/Hints.hs view
@@ -0,0 +1,88 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Hints+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 5.6 (Hints) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Hints (+   HintTarget(..), HintMode(..), hint+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++data HintTarget =+     PerspectiveCorrection+   | PointSmooth+   | LineSmooth+   | PolygonSmooth+   | Fog+   | GenerateMipmap+   | TextureCompression+   | PackCMYK+   | UnpackCMYK+   deriving ( Eq, Ord, Show )++marshalHintTarget :: HintTarget -> GLenum+marshalHintTarget x = case x of+   PerspectiveCorrection -> GL_PERSPECTIVE_CORRECTION_HINT+   PointSmooth -> GL_POINT_SMOOTH_HINT+   LineSmooth -> GL_LINE_SMOOTH_HINT+   PolygonSmooth -> GL_POLYGON_SMOOTH_HINT+   Fog -> GL_FOG_HINT+   GenerateMipmap -> GL_GENERATE_MIPMAP_HINT+   TextureCompression -> GL_TEXTURE_COMPRESSION_HINT+   PackCMYK -> GL_PACK_CMYK_HINT_EXT+   UnpackCMYK -> GL_UNPACK_CMYK_HINT_EXT++hintTargetToGetPName :: HintTarget -> PName1I+hintTargetToGetPName x = case x of+   PerspectiveCorrection -> GetPerspectiveCorrectionHint+   PointSmooth -> GetPointSmoothHint+   LineSmooth -> GetLineSmoothHint+   PolygonSmooth -> GetPolygonSmoothHint+   Fog -> GetFogHint+   GenerateMipmap -> GetGenerateMipmapHint+   TextureCompression -> GetTextureCompressionHint+   PackCMYK -> GetPackCMYKHint+   UnpackCMYK -> GetUnpackCMYKHint++--------------------------------------------------------------------------------++data HintMode =+     DontCare+   | Fastest+   | Nicest+   deriving ( Eq, Ord, Show )++marshalHintMode :: HintMode -> GLenum+marshalHintMode x = case x of+   DontCare -> GL_DONT_CARE+   Fastest -> GL_FASTEST+   Nicest -> GL_NICEST++unmarshalHintMode :: GLenum -> HintMode+unmarshalHintMode x+   | x == GL_DONT_CARE = DontCare+   | x == GL_FASTEST = Fastest+   | x == GL_NICEST = Nicest+   | otherwise = error ("unmarshalHintMode: illegal value " ++ show x)++--------------------------------------------------------------------------------++hint ::  HintTarget -> StateVar HintMode+hint t =+   makeStateVar+      (getEnum1 unmarshalHintMode (hintTargetToGetPName t))+      (glHint (marshalHintTarget t) . marshalHintMode)
+ src/Graphics/Rendering/OpenGL/GL/IOState.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.IOState+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for an IO monad with a pointer as an+-- additional state, basically a /StateT (Ptr s) IO a/.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.IOState (+   IOState(..), getIOState, peekIOState, evalIOState, nTimes+) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ( Applicative(..) )+#endif+import Control.Monad ( ap, liftM, replicateM )+import Foreign.Ptr ( Ptr, plusPtr )+import Foreign.Storable ( Storable(sizeOf,peek) )++--------------------------------------------------------------------------------++newtype IOState s a = IOState { runIOState :: Ptr s -> IO (a, Ptr s) }++instance Applicative (IOState s) where+   pure  = return+   (<*>) = ap++instance Functor (IOState s) where+   fmap = liftM++instance Monad (IOState s) where+   return a = IOState $ \s -> return (a, s)+   m >>= k  = IOState $ \s -> do (a, s') <- runIOState m s ; runIOState (k a) s'+#if MIN_VERSION_base(4,13,0)+instance MonadFail (IOState s) where+#endif+   fail str = IOState $ \_ -> fail str++getIOState :: IOState s (Ptr s)+getIOState = IOState $ \s -> return (s, s)++putIOState :: Ptr s -> IOState s ()+putIOState s = IOState $ \_ -> return ((), s)++peekIOState :: Storable a => IOState a a+peekIOState = do+   ptr <- getIOState+   x <- liftIOState $ peek ptr+   putIOState (ptr `plusPtr` sizeOf x)+   return x++liftIOState :: IO a -> IOState s a+liftIOState m = IOState $ \s -> do a <- m ; return (a, s)++evalIOState :: IOState s a -> Ptr s -> IO a+evalIOState m s = do (a, _) <- runIOState m s ; return a++nTimes :: Integral a => a -> IOState b c -> IOState b [c]+nTimes n = replicateM (fromIntegral n)
+ src/Graphics/Rendering/OpenGL/GL/LineSegments.hs view
@@ -0,0 +1,150 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.LineSegments+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.4 (Line Segments) of the OpenGL 2.1+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.LineSegments (+   -- * Line Rasterization+   lineWidth,++   -- * Line Stipple+   lineStipple,++   -- * Line Antialiasing+  lineSmooth,++   -- * Implementation-Dependent Limits+   aliasedLineWidthRange, smoothLineWidthRange, smoothLineWidthGranularity+) where++import Control.Monad+import Data.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++-- | 'lineWidth' contains the rasterized width of both aliased and antialiased+-- lines. The initial value is 1. Using a line width other than 1 has different+-- effects, depending on whether line antialiasing is enabled (see+-- 'lineSmooth'). Line antialiasing is initially disabled.+--+-- If line antialiasing is disabled, the actual width is determined by rounding+-- the supplied width to the nearest integer. (If the rounding results in the+-- value 0, it is as if the line width were 1.) If /delta x/ >= /delta y/, /i/+-- pixels are filled in each column that is rasterized, where /i/ is the+-- rounded value of 'lineWidth'. Otherwise, /i/ pixels are filled in each row+-- that is rasterized.+--+-- If antialiasing is enabled, line rasterization produces a fragment for each+-- pixel square that intersects the region lying within the rectangle having+-- width equal to the current line width, length equal to the actual length of+-- the line, and centered on the mathematical line segment. The coverage value+-- for each fragment is the window coordinate area of the intersection of the+-- rectangular region with the corresponding pixel square. This value is saved+-- and used in the final rasterization step.+--+-- Not all widths can be supported when line antialiasing is enabled. If an+-- unsupported width is requested, the nearest supported width is used. Only+-- width 1 is guaranteed to be supported; others depend on the implementation.+--  Likewise, there is a range for aliased line widths as well. To query the+-- range of supported widths of antialiased lines and the size difference+-- between supported widths within the range, query 'smoothLineWidthRange' and+-- 'smoothLineWidthGranularity', respectively. For aliased lines, query the+-- supported range with 'aliasedLineWidthRange'.+--+-- The line width specified when 'lineWidth' is set is always returned when it+-- is queried. Clamping and rounding for aliased and antialiased lines have no+-- effect on the specified value.+--+-- A non-antialiased line width may be clamped to an implementation-dependent+-- maximum.  Query 'aliasedLineWidthRange' to determine the maximum width.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if+-- 'lineWidth' is set to a value less than or equal to zero.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if+-- 'lineWidth' is set during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.++lineWidth :: StateVar GLfloat+lineWidth = makeStateVar (getFloat1 id GetLineWidth) glLineWidth++--------------------------------------------------------------------------------++-- | Line stippling masks out certain fragments produced by rasterization; those+-- fragments will not be drawn. The masking is achieved by using three+-- parameters: the repeat count (1st element of the 'lineStipple' pair, clamped+-- to the range [ 1 .. 256 ]), the 16-bit line stipple pattern (2nd element),+-- and an integer stipple counter /s/.+--+-- The counter /s/ is reset to 0 at before the first action during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is called and before+-- each line segment during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is generated. It is+-- incremented after each fragment of a unit width aliased line segment is+-- generated or after each /i/ fragments of an /i/ width line segment are+-- generated. The /i/ fragments associated with count /s/ are masked out if+-- @'Data.Bits.testBit' /pattern/ (( /s/ \/ /factor/ ) /mod/ 16)@ is 'False',+-- otherwise these fragments are sent to the frame buffer. Bit zero of the+-- pattern is the least significant bit, i.e. it is used first.+--+-- Antialiased lines are treated as a sequence of rectangles of height 1 for+-- purposes of stippling. Whether rectangle /s/ is rasterized or not depends on+-- the fragment rule described for aliased lines, counting rectangles rather+-- than groups of fragments.+--+-- The initial value of 'lineStipple' is 'Nothing', i.e. line stippling is+-- disabled.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if+-- 'lineStipple' is set during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.++lineStipple :: StateVar (Maybe (GLint, GLushort))+lineStipple =+   makeStateVarMaybe+      (return CapLineStipple)+      (liftM2 (,) (getInteger1 id GetLineStippleRepeat)+                  (getInteger1 fromIntegral GetLineStipplePattern))+      (uncurry glLineStipple)++--------------------------------------------------------------------------------++-- | Controls whether line antialiasing is enabled. The initial state is+-- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.++lineSmooth :: StateVar Capability+lineSmooth = makeCapability CapLineSmooth++--------------------------------------------------------------------------------++-- | The smallest and largest supported width of aliased lines.++aliasedLineWidthRange :: GettableStateVar (GLfloat, GLfloat)+aliasedLineWidthRange =+   makeGettableStateVar $ getFloat2 (,) GetAliasedLineWidthRange++-- | The smallest and largest supported width of antialiased lines.++smoothLineWidthRange :: GettableStateVar (GLfloat, GLfloat)+smoothLineWidthRange =+   makeGettableStateVar $ getFloat2 (,) GetSmoothLineWidthRange++-- | The antialiased line width granularity, i.e. the size difference between+-- supported widths.++smoothLineWidthGranularity :: GettableStateVar GLfloat+smoothLineWidthGranularity =+   makeGettableStateVar $ getFloat1 id GetSmoothLineWidthGranularity
+ src/Graphics/Rendering/OpenGL/GL/MatrixComponent.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.CoordTrans+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling matrix components.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.MatrixComponent where++import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.GL++--------------------------------------------------------------------------------++class Storable c => MatrixComponent c where+   getMatrix :: GetPNameMatrix p => p -> Ptr c -> IO ()+   loadMatrix :: Ptr c -> IO ()+   loadTransposeMatrix :: Ptr c -> IO ()+   multMatrix_ :: Ptr c -> IO ()+   multTransposeMatrix :: Ptr c -> IO ()+   getUniformv :: GLuint -> GLint -> Ptr c -> IO ()+   uniformMatrix4v :: GLint -> GLsizei -> GLboolean -> Ptr c -> IO ()+   rotate :: c -> Vector3 c -> IO ()+   translate :: Vector3 c -> IO ()+   scale :: c -> c -> c -> IO ()++instance MatrixComponent GLfloat where+   getMatrix = getMatrixf+   loadMatrix = glLoadMatrixf+   loadTransposeMatrix = glLoadTransposeMatrixf+   multMatrix_ = glMultMatrixf+   multTransposeMatrix = glMultTransposeMatrixf+   getUniformv = glGetUniformfv+   uniformMatrix4v = glUniformMatrix4fv+   rotate a (Vector3 x y z) = glRotatef a x y z+   translate (Vector3 x y z) = glTranslatef x y z+   scale = glScalef++instance MatrixComponent GLdouble where+   getMatrix = getMatrixd+   loadMatrix = glLoadMatrixd+   loadTransposeMatrix = glLoadTransposeMatrixd+   multMatrix_ = glMultMatrixd+   multTransposeMatrix = glMultTransposeMatrixd+   getUniformv = glGetUniformdv+   uniformMatrix4v = glUniformMatrix4dv+   rotate a (Vector3 x y z) = glRotated a x y z+   translate (Vector3 x y z) = glTranslated x y z+   scale = glScaled
+ src/Graphics/Rendering/OpenGL/GL/PeekPoke.hs view
@@ -0,0 +1,107 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PeekPoke+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module with peek- and poke-related utilities.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PeekPoke (+   poke1, poke2, poke3, poke4,+   peek1, peek2, peek3, peek4,+   peek1M, peek2M, peek3M, peek4M+) where++import Foreign.Ptr+import Foreign.Storable++--------------------------------------------------------------------------------+-- The implementation is little bit verbose/redundant, but seems to generate+-- better code than mapM/zipWithM_.++--------------------------------------------------------------------------------++{-# INLINE poke1 #-}+poke1 :: Storable a => Ptr a -> a -> IO ()+poke1 ptr x =+   pokeElemOff ptr 0 x++{-# INLINE poke2 #-}+poke2 :: Storable a => Ptr a -> a -> a -> IO ()+poke2 ptr x y = do+   pokeElemOff ptr 0 x+   pokeElemOff ptr 1 y++{-# INLINE poke3 #-}+poke3 :: Storable a => Ptr a -> a -> a -> a -> IO ()+poke3 ptr x y z = do+   pokeElemOff ptr 0 x+   pokeElemOff ptr 1 y+   pokeElemOff ptr 2 z++{-# INLINE poke4 #-}+poke4 :: Storable a => Ptr a -> a -> a -> a -> a -> IO ()+poke4 ptr x y z w = do+   pokeElemOff ptr 0 x+   pokeElemOff ptr 1 y+   pokeElemOff ptr 2 z+   pokeElemOff ptr 3 w++--------------------------------------------------------------------------------++{-# INLINE peek1 #-}+peek1 :: Storable a => (a -> b) -> Ptr a -> IO b+peek1 f ptr = do+   x <- peekElemOff ptr 0+   return $ f x++{-# INLINE peek2 #-}+peek2 :: Storable a => (a -> a -> b) -> Ptr a -> IO b+peek2 f = peek2M $ \x y -> return (f x y)++{-# INLINE peek3 #-}+peek3 :: Storable a => (a -> a -> a -> b) -> Ptr a -> IO b+peek3 f = peek3M $ \x y z -> return (f x y z)++{-# INLINE peek4 #-}+peek4 :: Storable a => (a -> a -> a -> a -> b) -> Ptr a -> IO b+peek4 f = peek4M $ \x y z w -> return (f x y z w)++--------------------------------------------------------------------------------++{-# INLINE peek1M #-}+peek1M :: Storable a => (a -> IO b) -> Ptr a -> IO b+peek1M f ptr = do+   x <- peekElemOff ptr 0+   f x++{-# INLINE peek2M #-}+peek2M :: Storable a => (a -> a -> IO b) -> Ptr a -> IO b+peek2M f ptr = do+   x <- peekElemOff ptr 0+   y <- peekElemOff ptr 1+   f x y++{-# INLINE peek3M #-}+peek3M :: Storable a => (a -> a -> a -> IO b) -> Ptr a -> IO b+peek3M f ptr = do+   x <- peekElemOff ptr 0+   y <- peekElemOff ptr 1+   z <- peekElemOff ptr 2+   f x y z++{-# INLINE peek4M #-}+peek4M :: Storable a => (a -> a -> a -> a -> IO b) -> Ptr a -> IO b+peek4M f ptr = do+   x <- peekElemOff ptr 0+   y <- peekElemOff ptr 1+   z <- peekElemOff ptr 2+   w <- peekElemOff ptr 3+   f x y z w
+ src/Graphics/Rendering/OpenGL/GL/PerFragment.hs view
@@ -0,0 +1,400 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PerFragment+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 4.1 (Per-Fragment Operations) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PerFragment (+   -- * Discarding Primitives Before Rasterization+   rasterizerDiscard, discardingRasterizer,++   -- * Scissor Test+   scissor,++   -- * Multisample Fragment Operations+   sampleAlphaToCoverage,  sampleAlphaToOne, sampleCoverage,++   -- * Depth Bounds Test+   depthBounds,++   -- * Alpha Test+   ComparisonFunction(..), alphaFunc,++   -- * Stencil Test+   stencilTest, stencilFunc, stencilFuncSeparate, StencilOp(..), stencilOp,+   stencilOpSeparate, activeStencilFace,++   -- * Depth Buffer Test+   depthFunc,++   -- * Blending+   blend, blendBuffer, BlendEquation(..), blendEquation, blendEquationSeparate,+   BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor,++   -- * Dithering+   dither,++   -- * Logical Operation+   LogicOp(..), logicOp+) where++import Control.Monad+import Data.StateVar+import Graphics.Rendering.OpenGL.GL.BlendingFactor+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.ComparisonFunction+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.Face+import Graphics.Rendering.OpenGL.GL.Framebuffer+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++rasterizerDiscard :: StateVar Capability+rasterizerDiscard = makeCapability CapRasterizerDiscard++discardingRasterizer :: IO a -> IO a+discardingRasterizer act = do+   r <- get rasterizerDiscard+   bracket_ (rasterizerDiscard $= Enabled) (rasterizerDiscard $= r) act++--------------------------------------------------------------------------------++scissor :: StateVar (Maybe (Position, Size))+scissor =+   makeStateVarMaybe+      (return CapScissorTest)+      (getInteger4 makeSB GetScissorBox)+      (\(Position x y, Size w h) -> glScissor x y w h)+   where makeSB x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))++--------------------------------------------------------------------------------++sampleAlphaToCoverage :: StateVar Capability+sampleAlphaToCoverage = makeCapability CapSampleAlphaToCoverage++sampleAlphaToOne :: StateVar Capability+sampleAlphaToOne = makeCapability CapSampleAlphaToOne++sampleCoverage :: StateVar (Maybe (GLclampf, Bool))+sampleCoverage =+   makeStateVarMaybe+      (return CapSampleCoverage)+      (liftM2 (,) (getClampf1 id GetSampleCoverageValue)+                  (getBoolean1 unmarshalGLboolean GetSampleCoverageInvert))+      (\(value, invert) -> glSampleCoverage value (marshalGLboolean invert))++--------------------------------------------------------------------------------++depthBounds :: StateVar (Maybe (GLclampd, GLclampd))+depthBounds =+   makeStateVarMaybe+      (return CapDepthBoundsTest)+      (getClampd2 (,) GetDepthBounds)+      (uncurry glDepthBoundsEXT)++--------------------------------------------------------------------------------++alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))+alphaFunc =+   makeStateVarMaybe+      (return CapAlphaTest)+      (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc)+                  (getClampf1 id GetAlphaTestRef))+      (uncurry (glAlphaFunc . marshalComparisonFunction))++--------------------------------------------------------------------------------++stencilTest :: StateVar Capability+stencilTest = makeCapability CapStencilTest++--------------------------------------------------------------------------------++stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint)+stencilFunc =+   makeStateVar+      (get (stencilFuncSeparate Front))+      (\(func, ref, mask) ->+         glStencilFunc (marshalComparisonFunction func) ref mask)++stencilFuncSeparate :: Face -> StateVar (ComparisonFunction, GLint, GLuint)+stencilFuncSeparate face =+   makeStateVar+      (case face of+          Front -> getStencilFunc GetStencilFunc+                                  GetStencilRef+                                  GetStencilValueMask+          Back -> getStencilFunc GetStencilBackFunc+                                 GetStencilBackRef+                                 GetStencilBackValueMask+          FrontAndBack -> do recordInvalidEnum; return (Never, 0, 0))+      (\(func, ref, mask) ->+         glStencilFuncSeparate (marshalFace face)+                               (marshalComparisonFunction func) ref mask)+   where getStencilFunc func ref mask =+            liftM3 (,,) (getEnum1 unmarshalComparisonFunction func)+                        (getInteger1 id ref)+                        (getInteger1 fromIntegral mask)++--------------------------------------------------------------------------------++data StencilOp =+     OpZero+   | OpKeep+   | OpReplace+   | OpIncr+   | OpIncrWrap+   | OpDecr+   | OpDecrWrap+   | OpInvert+   deriving ( Eq, Ord, Show )++marshalStencilOp :: StencilOp -> GLenum+marshalStencilOp x = case x of+   OpZero -> GL_ZERO+   OpKeep -> GL_KEEP+   OpReplace -> GL_REPLACE+   OpIncr -> GL_INCR+   OpIncrWrap -> GL_INCR_WRAP+   OpDecr -> GL_DECR+   OpDecrWrap -> GL_DECR_WRAP+   OpInvert -> GL_INVERT++unmarshalStencilOp :: GLenum -> StencilOp+unmarshalStencilOp x+   | x == GL_ZERO = OpZero+   | x == GL_KEEP = OpKeep+   | x == GL_REPLACE = OpReplace+   | x == GL_INCR = OpIncr+   | x == GL_INCR_WRAP = OpIncrWrap+   | x == GL_DECR = OpDecr+   | x == GL_DECR_WRAP = OpDecrWrap+   | x == GL_INVERT = OpInvert+   | otherwise = error ("unmarshalStencilOp: illegal value " ++ show x)++--------------------------------------------------------------------------------++stencilOp :: StateVar (StencilOp, StencilOp, StencilOp)+stencilOp =+   makeStateVar+      (get (stencilOpSeparate Front))+      (\(sf, spdf, spdp) -> glStencilOp (marshalStencilOp sf)+                                        (marshalStencilOp spdf)+                                        (marshalStencilOp spdp))++stencilOpSeparate :: Face -> StateVar (StencilOp, StencilOp, StencilOp)+stencilOpSeparate face =+   makeStateVar+      (case face of+          Front -> getStencilOp GetStencilFail+                                GetStencilPassDepthFail+                                GetStencilPassDepthPass+          Back ->  getStencilOp GetStencilBackFail+                                GetStencilBackPassDepthFail+                                GetStencilBackPassDepthPass+          FrontAndBack -> do recordInvalidEnum+                             return (OpZero, OpZero, OpZero))+      (\(sf, spdf, spdp) -> glStencilOpSeparate (marshalFace face)+                                                (marshalStencilOp sf)+                                                (marshalStencilOp spdf)+                                                (marshalStencilOp spdp))+   where getStencilOp sf spdf spdp =+            (liftM3 (,,) (getEnum1 unmarshalStencilOp sf)+                         (getEnum1 unmarshalStencilOp spdf)+                         (getEnum1 unmarshalStencilOp spdp))+++--------------------------------------------------------------------------------++activeStencilFace :: StateVar (Maybe Face)+activeStencilFace =+   makeStateVarMaybe+      (return CapStencilTestTwoSide)+      (getEnum1 unmarshalFace GetActiveStencilFace)+      (glActiveStencilFaceEXT . marshalFace)++--------------------------------------------------------------------------------++depthFunc :: StateVar (Maybe ComparisonFunction)+depthFunc =+   makeStateVarMaybe+      (return CapDepthTest)+      (getEnum1 unmarshalComparisonFunction GetDepthFunc)+      (glDepthFunc . marshalComparisonFunction)++--------------------------------------------------------------------------------++blend :: StateVar Capability+blend = makeCapability CapBlend++-- | enable or disable blending based on the buffer bound to the /i/'th drawBuffer+-- that is the buffer fmap (!! i) (get drawBuffers)+blendBuffer :: DrawBufferIndex -> StateVar Capability+blendBuffer = makeIndexedCapability ((fromIntegral GL_DRAW_BUFFER0) +) BlendI++--------------------------------------------------------------------------------++data BlendEquation =+     FuncAdd+   | FuncSubtract+   | FuncReverseSubtract+   | Min+   | Max+   | LogicOp+   deriving ( Eq, Ord, Show )++marshalBlendEquation :: BlendEquation -> GLenum+marshalBlendEquation x = case x of+   FuncAdd -> GL_FUNC_ADD+   FuncSubtract -> GL_FUNC_SUBTRACT+   FuncReverseSubtract -> GL_FUNC_REVERSE_SUBTRACT+   Min -> GL_MIN+   Max -> GL_MAX+   LogicOp -> GL_INDEX_LOGIC_OP++unmarshalBlendEquation :: GLenum -> BlendEquation+unmarshalBlendEquation x+   | x == GL_FUNC_ADD = FuncAdd+   | x == GL_FUNC_SUBTRACT = FuncSubtract+   | x == GL_FUNC_REVERSE_SUBTRACT = FuncReverseSubtract+   | x == GL_MIN = Min+   | x == GL_MAX = Max+   | x == GL_INDEX_LOGIC_OP = LogicOp+   | otherwise = error ("unmarshalBlendEquation: illegal value " ++ show x)++--------------------------------------------------------------------------------++blendEquation :: StateVar BlendEquation+blendEquation =+   makeStateVar+      (getEnum1 unmarshalBlendEquation GetBlendEquation)+      (glBlendEquation . marshalBlendEquation)++blendEquationSeparate :: StateVar (BlendEquation,BlendEquation)+blendEquationSeparate =+   makeStateVar+      (liftM2 (,) (getEnum1 unmarshalBlendEquation GetBlendEquation)+                  (getEnum1 unmarshalBlendEquation GetBlendEquationAlpha))+      (\(funcRGB, funcAlpha) ->+          glBlendEquationSeparate (marshalBlendEquation funcRGB)+                                  (marshalBlendEquation funcAlpha))++--------------------------------------------------------------------------------++blendFuncSeparate ::+   StateVar ((BlendingFactor, BlendingFactor), (BlendingFactor, BlendingFactor))+blendFuncSeparate =+   makeStateVar+      (do srcRGB   <- getEnum1 unmarshalBlendingFactor GetBlendSrcRGB+          srcAlpha <- getEnum1 unmarshalBlendingFactor GetBlendSrcAlpha+          dstRGB   <- getEnum1 unmarshalBlendingFactor GetBlendDstRGB+          dstAlpha <- getEnum1 unmarshalBlendingFactor GetBlendDstAlpha+          return ((srcRGB, srcAlpha), (dstRGB, dstAlpha)))+      (\((srcRGB, srcAlpha), (dstRGB, dstAlpha)) ->+         glBlendFuncSeparate (marshalBlendingFactor srcRGB)+                             (marshalBlendingFactor srcAlpha)+                             (marshalBlendingFactor dstRGB)+                             (marshalBlendingFactor dstAlpha))++blendFunc :: StateVar (BlendingFactor, BlendingFactor)+blendFunc =+   makeStateVar+      (liftM2 (,) (getEnum1 unmarshalBlendingFactor GetBlendSrc)+                  (getEnum1 unmarshalBlendingFactor GetBlendDst))+      (\(s, d) ->+         glBlendFunc (marshalBlendingFactor s) (marshalBlendingFactor d))++blendColor :: StateVar (Color4 GLclampf)+blendColor =+   makeStateVar+      (getClampf4 Color4 GetBlendColor)+      (\(Color4 r g b a) -> glBlendColor r g b a)++--------------------------------------------------------------------------------++dither :: StateVar Capability+dither = makeCapability CapDither++--------------------------------------------------------------------------------++data LogicOp =+     Clear+   | And+   | AndReverse+   | Copy+   | AndInverted+   | Noop+   | Xor+   | Or+   | Nor+   | Equiv+   | Invert+   | OrReverse+   | CopyInverted+   | OrInverted+   | Nand+   | Set+   deriving ( Eq, Ord, Show )++marshalLogicOp :: LogicOp -> GLenum+marshalLogicOp x = case x of+   Clear -> GL_CLEAR+   And -> GL_AND+   AndReverse -> GL_AND_REVERSE+   Copy -> GL_COPY+   AndInverted -> GL_AND_INVERTED+   Noop -> GL_NOOP+   Xor -> GL_XOR+   Or -> GL_OR+   Nor -> GL_NOR+   Equiv -> GL_EQUIV+   Invert -> GL_INVERT+   OrReverse -> GL_OR_REVERSE+   CopyInverted -> GL_COPY_INVERTED+   OrInverted -> GL_OR_INVERTED+   Nand -> GL_NAND+   Set -> GL_SET++unmarshalLogicOp :: GLenum -> LogicOp+unmarshalLogicOp x+   | x == GL_CLEAR = Clear+   | x == GL_AND = And+   | x == GL_AND_REVERSE = AndReverse+   | x == GL_COPY = Copy+   | x == GL_AND_INVERTED = AndInverted+   | x == GL_NOOP = Noop+   | x == GL_XOR = Xor+   | x == GL_OR = Or+   | x == GL_NOR = Nor+   | x == GL_EQUIV = Equiv+   | x == GL_INVERT = Invert+   | x == GL_OR_REVERSE = OrReverse+   | x == GL_COPY_INVERTED = CopyInverted+   | x == GL_OR_INVERTED = OrInverted+   | x == GL_NAND = Nand+   | x == GL_SET = Set+   | otherwise = error ("unmarshalLogicOp: illegal value " ++ show x)++--------------------------------------------------------------------------------++logicOp :: StateVar (Maybe LogicOp)+logicOp =+   makeStateVarMaybe+      (do rgba <- get rgbaMode+          return $ if rgba then CapColorLogicOp else CapIndexLogicOp)+      (getEnum1 unmarshalLogicOp GetLogicOpMode)+      (glLogicOp . marshalLogicOp)
+ src/Graphics/Rendering/OpenGL/GL/PixelData.hs view
@@ -0,0 +1,32 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelData+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal helper module.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelData (+   PixelData(..), withPixelData+) where++import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.DataType+import Graphics.Rendering.OpenGL.GL.PixelFormat+import Graphics.GL++--------------------------------------------------------------------------------++data PixelData a = PixelData PixelFormat DataType (Ptr a)+   deriving ( Eq, Ord, Show )++withPixelData :: PixelData a -> (GLenum -> GLenum -> Ptr a -> b) -> b+withPixelData (PixelData pixelFormat dataType ptr) f =+   f (marshalPixelFormat pixelFormat) (marshalDataType dataType) ptr
+ src/Graphics/Rendering/OpenGL/GL/PixelFormat.hs view
@@ -0,0 +1,128 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelFormat+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling PixelFormat.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelFormat (+   PixelFormat(..), marshalPixelFormat, unmarshalPixelFormat+) where++import Graphics.GL++--------------------------------------------------------------------------------++data PixelFormat =+     ColorIndex+   | StencilIndex+   | DepthComponent+   | DepthStencil+   | Red+   | Green+   | Blue+   | Alpha+   | RG+   | RGB+   | RGBA+   | Luminance+   | LuminanceAlpha+   | RedInteger+   | GreenInteger+   | BlueInteger+   | AlphaInteger+   | RGInteger+   | RGBInteger+   | RGBAInteger+   | BGRInteger+   | BGRAInteger+   | ABGR+   | BGR+   | BGRA+   | CMYK+   | CMYKA+   | FourTwoTwo+   | FourTwoTwoRev+   | FourTwoTwoAverage+   | FourTwoTwoRevAverage+   | YCBCR422+   deriving ( Eq, Ord, Show )++marshalPixelFormat :: PixelFormat -> GLenum+marshalPixelFormat x = case x of+   ColorIndex -> GL_COLOR_INDEX+   StencilIndex -> GL_STENCIL_INDEX+   DepthComponent -> GL_DEPTH_COMPONENT+   Red -> GL_RED+   Green -> GL_GREEN+   Blue -> GL_BLUE+   Alpha -> GL_ALPHA+   RG -> GL_RG+   RGB -> GL_RGB+   RGBA -> GL_RGBA+   Luminance -> GL_LUMINANCE+   LuminanceAlpha -> GL_LUMINANCE_ALPHA+   RedInteger -> GL_RED_INTEGER+   GreenInteger -> GL_GREEN_INTEGER+   BlueInteger -> GL_BLUE_INTEGER+   AlphaInteger -> GL_ALPHA_INTEGER+   RGInteger -> GL_RG_INTEGER+   RGBInteger -> GL_RGB_INTEGER+   RGBAInteger -> GL_RGBA_INTEGER+   BGRInteger -> GL_BGR_INTEGER+   BGRAInteger -> GL_BGRA_INTEGER+   ABGR -> GL_ABGR_EXT+   BGR -> GL_BGR+   BGRA -> GL_BGRA+   CMYK -> GL_CMYK_EXT+   CMYKA -> GL_CMYKA_EXT+   FourTwoTwo -> GL_422_EXT+   FourTwoTwoRev -> GL_422_REV_EXT+   FourTwoTwoAverage -> GL_422_AVERAGE_EXT+   FourTwoTwoRevAverage -> GL_422_REV_AVERAGE_EXT+   YCBCR422 -> GL_YCBCR_422_APPLE+   DepthStencil -> GL_DEPTH_STENCIL++unmarshalPixelFormat :: GLenum -> PixelFormat+unmarshalPixelFormat x+   | x == GL_COLOR_INDEX = ColorIndex+   | x == GL_STENCIL_INDEX = StencilIndex+   | x == GL_DEPTH_COMPONENT = DepthComponent+   | x == GL_RED = Red+   | x == GL_GREEN = Green+   | x == GL_BLUE = Blue+   | x == GL_ALPHA = Alpha+   | x == GL_RG = RG+   | x == GL_RGB = RGB+   | x == GL_RGBA = RGBA+   | x == GL_LUMINANCE = Luminance+   | x == GL_LUMINANCE_ALPHA = LuminanceAlpha+   | x == GL_RED_INTEGER = RedInteger+   | x == GL_GREEN_INTEGER = GreenInteger+   | x == GL_BLUE_INTEGER = BlueInteger+   | x == GL_ALPHA_INTEGER = AlphaInteger+   | x == GL_RG_INTEGER = RGInteger+   | x == GL_RGB_INTEGER = RGBInteger+   | x == GL_RGBA_INTEGER = RGBAInteger+   | x == GL_BGR_INTEGER = BGRInteger+   | x == GL_BGRA_INTEGER = BGRAInteger+   | x == GL_ABGR_EXT = ABGR+   | x == GL_BGR = BGR+   | x == GL_BGRA = BGRA+   | x == GL_CMYK_EXT = CMYK+   | x == GL_CMYKA_EXT = CMYKA+   | x == GL_422_EXT = FourTwoTwo+   | x == GL_422_REV_EXT = FourTwoTwoRev+   | x == GL_422_AVERAGE_EXT = FourTwoTwoAverage+   | x == GL_422_REV_AVERAGE_EXT = FourTwoTwoRevAverage+   | x == GL_YCBCR_422_APPLE = YCBCR422+   | x == GL_DEPTH_STENCIL = DepthStencil+   | otherwise = error ("unmarshalPixelFormat: illegal value " ++ show x)
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles.hs view
@@ -0,0 +1,34 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.6 (Pixel Rectangles) of the OpenGL 2.1+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles (+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax,+   module Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization+) where++import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage+import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer+import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap+import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs view
@@ -0,0 +1,247 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of+-- the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (+   ColorTableStage(..), colorTableStage,+   Proxy(..), ColorTable(..), PixelInternalFormat(..),+   colorTable, getColorTable, copyColorTable, colorSubTable, copyColorSubTable,+   colorTableScale, colorTableBias, colorTableFormat, colorTableWidth,+   colorTableRGBASizes, colorTableLuminanceSize, colorTableIntesitySize,+) where++import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++data ColorTableStage =+     ColorTableStage+   | PostConvolutionColorTableStage+   | PostColorMatrixColorTableStage+   | TextureColorTableStage+   deriving ( Eq, Ord, Show )++colorTableStageToColorTable :: ColorTableStage -> ColorTable+colorTableStageToColorTable x = case x of+   ColorTableStage -> ColorTable+   PostConvolutionColorTableStage -> PostConvolutionColorTable+   PostColorMatrixColorTableStage -> PostColorMatrixColorTable+   TextureColorTableStage -> TextureColorTable++colorTableStageToEnableCap :: ColorTableStage -> EnableCap+colorTableStageToEnableCap x = case x of+   ColorTableStage -> CapColorTable+   PostConvolutionColorTableStage -> CapPostConvolutionColorTable+   PostColorMatrixColorTableStage -> CapPostColorMatrixColorTable+   TextureColorTableStage -> CapTextureColorTable++--------------------------------------------------------------------------------++colorTableStage :: ColorTableStage -> StateVar Capability+colorTableStage = makeCapability . colorTableStageToEnableCap++--------------------------------------------------------------------------------++data ColorTable =+     ColorTable+   | PostConvolutionColorTable+   | PostColorMatrixColorTable+   | Texture1DColorTable+   | Texture2DColorTable+   | Texture3DColorTable+   | TextureCubeMapColorTable+   | TextureColorTable+   | SharedTexturePalette+   deriving ( Eq, Ord, Show )++marshalColorTable :: ColorTable -> GLenum+marshalColorTable x = case x of+   ColorTable -> GL_COLOR_TABLE+   PostConvolutionColorTable -> GL_POST_CONVOLUTION_COLOR_TABLE+   PostColorMatrixColorTable -> GL_POST_COLOR_MATRIX_COLOR_TABLE+   Texture1DColorTable -> GL_TEXTURE_1D+   Texture2DColorTable -> GL_TEXTURE_2D+   Texture3DColorTable -> GL_TEXTURE_3D+   TextureCubeMapColorTable -> GL_TEXTURE_CUBE_MAP+   TextureColorTable -> GL_TEXTURE_COLOR_TABLE_SGI+   SharedTexturePalette -> GL_SHARED_TEXTURE_PALETTE_EXT++--------------------------------------------------------------------------------++data Proxy =+     NoProxy+   | Proxy+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++marshalProxyColorTable :: Proxy -> ColorTable -> Maybe GLenum+marshalProxyColorTable NoProxy x = Just (marshalColorTable x)+marshalProxyColorTable Proxy   x = case x of+   ColorTable -> Just GL_PROXY_COLOR_TABLE+   PostConvolutionColorTable -> Just GL_PROXY_POST_CONVOLUTION_COLOR_TABLE+   PostColorMatrixColorTable -> Just GL_PROXY_POST_COLOR_MATRIX_COLOR_TABLE+   Texture1DColorTable -> Just GL_PROXY_TEXTURE_1D+   Texture2DColorTable -> Just GL_PROXY_TEXTURE_2D+   Texture3DColorTable -> Just GL_PROXY_TEXTURE_3D+   TextureCubeMapColorTable -> Just GL_PROXY_TEXTURE_CUBE_MAP+   TextureColorTable -> Just GL_TEXTURE_COLOR_TABLE_SGI+   SharedTexturePalette -> Nothing++--------------------------------------------------------------------------------++colorTable ::+   Proxy -> ColorTable -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()+colorTable proxy ct int w pd =+   maybe recordInvalidEnum+         (\target -> withPixelData pd $+            glColorTable target (marshalPixelInternalFormat' int) w)+         (marshalProxyColorTable proxy ct)++--------------------------------------------------------------------------------++getColorTable :: ColorTable -> PixelData a -> IO ()+getColorTable ct pd =+   withPixelData pd $ glGetColorTable (marshalColorTable ct)++--------------------------------------------------------------------------------++copyColorTable :: ColorTable -> PixelInternalFormat -> Position -> GLsizei -> IO ()+copyColorTable ct int (Position x y) =+   glCopyColorTable (marshalColorTable ct) (marshalPixelInternalFormat' int) x y++--------------------------------------------------------------------------------++colorSubTable :: ColorTable -> GLsizei -> GLsizei -> PixelData a -> IO ()+colorSubTable ct start count pd =+   withPixelData pd $ glColorSubTable (marshalColorTable ct) start count++--------------------------------------------------------------------------------++copyColorSubTable :: ColorTable -> GLsizei -> Position -> GLsizei -> IO ()+copyColorSubTable ct start (Position x y) =+   glCopyColorSubTable (marshalColorTable ct) start x y++--------------------------------------------------------------------------------++data ColorTablePName =+     ColorTableScale+   | ColorTableBias+   | ColorTableFormat+   | ColorTableWidth+   | ColorTableRedSize+   | ColorTableGreenSize+   | ColorTableBlueSize+   | ColorTableAlphaSize+   | ColorTableLuminanceSize+   | ColorTableIntensitySize++marshalColorTablePName :: ColorTablePName -> GLenum+marshalColorTablePName x = case x of+   ColorTableScale -> GL_COLOR_TABLE_SCALE+   ColorTableBias -> GL_COLOR_TABLE_BIAS+   ColorTableFormat -> GL_COLOR_TABLE_FORMAT+   ColorTableWidth -> GL_COLOR_TABLE_WIDTH+   ColorTableRedSize -> GL_COLOR_TABLE_RED_SIZE+   ColorTableGreenSize -> GL_COLOR_TABLE_GREEN_SIZE+   ColorTableBlueSize -> GL_COLOR_TABLE_BLUE_SIZE+   ColorTableAlphaSize -> GL_COLOR_TABLE_ALPHA_SIZE+   ColorTableLuminanceSize -> GL_COLOR_TABLE_LUMINANCE_SIZE+   ColorTableIntensitySize -> GL_COLOR_TABLE_INTENSITY_SIZE++--------------------------------------------------------------------------------++colorTableScale :: ColorTableStage -> StateVar (Color4 GLfloat)+colorTableScale = colorTableScaleBias ColorTableScale++colorTableBias :: ColorTableStage -> StateVar (Color4 GLfloat)+colorTableBias = colorTableScaleBias ColorTableBias++colorTableScaleBias ::+   ColorTablePName -> ColorTableStage -> StateVar (Color4 GLfloat)+colorTableScaleBias p s =+   makeStateVar (getColorTableParameterC4f ct p) (colorTableParameterC4f ct p)+   where ct = colorTableStageToColorTable s++getColorTableParameterC4f ::+   ColorTable -> ColorTablePName -> IO (Color4 GLfloat)+getColorTableParameterC4f ct p =+   alloca $ \buf -> do+      glGetColorTableParameterfv+         (marshalColorTable ct)+         (marshalColorTablePName p)+         (castPtr buf)+      peek buf++colorTableParameterC4f ::+   ColorTable -> ColorTablePName -> Color4 GLfloat -> IO ()+colorTableParameterC4f ct p c =+   with c $ \ptr ->+      glColorTableParameterfv (marshalColorTable ct) (marshalColorTablePName p) (castPtr ptr)++--------------------------------------------------------------------------------++colorTableFormat :: ColorTable -> GettableStateVar PixelInternalFormat+colorTableFormat ct =+   makeGettableStateVar $+      getColorTableParameteri unmarshalPixelInternalFormat ct ColorTableFormat++getColorTableParameteri :: (GLint -> a) -> ColorTable -> ColorTablePName -> IO a+getColorTableParameteri f ct p =+   with 0 $ \buf -> do+      glGetColorTableParameteriv+         (marshalColorTable ct)+         (marshalColorTablePName p)+         buf+      peek1 f buf++--------------------------------------------------------------------------------++colorTableWidth :: ColorTable -> GettableStateVar GLsizei+colorTableWidth ct =+   makeGettableStateVar $+      getColorTableParameteri fromIntegral ct ColorTableWidth++--------------------------------------------------------------------------------++colorTableRGBASizes :: ColorTable -> GettableStateVar (Color4 GLsizei)+colorTableRGBASizes ct =+   makeGettableStateVar $ do+      r <- getColorTableParameteri fromIntegral ct ColorTableRedSize+      g <- getColorTableParameteri fromIntegral ct ColorTableGreenSize+      b <- getColorTableParameteri fromIntegral ct ColorTableBlueSize+      a <- getColorTableParameteri fromIntegral ct ColorTableAlphaSize+      return $ Color4 r g b a++colorTableLuminanceSize :: ColorTable -> GettableStateVar GLsizei+colorTableLuminanceSize ct =+   makeGettableStateVar $+      getColorTableParameteri fromIntegral ct ColorTableLuminanceSize++colorTableIntesitySize :: ColorTable -> GettableStateVar GLsizei+colorTableIntesitySize ct =+   makeGettableStateVar $+      getColorTableParameteri fromIntegral ct ColorTableIntensitySize
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs view
@@ -0,0 +1,281 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of+-- the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution (+   ConvolutionTarget(..), convolution,+   convolutionFilter1D, getConvolutionFilter1D,+   convolutionFilter2D, getConvolutionFilter2D,+   separableFilter2D, getSeparableFilter2D,+   copyConvolutionFilter1D, copyConvolutionFilter2D,+   convolutionWidth, convolutionHeight,+   maxConvolutionWidth, maxConvolutionHeight,+   ConvolutionBorderMode(..), convolutionBorderMode,+   convolutionFilterScale, convolutionFilterBias,+) where++import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++data ConvolutionTarget =+     Convolution1D+   | Convolution2D+   | Separable2D+   deriving ( Eq, Ord, Show )++marshalConvolutionTarget :: ConvolutionTarget -> GLenum+marshalConvolutionTarget x = case x of+   Convolution1D -> GL_CONVOLUTION_1D+   Convolution2D -> GL_CONVOLUTION_2D+   Separable2D -> GL_SEPARABLE_2D++convolutionTargetToEnableCap :: ConvolutionTarget -> EnableCap+convolutionTargetToEnableCap x = case x of+   Convolution1D -> CapConvolution1D+   Convolution2D -> CapConvolution2D+   Separable2D -> CapSeparable2D++--------------------------------------------------------------------------------++convolution :: ConvolutionTarget -> StateVar Capability+convolution = makeCapability . convolutionTargetToEnableCap++--------------------------------------------------------------------------------++convolutionFilter1D :: PixelInternalFormat -> GLsizei -> PixelData a -> IO ()+convolutionFilter1D int w pd =+   withPixelData pd $+      glConvolutionFilter1D+         (marshalConvolutionTarget Convolution1D)+         (marshalPixelInternalFormat' int) w++--------------------------------------------------------------------------------++getConvolutionFilter1D :: PixelData a -> IO ()+getConvolutionFilter1D = getConvolutionFilter Convolution1D++getConvolutionFilter :: ConvolutionTarget -> PixelData a -> IO ()+getConvolutionFilter t pd =+   withPixelData pd $ glGetConvolutionFilter (marshalConvolutionTarget t)++--------------------------------------------------------------------------------++convolutionFilter2D :: PixelInternalFormat -> Size -> PixelData a -> IO ()+convolutionFilter2D int (Size w h) pd =+   withPixelData pd $+      glConvolutionFilter2D+         (marshalConvolutionTarget Convolution2D)+         (marshalPixelInternalFormat' int) w h++--------------------------------------------------------------------------------++getConvolutionFilter2D :: PixelData a -> IO ()+getConvolutionFilter2D = getConvolutionFilter Convolution2D++--------------------------------------------------------------------------------++separableFilter2D ::+   PixelInternalFormat -> Size -> PixelData a -> PixelData a -> IO ()+separableFilter2D int (Size w h) pdRow pdCol =+   withPixelData pdRow $ \f1 d1 p1 ->+      withPixelData pdCol $ \f2 d2 p2 ->+         if f1 == f2 && d1 == d2+            then glSeparableFilter2D+                    (marshalConvolutionTarget Separable2D)+                    (marshalPixelInternalFormat' int) w h f1 d1 p1 p2+            else recordInvalidValue++--------------------------------------------------------------------------------++getSeparableFilter2D :: PixelData a -> PixelData a -> IO ()+getSeparableFilter2D pdRow pdCol =+   withPixelData pdRow $ \f1 d1 p1 ->+      withPixelData pdCol $ \f2 d2 p2 ->+         if f1 == f2 && d1 == d2+            then glGetSeparableFilter+                    (marshalConvolutionTarget Separable2D) f1 d1 p1 p2 nullPtr+            else recordInvalidValue++--------------------------------------------------------------------------------++copyConvolutionFilter1D :: PixelInternalFormat -> Position -> GLsizei -> IO ()+copyConvolutionFilter1D int (Position x y) =+   glCopyConvolutionFilter1D+      (marshalConvolutionTarget Convolution1D) (marshalPixelInternalFormat' int)+      x y++--------------------------------------------------------------------------------++copyConvolutionFilter2D :: PixelInternalFormat -> Position -> Size -> IO ()+copyConvolutionFilter2D int (Position x y) (Size w h) =+   glCopyConvolutionFilter2D+      (marshalConvolutionTarget Convolution2D) (marshalPixelInternalFormat' int)+      x y w h++--------------------------------------------------------------------------------++data ConvolutionParameter =+     ConvolutionBorderColor+   | ConvolutionBorderMode+   | ConvolutionFilterScale+   | ConvolutionFilterBias+   | ConvolutionFormat+   | ConvolutionWidth+   | ConvolutionHeight+   | MaxConvolutionWidth+   | MaxConvolutionHeight+   deriving ( Eq, Ord, Show )++marshalConvolutionParameter :: ConvolutionParameter -> GLenum+marshalConvolutionParameter x = case x of+   ConvolutionBorderColor -> GL_CONVOLUTION_BORDER_COLOR+   ConvolutionBorderMode -> GL_CONVOLUTION_BORDER_MODE+   ConvolutionFilterScale -> GL_CONVOLUTION_FILTER_SCALE+   ConvolutionFilterBias -> GL_CONVOLUTION_FILTER_BIAS+   ConvolutionFormat -> GL_CONVOLUTION_FORMAT+   ConvolutionWidth -> GL_CONVOLUTION_WIDTH+   ConvolutionHeight -> GL_CONVOLUTION_HEIGHT+   MaxConvolutionWidth -> GL_MAX_CONVOLUTION_WIDTH+   MaxConvolutionHeight -> GL_MAX_CONVOLUTION_HEIGHT++--------------------------------------------------------------------------------++convolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei+convolutionWidth t = convolutionParameteri t ConvolutionWidth++convolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei+convolutionHeight t = convolutionParameteri t ConvolutionHeight++maxConvolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei+maxConvolutionWidth t = convolutionParameteri t MaxConvolutionWidth++maxConvolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei+maxConvolutionHeight t = convolutionParameteri t MaxConvolutionHeight++convolutionParameteri ::+   ConvolutionTarget -> ConvolutionParameter -> GettableStateVar GLsizei+convolutionParameteri t p =+   makeGettableStateVar (getConvolutionParameteri fromIntegral t p)++getConvolutionParameteri ::+   (GLint -> a) -> ConvolutionTarget -> ConvolutionParameter -> IO a+getConvolutionParameteri f t p =+   with 0 $ \buf -> do+      glGetConvolutionParameteriv+         (marshalConvolutionTarget t) (marshalConvolutionParameter p) buf+      peek1 f buf++--------------------------------------------------------------------------------++data ConvolutionBorderMode' =+     Reduce'+   | ConstantBorder'+   | ReplicateBorder'++marshalConvolutionBorderMode' :: ConvolutionBorderMode' -> GLint+marshalConvolutionBorderMode' x = fromIntegral $ case x of+   Reduce' -> GL_REDUCE+   ConstantBorder' -> GL_CONSTANT_BORDER+   ReplicateBorder' -> GL_REPLICATE_BORDER++unmarshalConvolutionBorderMode' :: GLint -> ConvolutionBorderMode'+unmarshalConvolutionBorderMode' x+   | y == GL_REDUCE = Reduce'+   | y == GL_CONSTANT_BORDER = ConstantBorder'+   | y == GL_REPLICATE_BORDER = ReplicateBorder'+   | otherwise = error ("unmarshalConvolutionBorderMode': illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++data ConvolutionBorderMode =+     Reduce+   | ConstantBorder (Color4 GLfloat)+   | ReplicateBorder+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++convolutionBorderMode :: ConvolutionTarget -> StateVar ConvolutionBorderMode+convolutionBorderMode t =+   makeStateVar (getConvolutionBorderMode t) (setConvolutionBorderMode t)++getConvolutionBorderMode :: ConvolutionTarget -> IO ConvolutionBorderMode+getConvolutionBorderMode t = do+   mode <- getConvolutionParameteri+              unmarshalConvolutionBorderMode' t ConvolutionBorderMode+   case mode of+      Reduce' -> return Reduce+      ConstantBorder' -> do+         c <- getConvolutionParameterC4f t ConvolutionBorderColor+         return $ ConstantBorder c+      ReplicateBorder' -> return ReplicateBorder++setConvolutionBorderMode :: ConvolutionTarget -> ConvolutionBorderMode -> IO ()+setConvolutionBorderMode t mode = do+   let setBM = setConvolutionParameteri+                  marshalConvolutionBorderMode' t ConvolutionBorderMode+   case mode of+      Reduce -> setBM Reduce'+      ConstantBorder c -> do+         setBM ConstantBorder'+         convolutionParameterC4f t ConvolutionBorderColor c+      ReplicateBorder -> setBM ReplicateBorder'++setConvolutionParameteri ::+   (a -> GLint) -> ConvolutionTarget -> ConvolutionParameter -> a -> IO ()+setConvolutionParameteri f t p x =+   glConvolutionParameteri+      (marshalConvolutionTarget t) (marshalConvolutionParameter p) (f x)++--------------------------------------------------------------------------------++convolutionFilterScale :: ConvolutionTarget -> StateVar (Color4 GLfloat)+convolutionFilterScale = convolutionC4f ConvolutionFilterScale++convolutionFilterBias :: ConvolutionTarget -> StateVar (Color4 GLfloat)+convolutionFilterBias = convolutionC4f ConvolutionFilterBias++convolutionC4f ::+   ConvolutionParameter -> ConvolutionTarget -> StateVar (Color4 GLfloat)+convolutionC4f p t =+   makeStateVar (getConvolutionParameterC4f t p) (convolutionParameterC4f t p)++getConvolutionParameterC4f ::+   ConvolutionTarget -> ConvolutionParameter -> IO (Color4 GLfloat)+getConvolutionParameterC4f t p =+   alloca $ \buf -> do+      glGetConvolutionParameterfv+         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr buf)+      peek buf++convolutionParameterC4f ::+   ConvolutionTarget -> ConvolutionParameter -> Color4 GLfloat -> IO ()+convolutionParameterC4f t p c =+   with c $ \ptr ->+      glConvolutionParameterfv+         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr ptr)
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs view
@@ -0,0 +1,132 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of+-- the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram (+   Sink(..), histogram, Reset(..), getHistogram, resetHistogram,+   histogramRGBASizes, histogramLuminanceSize+) where++import Data.StateVar+import Foreign.Marshal.Utils+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++data HistogramTarget =+     Histogram+   | ProxyHistogram++marshalHistogramTarget :: HistogramTarget -> GLenum+marshalHistogramTarget x = case x of+   Histogram -> GL_HISTOGRAM+   ProxyHistogram -> GL_PROXY_HISTOGRAM++proxyToHistogramTarget :: Proxy -> HistogramTarget+proxyToHistogramTarget x = case x of+   NoProxy -> Histogram+   Proxy -> ProxyHistogram++--------------------------------------------------------------------------------++histogram :: Proxy -> StateVar (Maybe (GLsizei, PixelInternalFormat, Sink))+histogram proxy =+   makeStateVarMaybe+      (return CapHistogram) (getHistogram' proxy) (setHistogram proxy)++getHistogram' :: Proxy -> IO (GLsizei, PixelInternalFormat, Sink)+getHistogram' proxy = do+   w <- getHistogramParameteri fromIntegral proxy HistogramWidth+   f <- getHistogramParameteri unmarshalPixelInternalFormat proxy HistogramFormat+   s <- getHistogramParameteri unmarshalSink proxy HistogramSink+   return (w, f, s)++getHistogramParameteri ::+   (GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a+getHistogramParameteri f proxy p =+   with 0 $ \buf -> do+      glGetHistogramParameteriv+         (marshalHistogramTarget (proxyToHistogramTarget proxy))+         (marshalGetHistogramParameterPName p)+         buf+      peek1 f buf++setHistogram :: Proxy -> (GLsizei, PixelInternalFormat, Sink) -> IO ()+setHistogram proxy (w, int, sink) =+   glHistogram+      (marshalHistogramTarget (proxyToHistogramTarget proxy))+      w+      (marshalPixelInternalFormat' int)+      (marshalSink sink)++--------------------------------------------------------------------------------++getHistogram :: Reset -> PixelData a -> IO ()+getHistogram reset pd =+   withPixelData pd $+      glGetHistogram+         (marshalHistogramTarget Histogram)+         (marshalReset reset)++--------------------------------------------------------------------------------++resetHistogram :: IO ()+resetHistogram = glResetHistogram (marshalHistogramTarget Histogram)++--------------------------------------------------------------------------------++data GetHistogramParameterPName =+     HistogramWidth+   | HistogramFormat+   | HistogramRedSize+   | HistogramGreenSize+   | HistogramBlueSize+   | HistogramAlphaSize+   | HistogramLuminanceSize+   | HistogramSink++marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum+marshalGetHistogramParameterPName x = case x of+   HistogramWidth -> GL_HISTOGRAM_WIDTH+   HistogramFormat -> GL_HISTOGRAM_FORMAT+   HistogramRedSize -> GL_HISTOGRAM_RED_SIZE+   HistogramGreenSize -> GL_HISTOGRAM_GREEN_SIZE+   HistogramBlueSize -> GL_HISTOGRAM_BLUE_SIZE+   HistogramAlphaSize -> GL_HISTOGRAM_ALPHA_SIZE+   HistogramLuminanceSize -> GL_HISTOGRAM_LUMINANCE_SIZE+   HistogramSink -> GL_HISTOGRAM_SINK++--------------------------------------------------------------------------------++histogramRGBASizes :: Proxy -> GettableStateVar (Color4 GLsizei)+histogramRGBASizes proxy =+   makeGettableStateVar $ do+      r <- getHistogramParameteri fromIntegral proxy HistogramRedSize+      g <- getHistogramParameteri fromIntegral proxy HistogramGreenSize+      b <- getHistogramParameteri fromIntegral proxy HistogramBlueSize+      a <- getHistogramParameteri fromIntegral proxy HistogramAlphaSize+      return $ Color4 r g b a++histogramLuminanceSize :: Proxy -> GettableStateVar GLsizei+histogramLuminanceSize proxy =+   makeGettableStateVar $+      getHistogramParameteri fromIntegral proxy HistogramLuminanceSize
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs view
@@ -0,0 +1,89 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of+-- the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax (+   minmax, getMinmax, resetMinmax+) where++import Data.StateVar+import Foreign.Marshal.Utils+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.GL++--------------------------------------------------------------------------------++data MinmaxTarget =+     Minmax++marshalMinmaxTarget :: MinmaxTarget -> GLenum+marshalMinmaxTarget x = case x of+   Minmax -> GL_MINMAX++--------------------------------------------------------------------------------++minmax :: StateVar (Maybe (PixelInternalFormat, Sink))+minmax = makeStateVarMaybe (return CapMinmax) getMinmax' setMinmax++getMinmax' :: IO (PixelInternalFormat, Sink)+getMinmax' = do+   f <- getMinmaxParameteri unmarshalPixelInternalFormat MinmaxFormat+   s <- getMinmaxParameteri unmarshalSink MinmaxSink+   return (f, s)++setMinmax :: (PixelInternalFormat, Sink) -> IO ()+setMinmax (int, sink) =+   glMinmax+      (marshalMinmaxTarget Minmax)+      (marshalPixelInternalFormat' int)+      (marshalSink sink)++--------------------------------------------------------------------------------++getMinmax :: Reset -> PixelData a -> IO ()+getMinmax reset pd =+   withPixelData pd $+      glGetMinmax (marshalMinmaxTarget Minmax) (marshalReset reset)++--------------------------------------------------------------------------------++resetMinmax :: IO ()+resetMinmax = glResetMinmax (marshalMinmaxTarget Minmax)++--------------------------------------------------------------------------------++data GetMinmaxParameterPName =+     MinmaxFormat+   | MinmaxSink++marshalGetMinmaxParameterPName :: GetMinmaxParameterPName -> GLenum+marshalGetMinmaxParameterPName x = case x of+   MinmaxFormat -> GL_MINMAX_FORMAT+   MinmaxSink -> GL_MINMAX_SINK++--------------------------------------------------------------------------------++getMinmaxParameteri :: (GLint -> a) -> GetMinmaxParameterPName -> IO a+getMinmaxParameteri f p =+   with 0 $ \buf -> do+      glGetMinmaxParameteriv+         (marshalMinmaxTarget Minmax)+         (marshalGetMinmaxParameterPName p)+         buf+      peek1 f buf
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs view
@@ -0,0 +1,209 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of+-- the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap (+   PixelMapTarget(..), PixelMapComponent, PixelMap(..), GLpixelmap,+   maxPixelMapTable, pixelMap, pixelMapIToRGBA, pixelMapRGBAToRGBA,+) where++import Data.List+import Data.StateVar+import Foreign.ForeignPtr+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++data PixelMapTarget =+     IToI+   | SToS+   | IToR+   | IToG+   | IToB+   | IToA+   | RToR+   | GToG+   | BToB+   | AToA+   deriving ( Eq, Ord, Show )++marshalPixelMapTarget :: PixelMapTarget -> GLenum+marshalPixelMapTarget x = case x of+   IToI -> GL_PIXEL_MAP_I_TO_I+   SToS -> GL_PIXEL_MAP_S_TO_S+   IToR -> GL_PIXEL_MAP_I_TO_R+   IToG -> GL_PIXEL_MAP_I_TO_G+   IToB -> GL_PIXEL_MAP_I_TO_B+   IToA -> GL_PIXEL_MAP_I_TO_A+   RToR -> GL_PIXEL_MAP_R_TO_R+   GToG -> GL_PIXEL_MAP_G_TO_G+   BToB -> GL_PIXEL_MAP_B_TO_B+   AToA -> GL_PIXEL_MAP_A_TO_A++pixelMapTargetToGetPName :: PixelMapTarget -> PName1I+pixelMapTargetToGetPName x = case x of+   IToI -> GetPixelMapIToISize+   SToS -> GetPixelMapSToSSize+   IToR -> GetPixelMapIToRSize+   IToG -> GetPixelMapIToGSize+   IToB -> GetPixelMapIToBSize+   IToA -> GetPixelMapIToASize+   RToR -> GetPixelMapRToRSize+   GToG -> GetPixelMapGToGSize+   BToB -> GetPixelMapBToBSize+   AToA -> GetPixelMapAToASize++--------------------------------------------------------------------------------++maxPixelMapTable :: GettableStateVar GLsizei+maxPixelMapTable = makeGettableStateVar $ getSizei1 id GetMaxPixelMapTable++--------------------------------------------------------------------------------++class Storable c => PixelMapComponent c where+   getPixelMapv :: GLenum -> Ptr c -> IO ()+   pixelMapv :: GLenum -> GLsizei -> Ptr c -> IO ()++instance PixelMapComponent GLushort where+   getPixelMapv = glGetPixelMapusv+   pixelMapv = glPixelMapusv++instance PixelMapComponent GLuint where+   getPixelMapv = glGetPixelMapuiv+   pixelMapv = glPixelMapuiv++instance PixelMapComponent GLfloat where+   getPixelMapv = glGetPixelMapfv+   pixelMapv = glPixelMapfv++--------------------------------------------------------------------------------++class PixelMap m where+   withNewPixelMap ::+      PixelMapComponent c => Int -> (Ptr c -> IO ()) -> IO (m c)+   withPixelMap ::+      PixelMapComponent c => m c -> (Int -> Ptr c -> IO a) -> IO a+   newPixelMap :: PixelMapComponent c => [c] -> IO (m c)+   getPixelMapComponents :: PixelMapComponent c => m c -> IO [c]++   withNewPixelMap size act =+      allocaArray size $ \p -> do+         act p+         components <- peekArray size p+         newPixelMap components++   withPixelMap m act = do+      components <- getPixelMapComponents m+      withArrayLen components act++   newPixelMap elements =+      withNewPixelMap (length elements) $ flip pokeArray elements++   getPixelMapComponents m =+      withPixelMap m peekArray++--------------------------------------------------------------------------------++data GLpixelmap a = GLpixelmap Int (ForeignPtr a)+   deriving ( Eq, Ord, Show )++instance PixelMap GLpixelmap where+   withNewPixelMap size f = do+      fp <- mallocForeignPtrArray size+      withForeignPtr fp f+      return $ GLpixelmap size fp++   withPixelMap (GLpixelmap size fp) f = withForeignPtr fp (f size)++--------------------------------------------------------------------------------++pixelMap :: (PixelMap m, PixelMapComponent c) => PixelMapTarget -> StateVar (m c)+pixelMap pm =+   makeStateVar+      (do size <- pixelMapSize pm+          withNewPixelMap size $ getPixelMapv (marshalPixelMapTarget pm))+      (\theMap -> withPixelMap theMap $ pixelMapv (marshalPixelMapTarget pm) . fromIntegral)++pixelMapSize :: PixelMapTarget -> IO Int+pixelMapSize = getInteger1 fromIntegral . pixelMapTargetToGetPName++--------------------------------------------------------------------------------++-- | Convenience state variable++pixelMapIToRGBA :: PixelMapComponent c => StateVar [Color4 c]+pixelMapIToRGBA = pixelMapXToY (IToR, IToG, IToB, IToA)++-- | Convenience state variable++pixelMapRGBAToRGBA :: PixelMapComponent c => StateVar [Color4 c]+pixelMapRGBAToRGBA = pixelMapXToY (RToR, GToG, BToB, AToA)++pixelMapXToY :: PixelMapComponent c =>+      (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)+   -> StateVar [Color4 c]+pixelMapXToY targets =+   makeStateVar (getPixelMapXToY targets) (setPixelMapXToY targets)++getPixelMapXToY :: PixelMapComponent c+   => (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)+   -> IO [Color4 c]+getPixelMapXToY (toR, toG, toB, toA) = do+   withPixelMapFor toR $ \sizeR bufR ->+      withPixelMapFor toG $ \sizeG bufG ->+         withPixelMapFor toB $ \sizeB bufB ->+            withPixelMapFor toA $ \sizeA bufA -> do+               let maxSize = sizeR `max` sizeG `max` sizeB `max` sizeA+               r <- sample sizeR bufR maxSize+               g <- sample sizeR bufG maxSize+               b <- sample sizeR bufB maxSize+               a <- sample sizeR bufA maxSize+               return $ zipWith4 Color4 r g b a++withPixelMapFor ::+    PixelMapComponent c => PixelMapTarget -> (Int -> Ptr c -> IO a) -> IO a+withPixelMapFor target f = do+    theMap <- get (pixelMap target)+    withGLpixelmap theMap f++withGLpixelmap :: PixelMapComponent c+               => GLpixelmap c -> (Int -> Ptr c -> IO a) -> IO a+withGLpixelmap = withPixelMap++sample :: Storable a => Int -> Ptr a -> Int -> IO [a]+sample len ptr newLen = f (fromIntegral (newLen - 1)) []+   where scale :: Float+         scale = fromIntegral len / fromIntegral newLen+         f l acc | l < 0     = return acc+                 | otherwise = do e <- peekElemOff ptr (truncate (l * scale))+                                  f (l - 1) (e : acc)++setPixelMapXToY :: PixelMapComponent c+   => (PixelMapTarget, PixelMapTarget, PixelMapTarget, PixelMapTarget)+   -> [Color4 c] -> IO ()+setPixelMapXToY (toR, toG, toB, toA) colors = do+   (pixelMap toR $=) =<< newGLpixelmap [ r | Color4 r _ _ _ <- colors ]+   (pixelMap toG $=) =<< newGLpixelmap [ g | Color4 _ g _ _ <- colors ]+   (pixelMap toB $=) =<< newGLpixelmap [ b | Color4 _ _ b _ <- colors ]+   (pixelMap toA $=) =<< newGLpixelmap [ a | Color4 _ _ _ a <- colors ]++newGLpixelmap :: PixelMapComponent c => [c] -> IO (GLpixelmap c)+newGLpixelmap = newPixelMap
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs view
@@ -0,0 +1,118 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.6.1 (Pixel Storage Modes) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage (+   PixelStoreDirection(..), swapBytes, lsbFirst, rowLength, skipRows,+   skipPixels, rowAlignment, imageHeight, skipImages+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++data PixelStoreDirection =+     Pack+   | Unpack+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data PixelStore =+     UnpackSwapBytes+   | UnpackLSBFirst+   | UnpackRowLength+   | UnpackSkipRows+   | UnpackSkipPixels+   | UnpackAlignment+   | PackSwapBytes+   | PackLSBFirst+   | PackRowLength+   | PackSkipRows+   | PackSkipPixels+   | PackAlignment+   | PackSkipImages+   | PackImageHeight+   | UnpackSkipImages+   | UnpackImageHeight++marshalPixelStore :: PixelStore -> GLenum+marshalPixelStore x = case x of+   UnpackSwapBytes -> GL_UNPACK_SWAP_BYTES+   UnpackLSBFirst -> GL_UNPACK_LSB_FIRST+   UnpackRowLength -> GL_UNPACK_ROW_LENGTH+   UnpackSkipRows -> GL_UNPACK_SKIP_ROWS+   UnpackSkipPixels -> GL_UNPACK_SKIP_PIXELS+   UnpackAlignment -> GL_UNPACK_ALIGNMENT+   PackSwapBytes -> GL_PACK_SWAP_BYTES+   PackLSBFirst -> GL_PACK_LSB_FIRST+   PackRowLength -> GL_PACK_ROW_LENGTH+   PackSkipRows -> GL_PACK_SKIP_ROWS+   PackSkipPixels -> GL_PACK_SKIP_PIXELS+   PackAlignment -> GL_PACK_ALIGNMENT+   PackSkipImages -> GL_PACK_SKIP_IMAGES+   PackImageHeight -> GL_PACK_IMAGE_HEIGHT+   UnpackSkipImages -> GL_UNPACK_SKIP_IMAGES+   UnpackImageHeight -> GL_UNPACK_IMAGE_HEIGHT++--------------------------------------------------------------------------------++swapBytes :: PixelStoreDirection -> StateVar Bool+swapBytes Pack   = pixelStoreb GetPackSwapBytes PackSwapBytes+swapBytes Unpack = pixelStoreb GetUnpackSwapBytes UnpackSwapBytes++lsbFirst :: PixelStoreDirection -> StateVar Bool+lsbFirst Pack   = pixelStoreb GetPackLSBFirst PackLSBFirst+lsbFirst Unpack = pixelStoreb GetUnpackLSBFirst UnpackLSBFirst++rowLength :: PixelStoreDirection -> StateVar GLint+rowLength Pack   = pixelStorei GetPackRowLength PackRowLength+rowLength Unpack = pixelStorei GetUnpackRowLength UnpackRowLength++skipRows :: PixelStoreDirection -> StateVar GLint+skipRows Pack   = pixelStorei GetPackSkipRows PackSkipRows+skipRows Unpack = pixelStorei GetUnpackSkipRows UnpackSkipRows++skipPixels :: PixelStoreDirection -> StateVar GLint+skipPixels Pack   = pixelStorei GetPackSkipPixels PackSkipPixels+skipPixels Unpack = pixelStorei GetUnpackSkipPixels UnpackSkipPixels++rowAlignment :: PixelStoreDirection -> StateVar GLint+rowAlignment Pack   = pixelStorei GetPackAlignment PackAlignment+rowAlignment Unpack = pixelStorei GetUnpackAlignment UnpackAlignment++imageHeight :: PixelStoreDirection -> StateVar GLint+imageHeight Pack   = pixelStorei GetPackImageHeight PackImageHeight+imageHeight Unpack = pixelStorei GetUnpackImageHeight UnpackImageHeight++skipImages :: PixelStoreDirection -> StateVar GLint+skipImages Pack   = pixelStorei GetPackSkipImages PackSkipImages+skipImages Unpack = pixelStorei GetUnpackSkipImages UnpackSkipImages++--------------------------------------------------------------------------------++pixelStoreb :: PName1I -> PixelStore -> StateVar Bool+pixelStoreb pn ps =+   makeStateVar+      (getBoolean1 unmarshalGLboolean pn)+      (glPixelStorei (marshalPixelStore ps) . marshalGLboolean)++pixelStorei :: PName1I -> PixelStore -> StateVar GLint+pixelStorei pn ps =+   makeStateVar+      (getInteger1 id pn)+      (glPixelStorei (marshalPixelStore ps))
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs view
@@ -0,0 +1,233 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of+-- the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer (+   PixelTransferStage(..),+   mapColor, mapStencil, indexShift, indexOffset, depthScale, depthBias,+   rgbaScale, rgbaBias+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++data PixelTransfer =+     MapColor+   | MapStencil+   | IndexShift+   | IndexOffset+   | RedScale+   | RedBias+   | GreenScale+   | GreenBias+   | BlueScale+   | BlueBias+   | AlphaScale+   | AlphaBias+   | DepthScale+   | DepthBias+   | PostConvolutionRedScale+   | PostConvolutionGreenScale+   | PostConvolutionBlueScale+   | PostConvolutionAlphaScale+   | PostConvolutionRedBias+   | PostConvolutionGreenBias+   | PostConvolutionBlueBias+   | PostConvolutionAlphaBias+   | PostColorMatrixRedScale+   | PostColorMatrixGreenScale+   | PostColorMatrixBlueScale+   | PostColorMatrixAlphaScale+   | PostColorMatrixRedBias+   | PostColorMatrixGreenBias+   | PostColorMatrixBlueBias+   | PostColorMatrixAlphaBias++marshalPixelTransfer :: PixelTransfer -> GLenum+marshalPixelTransfer x = case x of+   MapColor -> GL_MAP_COLOR+   MapStencil -> GL_MAP_STENCIL+   IndexShift -> GL_INDEX_SHIFT+   IndexOffset -> GL_INDEX_OFFSET+   RedScale -> GL_RED_SCALE+   RedBias -> GL_RED_BIAS+   GreenScale -> GL_GREEN_SCALE+   GreenBias -> GL_GREEN_BIAS+   BlueScale -> GL_BLUE_SCALE+   BlueBias -> GL_BLUE_BIAS+   AlphaScale -> GL_ALPHA_SCALE+   AlphaBias -> GL_ALPHA_BIAS+   DepthScale -> GL_DEPTH_SCALE+   DepthBias -> GL_DEPTH_BIAS+   PostConvolutionRedScale -> GL_POST_CONVOLUTION_RED_SCALE+   PostConvolutionGreenScale -> GL_POST_CONVOLUTION_GREEN_SCALE+   PostConvolutionBlueScale -> GL_POST_CONVOLUTION_BLUE_SCALE+   PostConvolutionAlphaScale -> GL_POST_CONVOLUTION_ALPHA_SCALE+   PostConvolutionRedBias -> GL_POST_CONVOLUTION_RED_BIAS+   PostConvolutionGreenBias -> GL_POST_CONVOLUTION_GREEN_BIAS+   PostConvolutionBlueBias -> GL_POST_CONVOLUTION_BLUE_BIAS+   PostConvolutionAlphaBias -> GL_POST_CONVOLUTION_ALPHA_BIAS+   PostColorMatrixRedScale -> GL_POST_COLOR_MATRIX_RED_SCALE+   PostColorMatrixGreenScale -> GL_POST_COLOR_MATRIX_GREEN_SCALE+   PostColorMatrixBlueScale -> GL_POST_COLOR_MATRIX_BLUE_SCALE+   PostColorMatrixAlphaScale -> GL_POST_COLOR_MATRIX_ALPHA_SCALE+   PostColorMatrixRedBias -> GL_POST_COLOR_MATRIX_RED_BIAS+   PostColorMatrixGreenBias -> GL_POST_COLOR_MATRIX_GREEN_BIAS+   PostColorMatrixBlueBias -> GL_POST_COLOR_MATRIX_BLUE_BIAS+   PostColorMatrixAlphaBias -> GL_POST_COLOR_MATRIX_ALPHA_BIAS++--------------------------------------------------------------------------------++data PixelTransferStage =+     PreConvolution+   | PostConvolution+   | PostColorMatrix+   deriving ( Eq, Ord, Show )++stageToGetScales ::+      PixelTransferStage+   -> (PName1F, PName1F, PName1F, PName1F)+stageToGetScales s = case s of+   PreConvolution  -> (GetRedScale,+                       GetGreenScale,+                       GetBlueScale,+                       GetAlphaScale)+   PostConvolution -> (GetPostConvolutionRedScale,+                       GetPostConvolutionGreenScale,+                       GetPostConvolutionBlueScale,+                       GetPostConvolutionAlphaScale)+   PostColorMatrix -> (GetPostColorMatrixRedScale,+                       GetPostColorMatrixGreenScale,+                       GetPostColorMatrixBlueScale,+                       GetPostColorMatrixAlphaScale)++stageToSetScales ::+      PixelTransferStage+   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)+stageToSetScales s = case s of+   PreConvolution  -> (RedScale,+                       GreenScale,+                       BlueScale,+                       AlphaScale)+   PostConvolution -> (PostConvolutionRedScale,+                       PostConvolutionGreenScale,+                       PostConvolutionBlueScale,+                       PostConvolutionAlphaScale)+   PostColorMatrix -> (PostColorMatrixRedScale,+                       PostColorMatrixGreenScale,+                       PostColorMatrixBlueScale,+                       PostColorMatrixAlphaScale)++stageToGetBiases ::+      PixelTransferStage+   -> (PName1F, PName1F, PName1F, PName1F)+stageToGetBiases s = case s of+   PreConvolution  -> (GetRedBias,+                       GetGreenBias,+                       GetBlueBias,+                       GetAlphaBias)+   PostConvolution -> (GetPostConvolutionRedBias,+                       GetPostConvolutionGreenBias,+                       GetPostConvolutionBlueBias,+                       GetPostConvolutionAlphaBias)+   PostColorMatrix -> (GetPostColorMatrixRedBias,+                       GetPostColorMatrixGreenBias,+                       GetPostColorMatrixBlueBias,+                       GetPostColorMatrixAlphaBias)++stageToSetBiases ::+      PixelTransferStage+   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)+stageToSetBiases s = case s of+   PreConvolution  -> (RedBias,+                       GreenBias,+                       BlueBias,+                       AlphaBias)+   PostConvolution -> (PostConvolutionRedBias,+                       PostConvolutionGreenBias,+                       PostConvolutionBlueBias,+                       PostConvolutionAlphaBias)+   PostColorMatrix -> (PostColorMatrixRedBias,+                       PostColorMatrixGreenBias,+                       PostColorMatrixBlueBias,+                       PostColorMatrixAlphaBias)++--------------------------------------------------------------------------------++mapColor :: StateVar Capability+mapColor = pixelTransferb GetMapColor MapColor++mapStencil :: StateVar Capability+mapStencil = pixelTransferb GetMapStencil MapStencil++indexShift :: StateVar GLint+indexShift = pixelTransferi GetIndexShift IndexShift++indexOffset :: StateVar GLint+indexOffset = pixelTransferi GetIndexOffset IndexOffset++depthScale :: StateVar GLfloat+depthScale = pixelTransferf GetDepthScale DepthScale++depthBias :: StateVar GLfloat+depthBias = pixelTransferf GetDepthBias DepthBias++rgbaScale :: PixelTransferStage -> StateVar (Color4 GLfloat)+rgbaScale s = pixelTransfer4f (stageToGetScales s) (stageToSetScales s)++rgbaBias :: PixelTransferStage -> StateVar (Color4 GLfloat)+rgbaBias s = pixelTransfer4f (stageToGetBiases s) (stageToSetBiases s)++--------------------------------------------------------------------------------++pixelTransferb :: GetPName1I p => p -> PixelTransfer -> StateVar Capability+pixelTransferb pn pt =+   makeStateVar+      (getBoolean1 unmarshalCapability pn)+      (glPixelTransferi (marshalPixelTransfer pt) .+       fromIntegral . marshalCapability)++pixelTransferi :: GetPName1I p => p -> PixelTransfer -> StateVar GLint+pixelTransferi pn pt =+   makeStateVar+      (getInteger1 id pn)+      (glPixelTransferi (marshalPixelTransfer pt))++pixelTransferf :: GetPName1F p => p -> PixelTransfer -> StateVar GLfloat+pixelTransferf pn pt =+   makeStateVar+      (getFloat1 id pn)+      (glPixelTransferf (marshalPixelTransfer pt))++pixelTransfer4f :: GetPName1F p =>+      (p, p, p, p)+   -> (PixelTransfer, PixelTransfer, PixelTransfer, PixelTransfer)+   -> StateVar (Color4 GLfloat)+pixelTransfer4f (pr, pg, pb, pa) (tr, tg, tb, ta) = makeStateVar get4f set4f+   where get4f = do+            r <- getFloat1 id pr+            g <- getFloat1 id pg+            b <- getFloat1 id pb+            a <- getFloat1 id pa+            return $ Color4 r g b a+         set4f (Color4 r g b a) = do+            glPixelTransferf (marshalPixelTransfer tr) r+            glPixelTransferf (marshalPixelTransfer tg) g+            glPixelTransferf (marshalPixelTransfer tb) b+            glPixelTransferf (marshalPixelTransfer ta) a
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs view
@@ -0,0 +1,39 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to a part of section 3.6.4 (Rasterization of Pixel+-- Rectangles) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization (+   PixelData(..), PixelFormat(..), drawPixels, pixelZoom+) where++import Control.Monad+import Data.StateVar+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.PixelFormat+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++drawPixels :: Size -> PixelData a -> IO ()+drawPixels (Size w h) pd = withPixelData pd $ glDrawPixels w h++--------------------------------------------------------------------------------++pixelZoom :: StateVar (GLfloat, GLfloat)+pixelZoom =+   makeStateVar+      (liftM2 (,) (getFloat1 id GetZoomX) (getFloat1 id GetZoomY))+      (uncurry glPixelZoom)
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling Reset.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset (+   Reset(..), marshalReset+) where++import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.GL++--------------------------------------------------------------------------------++data Reset =+     NoReset+   | Reset+   deriving ( Eq, Ord, Show )++marshalReset :: Reset -> GLboolean+marshalReset x = marshalGLboolean (x == Reset)
+ src/Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling Sink.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink (+   Sink(..), marshalSink, unmarshalSink+) where++import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.GL++--------------------------------------------------------------------------------++data Sink =+     PassThrough+   | Sink+   deriving ( Eq, Ord, Show )++marshalSink :: Sink -> GLboolean+marshalSink x = marshalGLboolean (x == Sink)++unmarshalSink :: GLint -> Sink+unmarshalSink s = if unmarshalGLboolean s then Sink else PassThrough
+ src/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs view
@@ -0,0 +1,82 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixellikeObject+-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixellikeObject (+  PixellikeObjectGetPName(..),+  PixellikeObjectTarget(pixellikeObjTarParam),+) where++import Data.StateVar+import Foreign.Marshal.Utils+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.Texturing.Specification+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.GL++-----------------------------------------------------------------------------++data PixellikeObjectGetPName =+     RedSize+   | BlueSize+   | GreenSize+   | AlphaSize+   | DepthSize+   | StencilSize++class PixellikeObjectTarget t where+   --dummy t to include it in the type class+   marshalPixellikeOT :: t -> PixellikeObjectGetPName -> GLenum+   pixObjTarQueryFunc :: t -> GLenum -> IO GLint+   pixellikeObjTarParam :: t -> PixellikeObjectGetPName -> GettableStateVar GLint+   pixellikeObjTarParam t p = makeGettableStateVar (pixObjTarQueryFunc t $ marshalPixellikeOT t p)++instance PixellikeObjectTarget RenderbufferTarget where+   marshalPixellikeOT _ x = case x of+      RedSize -> GL_RENDERBUFFER_RED_SIZE+      BlueSize -> GL_RENDERBUFFER_BLUE_SIZE+      GreenSize -> GL_RENDERBUFFER_GREEN_SIZE+      AlphaSize -> GL_RENDERBUFFER_ALPHA_SIZE+      DepthSize -> GL_RENDERBUFFER_DEPTH_SIZE+      StencilSize -> GL_RENDERBUFFER_STENCIL_SIZE+   pixObjTarQueryFunc t = getRBParameteriv t id++data FramebufferTargetAttachment =+    FramebufferTargetAttachment FramebufferTarget FramebufferObjectAttachment++instance PixellikeObjectTarget FramebufferTargetAttachment where+   marshalPixellikeOT _ x = case x of+      RedSize -> GL_FRAMEBUFFER_ATTACHMENT_RED_SIZE+      BlueSize -> GL_FRAMEBUFFER_ATTACHMENT_BLUE_SIZE+      GreenSize -> GL_FRAMEBUFFER_ATTACHMENT_GREEN_SIZE+      AlphaSize -> GL_FRAMEBUFFER_ATTACHMENT_ALPHA_SIZE+      DepthSize -> GL_FRAMEBUFFER_ATTACHMENT_DEPTH_SIZE+      StencilSize -> GL_FRAMEBUFFER_ATTACHMENT_STENCIL_SIZE+   pixObjTarQueryFunc (FramebufferTargetAttachment fbt fba) =+      getFBAParameteriv fbt fba id++data TextureTargetFull t = TextureTargetFull t Level++instance QueryableTextureTarget t => PixellikeObjectTarget (TextureTargetFull t) where+   marshalPixellikeOT _ x = case x of+      RedSize -> GL_TEXTURE_RED_SIZE+      BlueSize -> GL_TEXTURE_BLUE_SIZE+      GreenSize -> GL_TEXTURE_GREEN_SIZE+      AlphaSize -> GL_TEXTURE_ALPHA_SIZE+      DepthSize -> GL_TEXTURE_DEPTH_SIZE+      StencilSize -> GL_TEXTURE_STENCIL_SIZE+   pixObjTarQueryFunc (TextureTargetFull t level) p =+      with 0 $ \buf -> do+      glGetTexLevelParameteriv (marshalQueryableTextureTarget t) level p buf+      peek1 id buf
+ src/Graphics/Rendering/OpenGL/GL/PointParameter.hs view
@@ -0,0 +1,44 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PointParameter+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for setting point parameters.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PointParameter (+   PointParameter(..), pointParameterf, pointParameterfv+) where++import Foreign.Ptr+import Graphics.GL++--------------------------------------------------------------------------------++data PointParameter =+     PointSizeMin+   | PointSizeMax+   | PointFadeThresholdSize+   | PointDistanceAttenuation++marshalPointParameter :: PointParameter -> GLenum+marshalPointParameter x = case x of+   PointSizeMin -> GL_POINT_SIZE_MIN+   PointSizeMax -> GL_POINT_SIZE_MAX+   PointFadeThresholdSize -> GL_POINT_FADE_THRESHOLD_SIZE+   PointDistanceAttenuation -> GL_POINT_DISTANCE_ATTENUATION++--------------------------------------------------------------------------------++pointParameterf :: PointParameter -> GLfloat -> IO ()+pointParameterf = glPointParameterf . marshalPointParameter++pointParameterfv :: PointParameter -> Ptr GLfloat -> IO ()+pointParameterfv = glPointParameterfv . marshalPointParameter
+ src/Graphics/Rendering/OpenGL/GL/Points.hs view
@@ -0,0 +1,217 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Points+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.3 (Points) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Points (+   -- * Point Rasterization+   pointSize, vertexProgramPointSize,++   -- * Controlling the Derived Size+   pointSizeRange, pointDistanceAttenuation,++   -- * Fading Points+   pointFadeThresholdSize,++   -- * Point Antialiasing+   pointSmooth,++   -- * Point Sprites+   pointSprite,++   -- * Implementation-Dependent Limits+   aliasedPointSizeRange, smoothPointSizeRange, smoothPointSizeGranularity+) where++import Control.Monad+import Data.StateVar+import Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.PointParameter+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++-- | 'pointSize' contains the rasterized diameter of both aliased and+-- antialiased points. The initial value is 1. Using a point size other than 1+-- has different effects, depending on whether point antialiasing is enabled+-- (see 'pointSmooth') or point sprites are enabled (see 'pointSprite'). Both+-- are initially disabled.+--+-- The specified point size is multiplied with a distance attenuation factor+-- and clamped to the specified 'pointSizeRange', and further clamped to the+-- implementation-dependent point size range to produce the derived point size+-- using+--+-- @   /derivedSize/ = /clamp/ (/size/ * /sqrt/ (1 \/ (/a/ + /b/ * /d/ + /c/ * /d/^2)))@+--+-- where /d/ is the eye-coordinate distance from the eye to the vertex, and /a/,+-- /b/, and /c/ are the distance attenuation coefficients (see+-- 'pointDistanceAttenuation').+--+-- If multisampling is disabled, the computed point size is used as the point\'s+-- width.+--+-- If multisampling is enabled, the point may be faded by modifying the point+-- alpha value (see 'Graphics.Rendering.OpenGL.GL.PerFragment.sampleCoverage')+-- instead of allowing the point width to go below a given+-- 'pointFadeThresholdSize'. In this case, the width is further modified in+-- the following manner:+--+-- @   /width/ = if /derivedSize/ >= /threshold/ then /derivedSize/ else /threshold/@+--+-- The point alpha value is modified by computing:+--+-- @   /alpha/ = if /derivedSize/ >= /threshold/ then 1 else (/derivedSize/ \/ /threshold/)^2@+--+-- If point antialiasing is disabled, the actual size is determined by rounding+-- the supplied size to the nearest integer. (If the rounding results in the+-- value 0, it is as if the point size were 1.) If the rounded size is odd,+-- then the center point (/x/, /y/) of the pixel fragment that represents+-- the point is computed as+--+-- @   (/x/, /y/) = (/floor/ /xw/ + 0.5, /floor/ /yw/ + 0.5)@+--+-- where /xw/ and /yw/ indicate window coordinates. All pixels that lie within+-- the square grid of the rounded size centered at (/x/, /y/) make up the+-- fragment. If the size is even, the center point is+--+-- @   (/x/, /y/) = (/floor/ (/xw/ + 0.5), /floor/ (/yw/ + 0.5))@+--+-- and the rasterized fragment\'s centers are the half-integer window+-- coordinates within the square of the rounded size centered at (/x/, /y/). All+-- pixel fragments produced in rasterizing a nonantialiased point are assigned+-- the same associated data, that of the vertex corresponding to the point.+--+-- If antialiasing is enabled, then point rasterization produces a fragment for+-- each pixel square that intersects the region lying within the circle having+-- diameter equal to the current point size and centered at the point\'s+-- (/xw/, /yw/). The coverage value for each fragment is the window coordinate+-- area of the intersection of the circular region with the corresponding pixel+-- square. This value is saved and used in the final rasterization step. The+-- data associated with each fragment is the data associated with the point+-- being rasterized.+--+-- Not all sizes are supported when point antialiasing is enabled. If an+-- unsupported size is requested, the nearest supported size is used.  Only size+-- 1 is guaranteed to be supported; others depend on the implementation. To+-- query the range of supported sizes for antialiased points and the size+-- difference between supported sizes within the range, query+-- 'smoothPointSizeRange' and 'smoothPointSizeGranularity', respectively. For+-- aliased points, query the supported range with 'aliasedPointSizeRange'.+--+-- The point size specified when 'pointSize' is set is always returned when it+-- is queried. Clamping and rounding for aliased and antialiased points have no+-- effect on the specified value.+--+-- A non-antialiased point size may be clamped to an implementation-dependent+-- maximum. Although this maximum cannot be queried, it must be no less than the+-- maximum value for antialiased points, rounded to the nearest integer value.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if+-- 'pointSize' is set to a value less than or equal to zero.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if+-- 'pointSize' is set during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.++pointSize :: StateVar GLfloat+pointSize = makeStateVar (getFloat1 id GetPointSize) glPointSize++--------------------------------------------------------------------------------++vertexProgramPointSize :: StateVar Capability+vertexProgramPointSize = makeCapability CapVertexProgramPointSize++--------------------------------------------------------------------------------++-- | The range to which the derived point size is clamped, see 'pointSize'. Note+-- that the size is further clamped to the implementation-dependent limits, see+-- 'aliasedPointSizeRange' and 'smoothPointSizeRange'. The initial range is+-- (0, 1).+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the+-- lower or upper bound of the range is set to a value less than zero. If the+-- lower bound is greater than the upper bound, the point size after clamping is+-- undefined, but no error is generated.++pointSizeRange :: StateVar (GLfloat, GLfloat)+pointSizeRange =+   makeStateVar+   (liftM2 (,) (getFloat1 id GetPointSizeMin) (getFloat1 id GetPointSizeMax))+   (\(sizeMin, sizeMax) -> do pointParameterf PointSizeMin sizeMin+                              pointParameterf PointSizeMax sizeMax)++--------------------------------------------------------------------------------++-- | The  constant, linear, and quadratic distance attenuation coefficients, see+-- 'pointSize'. The initial coefficients are (1, 0, 0).++pointDistanceAttenuation :: StateVar (GLfloat, GLfloat, GLfloat)+pointDistanceAttenuation =+   makeStateVar+      (getFloat3 (,,) GetPointDistanceAttenuation)+      (\(a, b, c) -> withArray [a, b, c] $+                        pointParameterfv PointDistanceAttenuation)++--------------------------------------------------------------------------------++-- | The threshold for alpha attenuation of points when multisampling is used,+-- see 'pointSize'. The initial threshold is 1.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the+-- threshold is set to a value less than zero.++pointFadeThresholdSize :: StateVar GLfloat+pointFadeThresholdSize =+   makeStateVar+      (getFloat1 id GetPointFadeThresholdSize)+      (pointParameterf PointFadeThresholdSize)++--------------------------------------------------------------------------------++-- | Controls whether point antialiasing is enabled. The initial state is+-- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.++pointSmooth :: StateVar Capability+pointSmooth = makeCapability CapPointSmooth++--------------------------------------------------------------------------------++-- | Controls whether point sprites are enabled. The initial state is+-- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'. When point sprites are+-- enabled, the state of point antialiasing (i.e. 'pointSmooth') is ignored.++pointSprite :: StateVar Capability+pointSprite = makeCapability CapPointSprite++--------------------------------------------------------------------------------++-- | The smallest and largest supported size of aliased points.++aliasedPointSizeRange :: GettableStateVar (GLfloat, GLfloat)+aliasedPointSizeRange =+   makeGettableStateVar $ getFloat2 (,) GetAliasedPointSizeRange++-- | The smallest and largest supported size of antialiased points.++smoothPointSizeRange :: GettableStateVar (GLfloat, GLfloat)+smoothPointSizeRange =+   makeGettableStateVar $ getFloat2 (,) GetSmoothPointSizeRange++-- | The antialiased point size granularity, i.e. the size difference between+-- supported sizes.++smoothPointSizeGranularity :: GettableStateVar GLfloat+smoothPointSizeGranularity =+   makeGettableStateVar $ getFloat1 id GetSmoothPointSizeGranularity
+ src/Graphics/Rendering/OpenGL/GL/PolygonMode.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PolygonMode+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling PolygonMode.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PolygonMode (+   PolygonMode(..), marshalPolygonMode, unmarshalPolygonMode+) where++import Graphics.GL++--------------------------------------------------------------------------------++data PolygonMode =+     Point+   | Line+   | Fill+   deriving ( Eq, Ord, Show )++marshalPolygonMode :: PolygonMode -> GLenum+marshalPolygonMode x = case x of+   Point -> GL_POINT+   Line -> GL_LINE+   Fill -> GL_FILL++unmarshalPolygonMode :: GLenum -> PolygonMode+unmarshalPolygonMode x+   | x == GL_POINT = Point+   | x == GL_LINE = Line+   | x == GL_FILL = Fill+   | otherwise = error ("unmarshalPolygonMode: illegal value " ++ show x)
+ src/Graphics/Rendering/OpenGL/GL/Polygons.hs view
@@ -0,0 +1,139 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Polygons+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.5 (Polygons) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Polygons (+   polygonSmooth, cullFace,+   PolygonStipple(..), GLpolygonstipple, polygonStipple,+   PolygonMode(..), polygonMode, polygonOffset,+   polygonOffsetPoint, polygonOffsetLine, polygonOffsetFill+) where++import Control.Monad+import Data.StateVar+import Foreign.ForeignPtr+import Foreign.Marshal.Array+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Face+import Graphics.Rendering.OpenGL.GL.PixelRectangles+import Graphics.Rendering.OpenGL.GL.PolygonMode+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.SavingState+import Graphics.GL++--------------------------------------------------------------------------------++polygonSmooth :: StateVar Capability+polygonSmooth = makeCapability CapPolygonSmooth++--------------------------------------------------------------------------------++cullFace :: StateVar (Maybe Face)+cullFace = makeStateVarMaybe (return CapCullFace)+                             (getEnum1 unmarshalFace GetCullFaceMode)+                             (glCullFace . marshalFace)++--------------------------------------------------------------------------------++numPolygonStippleBytes :: Int+numPolygonStippleBytes = 128   -- 32x32 bits divided into GLubytes++class PolygonStipple s where+   withNewPolygonStipple :: (Ptr GLubyte -> IO ()) -> IO s+   withPolygonStipple :: s -> (Ptr GLubyte -> IO a) -> IO a+   newPolygonStipple :: [GLubyte] -> IO s+   getPolygonStippleComponents :: s -> IO [GLubyte]++   withNewPolygonStipple act =+      allocaArray numPolygonStippleBytes $ \p -> do+         act p+         components <- peekArray numPolygonStippleBytes p+         newPolygonStipple components++   withPolygonStipple s act = do+      components <- getPolygonStippleComponents s+      withArray components act++   newPolygonStipple components =+      withNewPolygonStipple $+         flip pokeArray (take numPolygonStippleBytes components)++   getPolygonStippleComponents s =+      withPolygonStipple s $ peekArray numPolygonStippleBytes++--------------------------------------------------------------------------------++data GLpolygonstipple = GLpolygonstipple (ForeignPtr GLubyte)+   deriving ( Eq, Ord, Show )++instance PolygonStipple GLpolygonstipple where+   withNewPolygonStipple f = do+      fp <- mallocForeignPtrArray numPolygonStippleBytes+      withForeignPtr fp f+      return $ GLpolygonstipple fp++   withPolygonStipple (GLpolygonstipple fp) = withForeignPtr fp++--------------------------------------------------------------------------------++polygonStipple :: PolygonStipple s => StateVar (Maybe s)+polygonStipple =+   makeStateVarMaybe (return CapPolygonStipple)+      (withoutGaps Pack $ withNewPolygonStipple glGetPolygonStipple)+      (\s -> withoutGaps Unpack $ withPolygonStipple s glPolygonStipple)++-- Note: No need to set rowAlignment, our memory allocator always returns a+-- region which is at least 8-byte aligned (the maximum)+withoutGaps :: PixelStoreDirection -> IO a -> IO a+withoutGaps direction action =+   preservingClientAttrib [ PixelStoreAttributes ] $ do+      rowLength  direction $= 0+      skipRows   direction $= 0+      skipPixels direction $= 0+      action++--------------------------------------------------------------------------------++polygonMode :: StateVar (PolygonMode, PolygonMode)+polygonMode = makeStateVar getPolygonMode setPolygonMode++getPolygonMode :: IO (PolygonMode, PolygonMode)+getPolygonMode = getInteger2 (\front back -> (un front, un back)) GetPolygonMode+   where un = unmarshalPolygonMode . fromIntegral++setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()+setPolygonMode (front, back)+   -- OpenGL 3 deprecated separate polygon draw modes, so try to avoid them.+   | front == back = setPM FrontAndBack front+   | otherwise = do setPM Front front; setPM Back back+   where setPM f m = glPolygonMode (marshalFace f) (marshalPolygonMode m)++--------------------------------------------------------------------------------++polygonOffset :: StateVar (GLfloat, GLfloat)+polygonOffset =+   makeStateVar (liftM2 (,) (getFloat1 id GetPolygonOffsetFactor)+                            (getFloat1 id GetPolygonOffsetUnits))+                (uncurry glPolygonOffset)++--------------------------------------------------------------------------------++polygonOffsetPoint :: StateVar Capability+polygonOffsetPoint = makeCapability CapPolygonOffsetPoint++polygonOffsetLine :: StateVar Capability+polygonOffsetLine = makeCapability CapPolygonOffsetLine++polygonOffsetFill :: StateVar Capability+polygonOffsetFill = makeCapability CapPolygonOffsetFill
+ src/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs view
@@ -0,0 +1,123 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PrimitiveMode+-- Copyright   :  (c) Sven Panne 2002-2019, Tobias Markus 2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 10.1 (Primitive Types) of the OpenGL 4.4+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PrimitiveMode (+   -- * Primitive Modes+   PrimitiveMode(..),+   -- * Patches (Tessellation)+   patchVertices, maxPatchVertices,+   patchDefaultOuterLevel, patchDefaultInnerLevel, maxTessGenLevel+) where++import Data.StateVar+import Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils.PName+import Graphics.GL++--------------------------------------------------------------------------------++-- | Specification of the way the vertices given during 'renderPrimitive' are+-- interpreted. In the description of the constructors, /n/ is an integer count+-- starting at one, and /N/ is the total number of vertices specified.++data PrimitiveMode =+     Points+     -- ^ Treats each vertex as a single point. Vertex /n/ defines point /n/.+     -- /N/ points are drawn.+   | Lines+     -- ^ Treats each pair of vertices as an independent line segment. Vertices+     -- 2/n/-1 and 2/n/ define line /n/. /N/\/2 lines are drawn.+   | LineLoop+     -- ^ Draws a connected group of line segments from the first vertex to the+     -- last, then back to the first. Vertices /n/ and /n/+1 define line /n/.+     -- The last line, however, is defined by vertices /N/ and 1. /N/ lines+     -- are drawn.+   | LineStrip+     -- ^ Draws a connected group of line  segments from the first vertex to the+     -- last. Vertices /n/ and /n/+1 define line /n/. /N/-1 lines are drawn.+   | Triangles+     -- ^ Treats each triplet of vertices as an independent triangle. Vertices+     -- /3n-2/, /3n-1/, and /3n/ define triangle /n/. /N\/3/ triangles are drawn.+   | TriangleStrip+     -- ^ Draws a connected group of triangles. One triangle is defined for each+     -- vertex presented after the first two vertices. For odd /n/, vertices+     -- /n/, /n/+1, and /n/+2 define triangle /n/. For even /n/, vertices /n/+1,+     -- /n/, and /n/+2 define triangle /n/. /N/-2 triangles are drawn.+   | TriangleFan+     -- ^ Draws a connected group of triangles. One triangle is defined for each+     -- vertex presented after the first two vertices. Vertices 1, /n/+1, and+     -- /n/+2 define triangle /n/. /N/-2 triangles are drawn.+   | Quads+     -- ^ Treats each group of four vertices as an independent quadrilateral.+     -- Vertices 4/n/-3, 4/n/-2, 4/n/-1, and 4/n/ define quadrilateral /n/.+     -- /N/\/4 quadrilaterals are drawn.+   | QuadStrip+     -- ^ Draws a connected group of quadrilaterals. One quadrilateral is+     --defined for each pair of vertices presented after the first pair.+     -- Vertices 2/n/-1, 2/n/, 2/n/+2, and 2/n/+1 define quadrilateral /n/.+     -- /N/\/2-1 quadrilaterals are drawn. Note that the order in which vertices+     -- are used to construct a quadrilateral from strip data is different from+     -- that used with independent data.+   | Polygon+     -- ^ Draws a single, convex polygon. Vertices 1 through /N/ define this+     -- polygon.+   | Patches+     -- ^ Only used in conjunction with tessellation. The number of vertices per+     -- patch can be set with 'patchVertices'.+   deriving ( Eq, Ord, Show )++-- | 'patchVertices' is the number of vertices per patch primitive.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if+-- 'patchVertices' is set to a value less than or equal to zero or greater+-- than the implementation-dependent maximum value 'maxPatchVertices'.++patchVertices :: StateVar GLsizei+patchVertices =+  makeStateVar (getSizei1 id GetPatchVertices)+               (glPatchParameteri GL_PATCH_VERTICES . fromIntegral)++-- | Contains the maximumum number of vertices in a single patch.++maxPatchVertices :: GettableStateVar GLsizei+maxPatchVertices = makeGettableStateVar $ getSizei1 id GetMaxPatchVertices++-- | Contains the four default outer tessellation levels to be used when no+-- tessellation control shader is present.++patchDefaultOuterLevel :: StateVar (GLfloat, GLfloat, GLfloat, GLfloat)+patchDefaultOuterLevel =+  makeStateVar+    (getFloat4 (,,,) GetPatchDefaultOuterLevel)+    (\(l0, l1, l2, l3) -> allocaArray 4 $ \ptr -> do+                            poke4 ptr l0 l1 l2 l3+                            glPatchParameterfv GL_PATCH_DEFAULT_OUTER_LEVEL ptr)++-- | Contains the two default inner tessellation levels to be used when no+-- tessellation control shader is present.++patchDefaultInnerLevel :: StateVar (GLfloat, GLfloat)+patchDefaultInnerLevel =+  makeStateVar+    (getFloat2 (,) GetPatchDefaultInnerLevel)+    (\(l0, l1) -> allocaArray 2 $ \ptr -> do+                    poke2 ptr l0 l1+                    glPatchParameterfv GL_PATCH_DEFAULT_INNER_LEVEL ptr)++-- | Contains the maximum allowed tessellation level.++maxTessGenLevel :: GettableStateVar GLsizei+maxTessGenLevel = makeGettableStateVar $ getSizei1 id GetMaxTessGenLevel
+ src/Graphics/Rendering/OpenGL/GL/PrimitiveModeInternal.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling PrimitiveMode.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal (+   marshalPrimitiveMode, unmarshalPrimitiveMode+) where++import Graphics.GL+import Graphics.Rendering.OpenGL.GL.PrimitiveMode++--------------------------------------------------------------------------------++marshalPrimitiveMode :: PrimitiveMode -> GLenum+marshalPrimitiveMode x = case x of+   Points -> GL_POINTS+   Lines -> GL_LINES+   LineLoop -> GL_LINE_LOOP+   LineStrip -> GL_LINE_STRIP+   Triangles -> GL_TRIANGLES+   TriangleStrip -> GL_TRIANGLE_STRIP+   TriangleFan -> GL_TRIANGLE_FAN+   Quads -> GL_QUADS+   QuadStrip -> GL_QUAD_STRIP+   Polygon -> GL_POLYGON+   Patches -> GL_PATCHES++unmarshalPrimitiveMode :: GLenum -> PrimitiveMode+unmarshalPrimitiveMode x+   | x == GL_POINTS = Points+   | x == GL_LINES = Lines+   | x == GL_LINE_LOOP = LineLoop+   | x == GL_LINE_STRIP = LineStrip+   | x == GL_TRIANGLES = Triangles+   | x == GL_TRIANGLE_STRIP = TriangleStrip+   | x == GL_TRIANGLE_FAN = TriangleFan+   | x == GL_QUADS = Quads+   | x == GL_QUAD_STRIP = QuadStrip+   | x == GL_POLYGON = Polygon+   | x == GL_PATCHES = Patches+   | otherwise = error ("unmarshalPrimitiveMode: illegal value " ++ show x)
+ src/Graphics/Rendering/OpenGL/GL/QueryObject.hs view
@@ -0,0 +1,52 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryObject+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling QueryObjects.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.QueryObject (+   QueryObject(..), noQueryObject+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++newtype QueryObject = QueryObject { queryID :: GLuint }+   deriving ( Eq, Ord, Show )++noQueryObject :: QueryObject+noQueryObject = QueryObject 0++--------------------------------------------------------------------------------++instance ObjectName QueryObject where+   isObjectName = liftIO . fmap unmarshalGLboolean . glIsQuery . queryID++   deleteObjectNames queryObjects =+      liftIO . withArrayLen (map queryID queryObjects) $+         glDeleteQueries . fromIntegral++instance GeneratableObjectName QueryObject where+   genObjectNames n =+      liftIO . allocaArray n $ \buf -> do+        glGenQueries (fromIntegral n) buf+        fmap (map QueryObject) $ peekArray n buf++instance CanBeLabeled QueryObject where+   objectLabel = objectNameLabel GL_QUERY . queryID
+ src/Graphics/Rendering/OpenGL/GL/QueryObjects.hs view
@@ -0,0 +1,175 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryObjects+-- Copyright   :  (c) Sven Panne 2004-2019, Lars Corbijn 2004-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 4.2 (Query Objects and Asynchronous+-- Queries) of the OpenGL 4.4 specs.+--+-----------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++module Graphics.Rendering.OpenGL.GL.QueryObjects (+   -- * Creating and Delimiting Queries+   QueryObject, QueryIndex, maxVertexStreams, QueryTarget(..),+   beginQuery, endQuery, withQuery,++   -- * Query Target Queries+   currentQuery, queryCounterBits,++   -- * Query Object Queries+   queryResultAvailable, QueryResult, queryResult,++   -- * Time Queries+   timestampQuery, timestamp+) where++import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryObject+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++type QueryIndex = GLuint++maxVertexStreams :: GettableStateVar QueryIndex+maxVertexStreams =+   makeGettableStateVar (getInteger1 fromIntegral GetMaxVertexStreams)++--------------------------------------------------------------------------------++data QueryTarget =+     SamplesPassed+   | AnySamplesPassed+   | AnySamplesPassedConservative+   | TimeElapsed+   | PrimitivesGenerated QueryIndex+   | TransformFeedbackPrimitivesWritten QueryIndex+   deriving ( Eq, Ord, Show )++marshalQueryTarget :: QueryTarget -> (GLenum, QueryIndex)+marshalQueryTarget x = case x of+   SamplesPassed -> (GL_SAMPLES_PASSED, 0)+   AnySamplesPassed -> (GL_ANY_SAMPLES_PASSED, 0)+   AnySamplesPassedConservative -> (GL_ANY_SAMPLES_PASSED_CONSERVATIVE, 0)+   TimeElapsed -> (GL_TIME_ELAPSED, 0)+   PrimitivesGenerated n -> (GL_PRIMITIVES_GENERATED, n)+   TransformFeedbackPrimitivesWritten n ->+      (GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN, n)++--------------------------------------------------------------------------------++beginQuery :: QueryTarget -> QueryObject -> IO ()+beginQuery target = case marshalQueryTarget target of+   (t, 0) -> glBeginQuery t . queryID+   (t, n) -> glBeginQueryIndexed t n . queryID++endQuery :: QueryTarget -> IO ()+endQuery target = case marshalQueryTarget target of+   (t, 0) -> glEndQuery t+   (t, n) -> glEndQueryIndexed t n++-- | Convenience function for an exception-safe combination of 'beginQuery' and+-- 'endQuery'.+withQuery :: QueryTarget -> QueryObject -> IO a -> IO a+withQuery t q = bracket_ (beginQuery t q) (endQuery t)++--------------------------------------------------------------------------------++data GetQueryPName =+     QueryCounterBits+   | CurrentQuery++marshalGetQueryPName :: GetQueryPName -> GLenum+marshalGetQueryPName x = case x of+   QueryCounterBits -> GL_QUERY_COUNTER_BITS+   CurrentQuery -> GL_CURRENT_QUERY++--------------------------------------------------------------------------------++currentQuery :: QueryTarget -> GettableStateVar (Maybe QueryObject)+currentQuery = getQueryi (toMaybeQueryObject . toQueryObject) CurrentQuery+   where toQueryObject = QueryObject . fromIntegral+         toMaybeQueryObject q = if q == noQueryObject then Nothing else Just q++queryCounterBits :: QueryTarget -> GettableStateVar GLsizei+queryCounterBits = getQueryi fromIntegral QueryCounterBits++getQueryi :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a+getQueryi f p t =+   makeGettableStateVar $+      with 0 $ \buf -> do+         getQueryiv' t p buf+         peek1 f buf++getQueryiv' :: QueryTarget -> GetQueryPName -> Ptr GLint -> IO ()+getQueryiv' target = case marshalQueryTarget target of+   (t, 0) -> glGetQueryiv t . marshalGetQueryPName+   (t, n) -> glGetQueryIndexediv t n . marshalGetQueryPName++--------------------------------------------------------------------------------++data GetQueryObjectPName =+     QueryResultAvailable+   | QueryResult++marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum+marshalGetQueryObjectPName x = case x of+   QueryResultAvailable -> GL_QUERY_RESULT_AVAILABLE+   QueryResult -> GL_QUERY_RESULT++--------------------------------------------------------------------------------++queryResultAvailable :: QueryObject -> GettableStateVar Bool+queryResultAvailable =+   getQueryObject (unmarshalGLboolean :: GLuint -> Bool) QueryResultAvailable++queryResult :: QueryResult a => QueryObject -> GettableStateVar a+queryResult = getQueryObject id QueryResult++class Storable a => QueryResult a where+   getQueryObjectv :: GLuint -> GLenum -> Ptr a -> IO ()++instance QueryResult GLint where getQueryObjectv = glGetQueryObjectiv+instance QueryResult GLuint where getQueryObjectv = glGetQueryObjectuiv+instance QueryResult GLint64 where getQueryObjectv = glGetQueryObjecti64v+instance QueryResult GLuint64 where getQueryObjectv = glGetQueryObjectui64v++getQueryObject :: (QueryResult a)+               => (a -> b)+               -> GetQueryObjectPName+               -> QueryObject+               -> GettableStateVar b+getQueryObject f p q =+   makeGettableStateVar $+      alloca $ \buf -> do+         getQueryObjectv (queryID q) (marshalGetQueryObjectPName p) buf+         peek1 f buf++--------------------------------------------------------------------------------++-- | Record the time after all previous commands on the GL client and server+-- state and the framebuffer have been fully realized++timestampQuery :: QueryObject -> IO ()+timestampQuery q = glQueryCounter (queryID q) GL_TIMESTAMP++-- | Contains the GL time after all previous commands have reached the GL server+-- but have not yet necessarily executed.++timestamp :: GettableStateVar GLuint64+timestamp = makeGettableStateVar (getInteger64 fromIntegral GetTimestamp)
+ src/Graphics/Rendering/OpenGL/GL/QueryUtils.hs view
@@ -0,0 +1,106 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module with utilities to query OpenGL state.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.QueryUtils (+   module Graphics.Rendering.OpenGL.GL.QueryUtils.PName,+   module Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib,++   lightIndexToEnum,+   modelviewIndexToEnum, modelviewEnumToIndex,++   maybeNullPtr,++   objectNameLabel, objectPtrLabel, maxLabelLength+) where++import Data.StateVar+import Foreign.C.String ( peekCStringLen, withCStringLen )+import Foreign.Ptr ( Ptr, nullPtr )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( allocaArray )+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils.PName+import Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib+import Graphics.GL++--------------------------------------------------------------------------------++-- 0x4000 through 0x4FFF are reserved for light numbers++lightIndexToEnum :: GLsizei -> Maybe GLenum+lightIndexToEnum i+   | 0 <= i && i <= maxLightIndex = Just (GL_LIGHT0 + fromIntegral i)+   | otherwise = Nothing++maxLightIndex :: GLsizei+maxLightIndex = 0xFFF++--------------------------------------------------------------------------------++-- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices++modelviewIndexToEnum :: GLsizei -> Maybe GLenum+modelviewIndexToEnum 0 = Just GL_MODELVIEW+modelviewIndexToEnum 1 = Just GL_MODELVIEW1_ARB+modelviewIndexToEnum i+   | 2 <= i && i <= 31 = Just (GL_MODELVIEW2_ARB - 2 + fromIntegral i)+   | otherwise = Nothing++modelviewEnumToIndex :: GLenum -> Maybe GLsizei+modelviewEnumToIndex x+   | x == GL_MODELVIEW = Just 0+   | x == GL_MODELVIEW1_ARB = Just 1+   | GL_MODELVIEW2_ARB <= x && x <= GL_MODELVIEW31_ARB = Just (fromIntegral (x - (GL_MODELVIEW2_ARB - 2)))+   | otherwise = Nothing++--------------------------------------------------------------------------------++maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b+maybeNullPtr n f ptr | ptr == nullPtr = n+                     | otherwise      = f ptr++--------------------------------------------------------------------------------++objectNameLabel :: GLuint -> GLenum -> StateVar (Maybe String)+objectNameLabel name ident =+ makeStateVar+   (getObjectLabelWith (glGetObjectLabel ident name))+   (setObjectLabelWith (glObjectLabel ident name))++objectPtrLabel :: Ptr () -> StateVar (Maybe String)+objectPtrLabel ptr =+  makeStateVar+    (getObjectLabelWith (glGetObjectPtrLabel ptr))+    (setObjectLabelWith (glObjectPtrLabel ptr))++getObjectLabelWith :: (GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())+                   -> IO (Maybe String)+getObjectLabelWith getLabel = do+  maxLen <- get maxLabelLength+  alloca $ \lenBuf ->+    allocaArray (fromIntegral maxLen) $ \labelBuf -> do+      getLabel maxLen lenBuf labelBuf+      actualLen <- peek1 fromIntegral lenBuf+      label <- peekCStringLen (labelBuf, actualLen)+      return $ if label == "" then Nothing else Just label++setObjectLabelWith :: (GLsizei -> Ptr GLchar -> IO ()) -> Maybe String -> IO ()+setObjectLabelWith setLabel =+  maybe (set (nullPtr, (0 :: Int))) (flip withCStringLen set)+  where set (labelBuf, len) = setLabel (fromIntegral len) labelBuf++maxLabelLength :: GettableStateVar GLsizei+maxLabelLength =+  makeGettableStateVar (getSizei1 id GetMaxLabelLength)
+ src/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs view
@@ -0,0 +1,1278 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils.PName+-- Copyright   :  (c) Sven Panne 2002-2019, Lars Corbijn 2013+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.QueryUtils.PName (+    GetPName(..),+    GetPName1I(..), GetPName1F(..), GetIPName1I(..),+    GetPName2I(..), GetPName2F(..),+    GetPName3I(..), GetPName3F(..),+    GetPName4I(..), GetPName4F(..), GetIPName4I(..),+    GetPNameNI(..),++    PName1I(..), PName1F(..), IPName1I(..),+    PName2I(..), PName2F(..),+    PName3F(..),+    PName4I(..), PName4F(..), PName4ISemiIndexed(..),+    PNameNI(..),++    GetPNameMatrix(..),+    PNameMatrix(..),++    clipPlaneIndexToEnum,++    GetPointervPName(..), getPointer+) where++import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( allocaArray, peekArray )+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( Ptr, nullPtr, castPtr )+import Foreign.Storable ( Storable(peek) )+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++-----------------------------------------------------------------------------++class GetPName p where+    marshalGetPName :: p -> Maybe GLenum++-----------------------------------------------------------------------------++getBooleanv :: GetPName p => p-> Ptr GLboolean -> IO ()+getBooleanv = makeGetter glGetBooleanv++getIntegerv :: GetPName p => p -> Ptr GLint -> IO ()+getIntegerv = makeGetter glGetIntegerv++getInteger64v :: GetPName p => p -> Ptr GLint64 -> IO ()+getInteger64v = makeGetter glGetInteger64v++getFloatv :: GetPName p => p -> Ptr GLfloat -> IO ()+getFloatv = makeGetter glGetFloatv++getDoublev :: GetPName p => p -> Ptr GLdouble -> IO ()+getDoublev = makeGetter glGetDoublev++-----------------------------------------------------------------------------++getBooleaniv :: GetPName p => p -> GLuint -> Ptr GLboolean -> IO ()+getBooleaniv p i = makeGetter (\e -> glGetBooleani_v e i) p++getIntegeriv :: GetPName p => p -> GLuint -> Ptr GLint -> IO ()+getIntegeriv p i =  makeGetter (\e -> glGetIntegeri_v e i) p++getInteger64iv :: GetPName p => p -> GLuint -> Ptr GLint64 -> IO ()+getInteger64iv p i =  makeGetter (\e -> glGetInteger64i_v e i) p++-----------------------------------------------------------------------------++{-# INLINE makeGetter #-}+makeGetter :: GetPName p => (GLenum -> Ptr a -> IO ()) -> p -> Ptr a -> IO ()+makeGetter f = maybe (const recordInvalidEnum) f . marshalGetPName++-----------------------------------------------------------------------------++class GetPName p => GetPName1I p where+    getBoolean1 :: (GLboolean -> a) -> p -> IO a+    getBoolean1 = get1 getBooleanv++    getInteger1 :: (GLint -> a) -> p -> IO a+    getInteger1 = get1 getIntegerv++    getEnum1 :: (GLenum -> a) -> p -> IO a+    getEnum1 = get1 getIntegerv++    getSizei1 :: (GLsizei -> a) -> p -> IO a+    getSizei1 = get1 getIntegerv++    getInteger64 :: (GLint64 -> a) -> p -> IO a+    getInteger64 = get1 getInteger64v++class GetPName p => GetPName1F p where+    getFloat1 :: (GLfloat -> a) -> p -> IO a+    getFloat1 = get1 getFloatv++    getClampf1 :: (GLclampf -> a) -> p -> IO a+    getClampf1 = get1 getFloatv++    getDouble1 :: (GLdouble -> a) -> p -> IO a+    getDouble1 = get1 getDoublev++    getClampd1 :: (GLclampd -> a) -> p -> IO a+    getClampd1 = get1 getDoublev++-- | Helper function for the get*1 functions.+get1 :: (Storable b, Storable c)+    => (p -> Ptr c -> IO ())+    -> (b -> a) -- ^ Conversion from the casted value to the return value+    -> p -> IO a+get1 g f n = alloca $ \buf -> do+    g n buf+    peek1 f (castPtr buf)++class GetPName p => GetIPName1I p where+    getBoolean1i :: (GLboolean -> a) -> p -> GLuint -> IO a+    getBoolean1i = get1i getBooleaniv++    getInteger1i :: (GLint -> a) -> p -> GLuint -> IO a+    getInteger1i = get1i getIntegeriv++    getEnum1i :: (GLenum -> a) -> p -> GLuint -> IO a+    getEnum1i = get1i getIntegeriv++    getSizei1i :: (GLsizei -> a) -> p -> GLuint -> IO a+    getSizei1i = get1i getIntegeriv++    getInteger641i :: (GLint64 -> a) -> p -> GLuint -> IO a+    getInteger641i = get1i getInteger64iv++-- Indexed helper+get1i :: (Storable b, Storable c)+    => (p -> GLuint -> Ptr c -> IO ())+    -> (b -> a) -- ^ Conversion from the casted value to the return value+    -> p -> GLuint -> IO a+get1i g f n i = alloca $ \buf -> do+    g n i buf+    peek1 f (castPtr buf)++-----------------------------------------------------------------------------++class GetPName p => GetPName2I p where+    getBoolean2 :: (GLboolean -> GLboolean -> a) -> p -> IO a+    getBoolean2 = get2 getBooleanv++    getInteger2 :: (GLint -> GLint -> a) -> p -> IO a+    getInteger2 = get2 getIntegerv++    getEnum2 :: (GLenum -> GLenum -> a) -> p -> IO a+    getEnum2 = get2 getIntegerv++    getSizei2 :: (GLsizei -> GLsizei -> a) -> p -> IO a+    getSizei2 = get2 getIntegerv++class GetPName p => GetPName2F p where+    getFloat2 :: (GLfloat -> GLfloat -> a) -> p -> IO a+    getFloat2 = get2 getFloatv++    getClampf2 :: (GLclampf -> GLclampf -> a) -> p -> IO a+    getClampf2 = get2 getFloatv++    getDouble2 :: (GLdouble -> GLdouble -> a) -> p -> IO a+    getDouble2 = get2 getDoublev++    getClampd2 :: (GLclampd -> GLclampd -> a) -> p -> IO a+    getClampd2 = get2 getDoublev++-- | Helper function for the get*2 functions.+get2 :: (Storable b, Storable c)+    => (p -> Ptr c -> IO ())+    -> (b -> b -> a) -- ^ Conversion from the casted value to the return value+    -> p -> IO a+get2 g f n = allocaArray 2 $ \buf -> do+    g n buf+    peek2 f (castPtr buf)++-----------------------------------------------------------------------------++class GetPName p => GetPName3I p where+    getBoolean3 :: (GLboolean -> GLboolean -> GLboolean -> a) -> p -> IO a+    getBoolean3 = get3 getBooleanv++    getInteger3 :: (GLint -> GLint -> GLint -> a) -> p -> IO a+    getInteger3 = get3 getIntegerv++    getEnum3 :: (GLenum -> GLenum -> GLenum -> a) -> p -> IO a+    getEnum3 = get3 getIntegerv++    getSizei3 :: (GLsizei -> GLsizei -> GLsizei -> a) -> p -> IO a+    getSizei3 = get3 getIntegerv++class GetPName p => GetPName3F p where+    getFloat3 :: (GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a+    getFloat3 = get3 getFloatv++    getClampf3 :: (GLclampf -> GLclampf -> GLclampf -> a) -> p -> IO a+    getClampf3 = get3 getFloatv++    getDouble3 :: (GLdouble -> GLdouble -> GLdouble -> a) -> p -> IO a+    getDouble3 = get3 getDoublev++    getClampd3 :: (GLclampd -> GLclampd -> GLclampd -> a) -> p -> IO a+    getClampd3 = get3 getDoublev++-- | Helper function for the get*3 functions.+get3 :: (Storable b, Storable c)+    => (p -> Ptr c -> IO ())+    -> (b -> b -> b -> a) -- ^ Conversion from the casted value to the return value+    -> p -> IO a+get3 g f n = allocaArray 3 $ \buf -> do+    g n buf+    peek3 f (castPtr buf)++-----------------------------------------------------------------------------++class GetPName p => GetPName4I p where+    getBoolean4 :: (GLboolean -> GLboolean -> GLboolean -> GLboolean -> a) -> p -> IO a+    getBoolean4 = get4 getBooleanv++    getInteger4 :: (GLint -> GLint -> GLint -> GLint -> a) -> p -> IO a+    getInteger4 = get4 getIntegerv++    getEnum4 :: (GLenum -> GLenum -> GLenum -> GLenum -> a) -> p -> IO a+    getEnum4 = get4 getIntegerv++    getSizei4 :: (GLsizei -> GLsizei -> GLsizei -> GLsizei -> a) -> p -> IO a+    getSizei4 = get4 getIntegerv++class GetPName p => GetPName4F p where+    getFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> a) -> p -> IO a+    getFloat4 = get4 getFloatv++    getClampf4 :: (GLclampf -> GLclampf -> GLclampf -> GLclampf -> a) -> p -> IO a+    getClampf4 = get4 getFloatv++    getDouble4 :: (GLdouble -> GLdouble -> GLdouble -> GLdouble -> a) -> p -> IO a+    getDouble4 = get4 getDoublev++    getClampd4 :: (GLclampd -> GLclampd -> GLclampd -> GLclampd -> a) -> p -> IO a+    getClampd4 = get4 getDoublev++-- | Helper function for the get*4 functions.+get4 :: (Storable b, Storable c)+    => (p -> Ptr c -> IO ())+    -> (b -> b -> b -> b -> a) -- ^ Conversion from the casted value to the return value+    -> p -> IO a+get4 g f n = allocaArray 4 $ \buf -> do+    g n buf+    peek4 f (castPtr buf)++class GetPName p => GetIPName4I p where+    getBoolean4i :: (GLboolean -> GLboolean -> GLboolean -> GLboolean -> a) -> p -> GLuint -> IO a+    getBoolean4i = get4i getBooleaniv++    getInteger4i :: (GLint -> GLint -> GLint -> GLint -> a) -> p -> GLuint -> IO a+    getInteger4i = get4i getIntegeriv++    getEnum4i :: (GLenum -> GLenum -> GLenum -> GLenum -> a) -> p -> GLuint -> IO a+    getEnum4i = get4i getIntegeriv++    getSizei4i :: (GLsizei -> GLsizei -> GLsizei -> GLsizei -> a) -> p -> GLuint -> IO a+    getSizei4i = get4i getIntegeriv++-- | Helper function for the get*4 functions.+get4i :: (Storable b, Storable c)+    => (p -> GLuint -> Ptr c -> IO ())+    -> (b -> b -> b -> b -> a) -- ^ Conversion from the casted value to the return value+    -> p -> GLuint -> IO a+get4i g f n i = allocaArray 4 $ \buf -> do+    g n i buf+    peek4 f (castPtr buf)++class GetPName p => GetPNameNI p where+   getEnumN :: (GLenum -> a) -> p -> Int -> IO [a]+   getEnumN f p n =+      allocaArray n $ \buf -> do+         getIntegerv p buf+         (map (f . fromIntegral)) `fmap` peekArray n buf++-----------------------------------------------------------------------------++class GetPName p => GetPNameMatrix p where+    getMatrixf :: p -> Ptr GLfloat -> IO ()+    getMatrixf = getFloatv+    getMatrixd :: p -> Ptr GLdouble -> IO ()+    getMatrixd = getDoublev++-----------------------------------------------------------------------------++data PName1I+    = GetEdgeFlag           -- ^ bool+    | GetRGBAMode           -- ^ enum+    | GetCurrentIndex       -- ^ int+    | GetMaxTextureUnits    -- ^ enum+    -- displaylist+    | GetListIndex          -- ^ enum+    | GetListMode           -- ^ enum+    | GetMaxListNesting     -- ^ sizei+    | GetListBase           -- ^ enum+    -- rendermode+    | GetRenderMode         -- ^ enum+    -- framebufferbinding+    | GetDrawFramebufferBinding -- ^ int+    | GetReadFramebufferBinding -- ^ int+    | GetFramebufferBinding     -- ^ int+    -- renderbufferbinding+    | GetRenderbufferBinding    -- ^ int+    -- hint+    | GetPerspectiveCorrectionHint -- ^ enum+    | GetPointSmoothHint        -- ^ enum+    | GetLineSmoothHint         -- ^ enum+    | GetPolygonSmoothHint      -- ^ enum+    | GetFogHint                -- ^ enum+    | GetGenerateMipmapHint     -- ^ enum+    | GetTextureCompressionHint -- ^ enum+    | GetPackCMYKHint           -- ^ enum+    | GetUnpackCMYKHint         -- ^ enum+    -- vertexarray+    | GetVertexArrayBinding     -- ^ int+    -- Selction?+    | GetMaxNameStackDepth      -- ^ int+    | GetNameStackDepth         -- ^ int+    -- ContextProfile+    | GetContextProfileMask     -- ^ enum+    -- pixelStorage+    | GetPackSwapBytes      -- ^ bool+    | GetUnpackSwapBytes    -- ^ bool+    | GetPackLSBFirst       -- ^ bool+    | GetUnpackLSBFirst     -- ^ bool+    | GetPackRowLength      -- ^ int+    | GetUnpackRowLength    -- ^ int+    | GetPackSkipRows       -- ^ int+    | GetUnpackSkipRows     -- ^ int+    | GetPackSkipPixels     -- ^ int+    | GetUnpackSkipPixels   -- ^ int+    | GetPackAlignment      -- ^ int+    | GetUnpackAlignment    -- ^ int+    | GetPackImageHeight    -- ^ int+    | GetUnpackImageHeight  -- ^ int+    | GetPackSkipImages     -- ^ int+    | GetUnpackSkipImages   -- ^ int+    -- pixel map+    | GetPixelMapIToISize   -- ^ int+    | GetPixelMapSToSSize   -- ^ int+    | GetPixelMapIToRSize   -- ^ int+    | GetPixelMapIToGSize   -- ^ int+    | GetPixelMapIToBSize   -- ^ int+    | GetPixelMapIToASize   -- ^ int+    | GetPixelMapRToRSize   -- ^ int+    | GetPixelMapGToGSize   -- ^ int+    | GetPixelMapBToBSize   -- ^ int+    | GetPixelMapAToASize   -- ^ int+    | GetMaxPixelMapTable   -- ^ sizei+    -- shader limits+    | GetMaxVertexTextureImageUnits     -- ^ sizei+    | GetMaxTextureImageUnits           -- ^ sizei+    | GetMaxCombinedTextureImageUnits   -- ^ sizei+    | GetMaxTextureCoords               -- ^ sizei+    | GetMaxVertexUniformComponents     -- ^ sizei+    | GetMaxFragmentUniformComponents   -- ^ sizei+    | GetMaxVertexAttribs               -- ^ sizei+    | GetMaxVaryingFloats               -- ^ sizei+    -- tessellation+    | GetPatchVertices                  -- ^ sizei+    | GetMaxPatchVertices               -- ^ sizei+    | GetMaxTessGenLevel                -- ^ sizei+    -- coordtrans+    | GetMatrixMode                 -- ^ enum+    | GetModelviewStackDepth        -- ^ sizei+    | GetProjectionStackDepth       -- ^ sizei+    | GetTextureStackDepth          -- ^ sizei+    | GetColorMatrixStackDepth      -- ^ sizei+    | GetMaxModelviewStackDepth     -- ^ sizei+    | GetMaxProjectionStackDepth    -- ^ sizei+    | GetMaxTextureStackDepth       -- ^ sizei+    | GetMaxColorMatrixStackDepth   -- ^ sizei+    | GetMaxMatrixPaletteStackDepth -- ^ sizei+    | GetCurrentMatrixStackDepth    -- ^ sizei+    | GetActiveTexture              -- ^ enum+    -- VertexArrays+    | GetVertexArraySize    -- ^ int+    | GetVertexArrayType    -- ^ enum+    | GetVertexArrayStride  -- ^ int+    | GetNormalArrayType    -- ^ enum+    | GetNormalArrayStride  -- ^ int+    | GetColorArraySize     -- ^ int+    | GetColorArrayType     -- ^ enum+    | GetColorArrayStride   -- ^ int+    | GetIndexArrayType     -- ^ enum+    | GetIndexArrayStride   -- ^ int+    | GetTextureCoordArraySize      -- ^ int+    | GetTextureCoordArrayType      -- ^ enum+    | GetTextureCoordArrayStride    -- ^ int+    | GetEdgeFlagArrayStride        -- ^ int+    | GetFogCoordArrayType          -- ^ enum+    | GetFogCoordArrayStride        -- ^ int+    | GetSecondaryColorArraySize    -- ^ int+    | GetSecondaryColorArrayType    -- ^ enum+    | GetSecondaryColorArrayStride  -- ^ int+    | GetArrayElementLockCount      -- ^ int+    | GetArrayElementLockFirst      -- ^ int+    | GetClientActiveTexture        -- ^ enum+    | GetMaxElementsVertices        -- ^ sizei+    | GetMaxElementsIndices         -- ^ sizei+    | GetPrimitiveRestartIndex      -- ^ int+    | GetPrimitiveRestartNV         -- ^ bool+    | GetPrimitiveRestartIndexNV    -- ^ int+    -- bufferObjects+    | GetArrayBufferBinding         -- ^ int+    | GetAtomicCounterBufferBinding -- ^ int+    | GetCopyReadBufferBinding      -- ^ int+    | GetCopyWriteBufferBinding     -- ^ int+    | GetDispatchIndirectBufferBinding -- ^ int+    | GetDrawIndirectBufferBinding  -- ^ int+    | GetElementArrayBufferBinding  -- ^ int+    | GetPixelPackBufferBinding     -- ^ int+    | GetPixelUnpackBufferBinding   -- ^ int+    | GetQueryBufferBinding         -- ^ int+    | GetShaderStorageBufferBinding -- ^ int+    | GetTransformFeedbackBufferBinding -- ^ int+    | GetUniformBufferBinding       -- ^ int++    | GetVertexArrayBufferBinding   -- ^ int+    | GetNormalArrayBufferBinding   -- ^ int+    | GetColorArrayBufferBinding    -- ^ int+    | GetIndexArrayBufferBinding    -- ^ int+    | GetTextureCoordArrayBufferBinding -- ^ int+    | GetEdgeFlagArrayBufferBinding -- ^ int+    | GetSecondaryColorArrayBufferBinding   -- ^ int+    | GetFogCoordArrayBufferBinding -- ^ int+    -- clipping+    | GetMaxClipPlanes          -- ^ sizei+    -- Colors+    | GetMaxLights              -- ^ sizei+    | GetFrontFace              -- ^ enum+    | GetLightModelLocalViewer  -- ^ bool+    | GetLightModelTwoSide      -- ^ bool+    | GetLightModelColorControl -- ^ enum+    | GetColorMaterialFace      -- ^ enum+    | GetColorMaterialParameter -- ^ enum+    | GetShadeModel             -- ^ enum+    | GetFragmentColorClamp     -- ^ enum+    | GetVertexColorClamp       -- ^ enum+    | GetReadColorClamp         -- ^ enum+    -- Evaluators+    | GetMaxEvalOrder       -- ^ int+    | GetMap1GridSegments   -- ^ int+    -- Fog+    | GetFogMode            -- ^ int => enum+    | GetFogIndex           -- ^ int+    | GetFogCoordSrc        -- ^ int+    | GetFogDistanceMode    -- ^ int => enum+    -- Framebuffer+    | GetAuxBuffers         -- ^ sizei+    | GetDoublebuffer       -- ^ bool+    | GetStereo             -- ^ bool+    | GetRedBits            -- ^ sizei+    | GetGreenBits          -- ^ sizei+    | GetBlueBits           -- ^ sizei+    | GetAlphaBits          -- ^ sizei+    | GetStencilBits        -- ^ sizei+    | GetDepthBits          -- ^ sizei+    | GetAccumRedBits       -- ^ sizei+    | GetAccumGreenBits     -- ^ sizei+    | GetAccumBlueBits      -- ^ sizei+    | GetAccumAlphaBits     -- ^ sizei+    | GetDrawBuffer         -- ^ enum+    | GetDrawBufferN GLsizei -- enum+    | GetMaxDrawBuffers     -- ^ sizei+    | GetIndexWritemask     -- ^ int+    | GetDepthWritemask     -- ^ bool+    | GetStencilWritemask   -- ^ bool+    | GetStencilBackWritemask   -- ^ bool+    | GetStencilClearValue  -- ^ int+    -- Program+    | GetCurrentProgram     -- ^ int+    -- Transformfeedback+    | GetMaxTransformFeedbackSeparateAttribs        -- ^ int+    | GetMaxTransformFeedbackInterleavedComponents  -- ^ int+    | GetMaxTransformFeedbackSeparateComponents     -- ^ int+    | GetCurrentRasterIndex         -- ^ int+    | GetCurrentRasterPositionValid -- ^ bool+    -- LineSegment+    | GetLineStippleRepeat          -- ^ int+    | GetLineStipplePattern         -- ^ int+    -- PerFragment+    | GetSampleCoverageInvert       -- ^ bool+    | GetAlphaTestFunc              -- ^ enum+    | GetStencilFunc                -- ^ enum+    | GetStencilBackFunc            -- ^ enum+    | GetStencilValueMask           -- ^ int+    | GetStencilBackValueMask       -- ^ int+    | GetStencilRef                 -- ^ int+    | GetStencilBackRef             -- ^ int+    | GetStencilFail                -- ^ enum+    | GetStencilBackFail            -- ^ enum+    | GetStencilPassDepthFail       -- ^ enum+    | GetStencilBackPassDepthFail   -- ^ enum+    | GetStencilPassDepthPass       -- ^ enum+    | GetStencilBackPassDepthPass   -- ^ enum+    | GetActiveStencilFace          -- ^ enum+    | GetLogicOpMode                -- ^ enum+    | GetBlendDst                   -- ^ enum+    | GetBlendSrc                   -- ^ enum+    | GetBlendSrcRGB                -- ^ enum+    | GetBlendSrcAlpha              -- ^ enum+    | GetBlendDstRGB                -- ^ enum+    | GetBlendDstAlpha              -- ^ enum+    | GetBlendEquation              -- ^ enum+    | GetBlendEquationAlpha         -- ^ enum+    | GetDepthFunc                  -- ^ enum+    | GetMapColor                   -- ^ bool+    | GetMapStencil                 -- ^ bool+    | GetIndexShift                 -- ^ int+    | GetIndexOffset                -- ^ int+    -- Polygons                     -- ^ enum+    | GetCullFaceMode+    -- TextureSpecification+    | GetNumCompressedTextureFormats    -- ^ int+    | GetMaxTextureSize                 -- ^ int+    | GetMax3DTextureSize               -- ^ int+    | GetMaxCubeMapTextureSize          -- ^ int+    | GetMaxRectangleTextureSize        -- ^ int+    | GetMaxArrayTextureLayers          -- ^ int+    | GetMaxSampleMaskWords             -- ^ int+    | GetMaxColorTextureSamples         -- ^ int+    | GetMaxDepthTextureSamples         -- ^ int+    | GetMaxIntegerSamples              -- ^ int+    -- ReadCopyPixels+    | GetReadBuffer                 -- ^ enum+    -- Texture Objects+    | GetTextureBinding1D           -- ^ int\/enum+    | GetTextureBinding2D           -- ^ int\/enum+    | GetTextureBinding3D           -- ^ int\/enum+    | GetTextureBinding1DArray      -- ^ int\/enum+    | GetTextureBinding2DArray      -- ^ int\/enum+    | GetTextureBindingCubeMapArray -- ^ int\/enum+    | GetTextureBindingRectangle    -- ^ int\/enum+    | GetTextureBindingBuffer       -- ^ int\/enum+    | GetTextureBindingCubeMap      -- ^ int\/enum+    | GetTextureBinding2DMultisample -- ^ int\/enum+    | GetTextureBinding2DMultisampleArray -- ^ int\/enum+    -- Antialiasing+    | GetSubpixelBits               -- ^ sizei+    | GetSamples                    -- ^ sizei+    | GetSampleBuffers              -- ^ sizei+    -- Sync Objects+    | GetMaxServerWaitTimeout       -- ^ int+    -- Query Objects+    | GetMaxVertexStreams           -- ^ int+    -- GL Time+    | GetTimestamp                  -- ^ int+    -- Shader+    | GetShaderCompiler             -- ^ bool+    | GetNumShaderBinaryFormats     -- ^ int+    | GetNumProgramBinaryFormats    -- ^ int+    -- Debug Output+    | GetMaxDebugMessageLength        -- ^ int+    | GetMaxDebugLoggedMessages       -- ^ int+    | GetDebugLoggedMessages          -- ^ int+    | GetDebugNextLoggedMessageLength -- ^ int+    | GetMaxDebugGroupStackDepth      -- ^ int+    | GetMaxLabelLength               -- ^ int+    -- Extensions+    | GetNumExtensions     -- ^ uint++instance GetPName1I PName1I where++instance GetPName PName1I where+    marshalGetPName pn = case pn of+        GetEdgeFlag -> Just GL_EDGE_FLAG+        GetRGBAMode -> Just GL_RGBA_MODE+        GetCurrentIndex -> Just GL_CURRENT_INDEX+        GetMaxTextureUnits -> Just GL_MAX_TEXTURE_UNITS+        -- displaylist+        GetListIndex -> Just GL_LIST_INDEX+        GetListMode -> Just GL_LIST_MODE+        GetMaxListNesting -> Just GL_MAX_LIST_NESTING+        GetListBase -> Just GL_LIST_BASE+        -- rendermode+        GetRenderMode -> Just GL_RENDER_MODE+        -- framebufferbinding+        GetDrawFramebufferBinding -> Just GL_DRAW_FRAMEBUFFER_BINDING+        GetReadFramebufferBinding -> Just GL_READ_FRAMEBUFFER_BINDING+        GetFramebufferBinding -> Just GL_FRAMEBUFFER_BINDING+        -- renderbufferbinding+        GetRenderbufferBinding -> Just GL_RENDERBUFFER_BINDING+        -- hint+        GetPerspectiveCorrectionHint -> Just GL_PERSPECTIVE_CORRECTION_HINT+        GetPointSmoothHint -> Just GL_POINT_SMOOTH_HINT+        GetLineSmoothHint -> Just GL_LINE_SMOOTH_HINT+        GetPolygonSmoothHint -> Just GL_POLYGON_SMOOTH_HINT+        GetFogHint -> Just GL_FOG_HINT+        GetGenerateMipmapHint -> Just GL_GENERATE_MIPMAP_HINT+        GetTextureCompressionHint -> Just GL_TEXTURE_COMPRESSION_HINT+        GetPackCMYKHint -> Just GL_PACK_CMYK_HINT_EXT+        GetUnpackCMYKHint -> Just GL_UNPACK_CMYK_HINT_EXT+        GetVertexArrayBinding -> Just GL_VERTEX_ARRAY_BINDING+        -- Selection ?+        GetMaxNameStackDepth -> Just GL_MAX_NAME_STACK_DEPTH+        GetNameStackDepth -> Just GL_NAME_STACK_DEPTH+        -- ContextProfile+        GetContextProfileMask -> Just GL_CONTEXT_PROFILE_MASK+        --pixel storage+        GetPackSwapBytes -> Just GL_PACK_SWAP_BYTES+        GetUnpackSwapBytes -> Just GL_UNPACK_SWAP_BYTES+        GetPackLSBFirst -> Just GL_PACK_LSB_FIRST+        GetUnpackLSBFirst -> Just GL_UNPACK_LSB_FIRST+        GetPackRowLength -> Just GL_PACK_ROW_LENGTH+        GetUnpackRowLength -> Just GL_UNPACK_ROW_LENGTH+        GetPackSkipRows -> Just GL_PACK_SKIP_ROWS+        GetUnpackSkipRows -> Just GL_UNPACK_SKIP_ROWS+        GetPackSkipPixels -> Just GL_PACK_SKIP_PIXELS+        GetUnpackSkipPixels -> Just GL_UNPACK_SKIP_PIXELS+        GetPackAlignment -> Just GL_PACK_ALIGNMENT+        GetUnpackAlignment -> Just GL_UNPACK_ALIGNMENT+        GetPackSkipImages -> Just GL_PACK_SKIP_IMAGES+        GetUnpackSkipImages -> Just GL_UNPACK_SKIP_IMAGES+        GetPackImageHeight -> Just GL_PACK_IMAGE_HEIGHT+        GetUnpackImageHeight -> Just GL_UNPACK_IMAGE_HEIGHT+        -- pixelmap+        GetPixelMapIToISize -> Just GL_PIXEL_MAP_I_TO_I_SIZE+        GetPixelMapSToSSize -> Just GL_PIXEL_MAP_S_TO_S_SIZE+        GetPixelMapIToRSize -> Just GL_PIXEL_MAP_I_TO_R_SIZE+        GetPixelMapIToGSize -> Just GL_PIXEL_MAP_I_TO_G_SIZE+        GetPixelMapIToBSize -> Just GL_PIXEL_MAP_I_TO_B_SIZE+        GetPixelMapIToASize -> Just GL_PIXEL_MAP_I_TO_A_SIZE+        GetPixelMapRToRSize -> Just GL_PIXEL_MAP_R_TO_R_SIZE+        GetPixelMapGToGSize -> Just GL_PIXEL_MAP_G_TO_G_SIZE+        GetPixelMapBToBSize -> Just GL_PIXEL_MAP_B_TO_B_SIZE+        GetPixelMapAToASize -> Just GL_PIXEL_MAP_A_TO_A_SIZE+        GetMaxPixelMapTable -> Just GL_MAX_PIXEL_MAP_TABLE+        -- shader limits+        GetMaxVertexTextureImageUnits -> Just GL_MAX_VERTEX_TEXTURE_IMAGE_UNITS+        GetMaxTextureImageUnits -> Just GL_MAX_TEXTURE_IMAGE_UNITS+        GetMaxCombinedTextureImageUnits -> Just GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS+        GetMaxTextureCoords -> Just GL_MAX_TEXTURE_COORDS+        GetMaxVertexUniformComponents -> Just GL_MAX_VERTEX_UNIFORM_COMPONENTS+        GetMaxFragmentUniformComponents -> Just GL_MAX_FRAGMENT_UNIFORM_COMPONENTS+        GetMaxVaryingFloats -> Just GL_MAX_VARYING_COMPONENTS+        GetMaxVertexAttribs -> Just GL_MAX_VERTEX_ATTRIBS+        -- tessellation+        GetPatchVertices -> Just GL_PATCH_VERTICES+        GetMaxPatchVertices -> Just GL_MAX_PATCH_VERTICES+        GetMaxTessGenLevel -> Just GL_MAX_TESS_GEN_LEVEL+        -- coordtrans+        GetMatrixMode -> Just GL_MATRIX_MODE+        GetModelviewStackDepth -> Just GL_MODELVIEW_STACK_DEPTH+        GetProjectionStackDepth -> Just GL_PROJECTION_STACK_DEPTH+        GetTextureStackDepth -> Just GL_TEXTURE_STACK_DEPTH+        GetColorMatrixStackDepth -> Just GL_COLOR_MATRIX_STACK_DEPTH+        GetMaxModelviewStackDepth -> Just GL_MAX_MODELVIEW_STACK_DEPTH+        GetMaxProjectionStackDepth -> Just GL_MAX_PROJECTION_STACK_DEPTH+        GetMaxTextureStackDepth -> Just GL_MAX_TEXTURE_STACK_DEPTH+        GetMaxColorMatrixStackDepth -> Just GL_MAX_COLOR_MATRIX_STACK_DEPTH+        GetMaxMatrixPaletteStackDepth -> Just GL_MAX_MATRIX_PALETTE_STACK_DEPTH_ARB+        GetCurrentMatrixStackDepth -> Just GL_CURRENT_MATRIX_STACK_DEPTH_ARB+        GetActiveTexture -> Just GL_ACTIVE_TEXTURE+        -- vertexarrays+        GetVertexArraySize -> Just GL_VERTEX_ARRAY_SIZE+        GetVertexArrayType -> Just GL_VERTEX_ARRAY_TYPE+        GetVertexArrayStride -> Just GL_VERTEX_ARRAY_STRIDE+        GetNormalArrayType -> Just GL_NORMAL_ARRAY_TYPE+        GetNormalArrayStride -> Just GL_NORMAL_ARRAY_STRIDE+        GetColorArraySize -> Just GL_COLOR_ARRAY_SIZE+        GetColorArrayType -> Just GL_COLOR_ARRAY_TYPE+        GetColorArrayStride -> Just GL_COLOR_ARRAY_STRIDE+        GetIndexArrayType -> Just GL_INDEX_ARRAY_TYPE+        GetIndexArrayStride -> Just GL_INDEX_ARRAY_STRIDE+        GetTextureCoordArraySize -> Just GL_TEXTURE_COORD_ARRAY_SIZE+        GetTextureCoordArrayType -> Just GL_TEXTURE_COORD_ARRAY_TYPE+        GetTextureCoordArrayStride -> Just GL_TEXTURE_COORD_ARRAY_STRIDE+        GetEdgeFlagArrayStride -> Just GL_EDGE_FLAG_ARRAY_STRIDE+        GetFogCoordArrayType -> Just GL_FOG_COORD_ARRAY_TYPE+        GetFogCoordArrayStride -> Just GL_FOG_COORD_ARRAY_STRIDE+        GetSecondaryColorArraySize -> Just GL_SECONDARY_COLOR_ARRAY_SIZE+        GetSecondaryColorArrayType -> Just GL_SECONDARY_COLOR_ARRAY_TYPE+        GetSecondaryColorArrayStride -> Just GL_SECONDARY_COLOR_ARRAY_STRIDE+        GetArrayElementLockCount -> Just GL_ARRAY_ELEMENT_LOCK_COUNT_EXT+        GetArrayElementLockFirst -> Just GL_ARRAY_ELEMENT_LOCK_FIRST_EXT+        GetClientActiveTexture -> Just GL_CLIENT_ACTIVE_TEXTURE+        GetMaxElementsVertices -> Just GL_MAX_ELEMENTS_VERTICES+        GetMaxElementsIndices -> Just GL_MAX_ELEMENTS_INDICES+        GetPrimitiveRestartIndex -> Just GL_PRIMITIVE_RESTART_INDEX+        GetPrimitiveRestartNV -> Just GL_PRIMITIVE_RESTART_NV+        GetPrimitiveRestartIndexNV -> Just GL_PRIMITIVE_RESTART_INDEX_NV+        -- bufferobjects+        GetArrayBufferBinding -> Just GL_ARRAY_BUFFER_BINDING+        GetAtomicCounterBufferBinding -> Just GL_ATOMIC_COUNTER_BUFFER_BINDING+        GetCopyReadBufferBinding -> Just GL_COPY_READ_BUFFER_BINDING+        GetCopyWriteBufferBinding -> Just GL_COPY_WRITE_BUFFER_BINDING+        GetDispatchIndirectBufferBinding -> Just GL_DISPATCH_INDIRECT_BUFFER_BINDING+        GetDrawIndirectBufferBinding -> Just GL_DRAW_INDIRECT_BUFFER_BINDING+        GetElementArrayBufferBinding -> Just GL_ELEMENT_ARRAY_BUFFER_BINDING+        GetPixelPackBufferBinding -> Just GL_PIXEL_PACK_BUFFER_BINDING+        GetPixelUnpackBufferBinding -> Just GL_PIXEL_UNPACK_BUFFER_BINDING+        GetQueryBufferBinding -> Just GL_QUERY_BUFFER_BINDING+        GetShaderStorageBufferBinding -> Just GL_SHADER_STORAGE_BUFFER_BINDING+        GetTransformFeedbackBufferBinding -> Just GL_TRANSFORM_FEEDBACK_BUFFER_BINDING+        GetUniformBufferBinding -> Just GL_UNIFORM_BUFFER_BINDING++        GetVertexArrayBufferBinding -> Just GL_VERTEX_ARRAY_BUFFER_BINDING+        GetNormalArrayBufferBinding -> Just GL_NORMAL_ARRAY_BUFFER_BINDING+        GetColorArrayBufferBinding -> Just GL_COLOR_ARRAY_BUFFER_BINDING+        GetIndexArrayBufferBinding -> Just GL_INDEX_ARRAY_BUFFER_BINDING+        GetTextureCoordArrayBufferBinding -> Just GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING+        GetEdgeFlagArrayBufferBinding -> Just GL_EDGE_FLAG_ARRAY_BUFFER_BINDING+        GetSecondaryColorArrayBufferBinding -> Just GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING+        GetFogCoordArrayBufferBinding -> Just GL_FOG_COORD_ARRAY_BUFFER_BINDING+        -- clipping+        GetMaxClipPlanes -> Just GL_MAX_CLIP_DISTANCES+        -- Colors+        GetMaxLights -> Just GL_MAX_LIGHTS+        GetFrontFace -> Just GL_FRONT_FACE+        GetLightModelLocalViewer -> Just GL_LIGHT_MODEL_LOCAL_VIEWER+        GetLightModelTwoSide -> Just GL_LIGHT_MODEL_TWO_SIDE+        GetLightModelColorControl -> Just GL_LIGHT_MODEL_COLOR_CONTROL+        GetColorMaterialFace -> Just GL_COLOR_MATERIAL_FACE+        GetColorMaterialParameter -> Just GL_COLOR_MATERIAL_PARAMETER+        GetShadeModel -> Just GL_SHADE_MODEL+        GetVertexColorClamp -> Just GL_CLAMP_VERTEX_COLOR+        GetFragmentColorClamp -> Just GL_CLAMP_FRAGMENT_COLOR+        GetReadColorClamp -> Just GL_CLAMP_READ_COLOR+        -- Evaluators+        GetMaxEvalOrder -> Just GL_MAX_EVAL_ORDER+        GetMap1GridSegments -> Just GL_MAP1_GRID_SEGMENTS+        -- Fog+        GetFogMode -> Just GL_FOG_MODE+        GetFogIndex -> Just GL_FOG_INDEX+        GetFogCoordSrc -> Just GL_FOG_COORD_SRC+        GetFogDistanceMode -> Just GL_FOG_DISTANCE_MODE_NV+        -- Framebuffer+        GetAuxBuffers -> Just GL_AUX_BUFFERS+        GetDoublebuffer -> Just GL_DOUBLEBUFFER+        GetStereo -> Just GL_STEREO+        GetRedBits -> Just GL_RED_BITS+        GetGreenBits -> Just GL_GREEN_BITS+        GetBlueBits -> Just GL_BLUE_BITS+        GetAlphaBits -> Just GL_ALPHA_BITS+        GetDepthBits -> Just GL_DEPTH_BITS+        GetStencilBits -> Just GL_STENCIL_BITS+        GetAccumRedBits -> Just GL_ACCUM_RED_BITS+        GetAccumGreenBits -> Just GL_ACCUM_GREEN_BITS+        GetAccumBlueBits -> Just GL_ACCUM_BLUE_BITS+        GetAccumAlphaBits -> Just GL_ACCUM_ALPHA_BITS+        GetDrawBuffer -> Just GL_DRAW_BUFFER+        GetDrawBufferN i -> drawBufferIndexToEnum i+        GetMaxDrawBuffers -> Just GL_MAX_DRAW_BUFFERS+        GetIndexWritemask -> Just GL_INDEX_WRITEMASK+        GetDepthWritemask -> Just GL_DEPTH_WRITEMASK+        GetStencilWritemask -> Just GL_STENCIL_WRITEMASK+        GetStencilBackWritemask -> Just GL_STENCIL_BACK_WRITEMASK+        GetStencilClearValue -> Just GL_STENCIL_CLEAR_VALUE+        -- Program+        GetCurrentProgram -> Just GL_CURRENT_PROGRAM+        -- Transformfeedback+        GetMaxTransformFeedbackSeparateAttribs -> Just GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_ATTRIBS+        GetMaxTransformFeedbackSeparateComponents -> Just GL_MAX_TRANSFORM_FEEDBACK_SEPARATE_COMPONENTS+        GetMaxTransformFeedbackInterleavedComponents -> Just GL_MAX_TRANSFORM_FEEDBACK_INTERLEAVED_COMPONENTS+        -- RasterPos+        GetCurrentRasterIndex -> Just GL_CURRENT_RASTER_INDEX+        GetCurrentRasterPositionValid -> Just GL_CURRENT_RASTER_POSITION_VALID+        -- LineSegment+        GetLineStipplePattern -> Just GL_LINE_STIPPLE_PATTERN+        GetLineStippleRepeat -> Just GL_LINE_STIPPLE_REPEAT+        -- PerFragment+        GetSampleCoverageInvert -> Just GL_SAMPLE_COVERAGE_INVERT+        GetAlphaTestFunc -> Just GL_ALPHA_TEST_FUNC+        GetStencilFunc -> Just GL_STENCIL_FUNC+        GetStencilBackFunc -> Just GL_STENCIL_BACK_FUNC+        GetStencilValueMask -> Just GL_STENCIL_VALUE_MASK+        GetStencilBackValueMask -> Just GL_STENCIL_BACK_VALUE_MASK+        GetStencilRef -> Just GL_STENCIL_REF+        GetStencilBackRef -> Just GL_STENCIL_BACK_REF+        GetStencilFail -> Just GL_STENCIL_FAIL+        GetStencilBackFail -> Just GL_STENCIL_BACK_FAIL+        GetStencilPassDepthFail -> Just GL_STENCIL_PASS_DEPTH_FAIL+        GetStencilBackPassDepthFail -> Just GL_STENCIL_BACK_PASS_DEPTH_FAIL+        GetStencilPassDepthPass -> Just GL_STENCIL_PASS_DEPTH_PASS+        GetStencilBackPassDepthPass -> Just GL_STENCIL_BACK_PASS_DEPTH_PASS+        GetActiveStencilFace -> Just GL_ACTIVE_STENCIL_FACE_EXT+        GetLogicOpMode -> Just GL_LOGIC_OP_MODE+        GetBlendDst -> Just GL_BLEND_DST+        GetBlendSrc -> Just GL_BLEND_SRC+        GetBlendDstRGB -> Just GL_BLEND_DST_RGB+        GetBlendSrcRGB -> Just GL_BLEND_SRC_RGB+        GetBlendDstAlpha -> Just GL_BLEND_DST_ALPHA+        GetBlendSrcAlpha -> Just GL_BLEND_SRC_ALPHA+        GetBlendEquation -> Just GL_BLEND_EQUATION_RGB+        GetBlendEquationAlpha -> Just GL_BLEND_EQUATION_ALPHA+        GetDepthFunc -> Just GL_DEPTH_FUNC+        GetMapColor -> Just GL_MAP_COLOR+        GetMapStencil -> Just GL_MAP_STENCIL+        GetIndexShift -> Just GL_INDEX_SHIFT+        GetIndexOffset -> Just GL_INDEX_OFFSET+        -- Polygons+        GetCullFaceMode -> Just GL_CULL_FACE_MODE+        -- Texture specification+        GetNumCompressedTextureFormats -> Just GL_NUM_COMPRESSED_TEXTURE_FORMATS+        GetMaxTextureSize -> Just GL_MAX_TEXTURE_SIZE+        GetMax3DTextureSize -> Just GL_MAX_3D_TEXTURE_SIZE+        GetMaxCubeMapTextureSize -> Just GL_MAX_CUBE_MAP_TEXTURE_SIZE+        GetMaxRectangleTextureSize -> Just GL_MAX_RECTANGLE_TEXTURE_SIZE+        GetMaxArrayTextureLayers -> Just GL_MAX_ARRAY_TEXTURE_LAYERS+        GetMaxSampleMaskWords -> Just GL_MAX_SAMPLE_MASK_WORDS+        GetMaxColorTextureSamples -> Just GL_MAX_COLOR_TEXTURE_SAMPLES+        GetMaxDepthTextureSamples -> Just GL_MAX_DEPTH_TEXTURE_SAMPLES+        GetMaxIntegerSamples -> Just GL_MAX_INTEGER_SAMPLES+        -- ReadCopyPixels+        GetReadBuffer -> Just GL_READ_BUFFER+        -- Texture Objects+        GetTextureBinding1D -> Just GL_TEXTURE_BINDING_1D+        GetTextureBinding2D -> Just GL_TEXTURE_BINDING_2D+        GetTextureBinding3D -> Just GL_TEXTURE_BINDING_3D+        GetTextureBinding1DArray -> Just GL_TEXTURE_BINDING_1D_ARRAY+        GetTextureBinding2DArray -> Just GL_TEXTURE_BINDING_2D_ARRAY+        GetTextureBindingCubeMapArray -> Just GL_TEXTURE_BINDING_CUBE_MAP_ARRAY+        GetTextureBindingRectangle -> Just GL_TEXTURE_BINDING_RECTANGLE+        GetTextureBindingBuffer -> Just GL_TEXTURE_BINDING_BUFFER+        GetTextureBindingCubeMap -> Just GL_TEXTURE_BINDING_CUBE_MAP+        GetTextureBinding2DMultisample -> Just GL_TEXTURE_BINDING_2D_MULTISAMPLE+        GetTextureBinding2DMultisampleArray -> Just GL_TEXTURE_BINDING_2D_MULTISAMPLE_ARRAY+        -- Antialiasing+        GetSubpixelBits -> Just GL_SUBPIXEL_BITS+        GetSampleBuffers -> Just GL_SAMPLE_BUFFERS+        GetSamples -> Just GL_SAMPLES+         -- Sync Objects+        GetMaxServerWaitTimeout -> Just GL_MAX_SERVER_WAIT_TIMEOUT+        -- Query Objects+        GetMaxVertexStreams -> Just GL_MAX_VERTEX_STREAMS+        -- GL Time+        GetTimestamp -> Just GL_TIMESTAMP+        -- Shader+        GetShaderCompiler -> Just GL_SHADER_COMPILER+        GetNumShaderBinaryFormats -> Just GL_NUM_SHADER_BINARY_FORMATS+        GetNumProgramBinaryFormats -> Just GL_NUM_PROGRAM_BINARY_FORMATS+        -- Debug Output+        GetMaxDebugMessageLength -> Just GL_MAX_DEBUG_MESSAGE_LENGTH+        GetMaxDebugLoggedMessages -> Just GL_MAX_DEBUG_LOGGED_MESSAGES+        GetDebugLoggedMessages -> Just GL_DEBUG_LOGGED_MESSAGES+        GetDebugNextLoggedMessageLength -> Just GL_DEBUG_NEXT_LOGGED_MESSAGE_LENGTH+        GetMaxDebugGroupStackDepth -> Just GL_MAX_DEBUG_GROUP_STACK_DEPTH+        GetMaxLabelLength -> Just GL_MAX_LABEL_LENGTH+        GetNumExtensions -> Just GL_NUM_EXTENSIONS++-- 0x8825 through 0x8834 are reserved for draw buffers++drawBufferIndexToEnum :: GLsizei -> Maybe GLenum+drawBufferIndexToEnum i+   | 0 <= i && i <= maxDrawBufferIndex = Just (GL_DRAW_BUFFER0 + fromIntegral i)+   | otherwise = Nothing++maxDrawBufferIndex :: GLsizei+maxDrawBufferIndex = fromIntegral (GL_DRAW_BUFFER15 - GL_DRAW_BUFFER0)+++-----------------------------------------------------------------------------++data PName1F+    = GetCurrentFogCoord    -- ^ Float1+    -- Rasterization+    | GetZoomX              -- ^ Float+    | GetZoomY              -- ^ Float+    -- Colors+    | GetMaxShininess       -- ^ Float+    | GetMaxSpotExponent    -- ^ Float+    -- Fog+    | GetFogStart           -- ^ float+    | GetFogEnd             -- ^ float+    | GetFogDensity         -- ^ float+    -- Framebuffer+    | GetDepthClearValue    -- ^ clampf+    | GetIndexClearValue    -- ^ float+    -- RasterPos+    | GetCurrentRasterDistance -- ^ float+    -- Point+    | GetPointSizeMin               -- ^ float+    | GetPointSizeMax               -- ^ float+    | GetPointFadeThresholdSize     -- ^ float+    | GetSmoothPointSizeGranularity -- ^ float+    | GetPointSize                  -- ^ float+    -- LineSegment+    | GetLineWidth                  -- ^ float+    | GetSmoothLineWidthGranularity -- ^ float+    -- PerFragment+    | GetSampleCoverageValue        -- ^ clampf+    | GetAlphaTestRef               -- ^ clampf+    -- PixelTransfer+    | GetRedScale                   -- ^ float+    | GetGreenScale                 -- ^ float+    | GetBlueScale                  -- ^ float+    | GetAlphaScale                 -- ^ float+    | GetPostConvolutionRedScale    -- ^ float+    | GetPostConvolutionGreenScale  -- ^ float+    | GetPostConvolutionBlueScale   -- ^ float+    | GetPostConvolutionAlphaScale  -- ^ float+    | GetPostColorMatrixRedScale    -- ^ float+    | GetPostColorMatrixGreenScale  -- ^ float+    | GetPostColorMatrixBlueScale   -- ^ float+    | GetPostColorMatrixAlphaScale  -- ^ float+    | GetRedBias                    -- ^ float+    | GetGreenBias                  -- ^ float+    | GetBlueBias                   -- ^ float+    | GetAlphaBias                  -- ^ float+    | GetPostConvolutionRedBias     -- ^ float+    | GetPostConvolutionGreenBias   -- ^ float+    | GetPostConvolutionBlueBias    -- ^ float+    | GetPostConvolutionAlphaBias   -- ^ float+    | GetPostColorMatrixRedBias     -- ^ float+    | GetPostColorMatrixGreenBias   -- ^ float+    | GetPostColorMatrixBlueBias    -- ^ float+    | GetPostColorMatrixAlphaBias   -- ^ float+    | GetDepthScale                 -- ^ float+    | GetDepthBias                  -- ^ float+    -- Polygons+    | GetPolygonOffsetFactor        -- ^ float+    | GetPolygonOffsetUnits         -- ^ float+    -- Texture parameters+    | GetMaxTextureMaxAnisotropy    -- ^ float+    | GetMaxTextureLODBias          -- ^ float++instance GetPName1F PName1F where++instance GetPName PName1F where+    marshalGetPName pn = case pn of+        GetCurrentFogCoord -> Just GL_CURRENT_FOG_COORD+        -- Rasterization+        GetZoomX -> Just GL_ZOOM_X+        GetZoomY -> Just GL_ZOOM_Y+        -- Colors+        GetMaxShininess -> Just GL_MAX_SHININESS_NV+        GetMaxSpotExponent -> Just GL_MAX_SPOT_EXPONENT_NV+        -- Fog+        GetFogStart -> Just GL_FOG_START+        GetFogEnd -> Just GL_FOG_END+        GetFogDensity -> Just GL_FOG_DENSITY+        -- Framebuffer+        GetDepthClearValue -> Just GL_DEPTH_CLEAR_VALUE+        GetIndexClearValue -> Just GL_INDEX_CLEAR_VALUE+        -- RasterPos+        GetCurrentRasterDistance -> Just GL_CURRENT_RASTER_DISTANCE+        -- Point+        GetPointSizeMin -> Just GL_POINT_SIZE_MIN+        GetPointSizeMax -> Just GL_POINT_SIZE_MAX+        GetPointFadeThresholdSize -> Just GL_POINT_FADE_THRESHOLD_SIZE+        GetSmoothPointSizeGranularity -> Just GL_POINT_SIZE_GRANULARITY+        GetPointSize -> Just GL_POINT_SIZE+        -- LineSegment+        GetSmoothLineWidthGranularity -> Just GL_SMOOTH_LINE_WIDTH_GRANULARITY+        GetLineWidth -> Just GL_LINE_WIDTH+        -- PerFragment+        GetSampleCoverageValue -> Just GL_SAMPLE_COVERAGE_VALUE+        GetAlphaTestRef -> Just GL_ALPHA_TEST_REF+        -- PixelTransfer+        GetRedScale -> Just GL_RED_SCALE+        GetRedBias -> Just GL_RED_BIAS+        GetGreenScale -> Just GL_GREEN_SCALE+        GetGreenBias -> Just GL_GREEN_BIAS+        GetBlueScale -> Just GL_BLUE_SCALE+        GetBlueBias -> Just GL_BLUE_BIAS+        GetAlphaScale -> Just GL_ALPHA_SCALE+        GetAlphaBias -> Just GL_ALPHA_BIAS+        GetPostConvolutionRedScale -> Just GL_POST_CONVOLUTION_RED_SCALE+        GetPostConvolutionGreenScale -> Just GL_POST_CONVOLUTION_GREEN_SCALE+        GetPostConvolutionBlueScale -> Just GL_POST_CONVOLUTION_BLUE_SCALE+        GetPostConvolutionAlphaScale -> Just GL_POST_CONVOLUTION_ALPHA_SCALE+        GetPostConvolutionRedBias -> Just GL_POST_CONVOLUTION_RED_BIAS+        GetPostConvolutionGreenBias -> Just GL_POST_CONVOLUTION_GREEN_BIAS+        GetPostConvolutionBlueBias -> Just GL_POST_CONVOLUTION_BLUE_BIAS+        GetPostConvolutionAlphaBias -> Just GL_POST_CONVOLUTION_ALPHA_BIAS+        GetPostColorMatrixRedScale -> Just GL_POST_COLOR_MATRIX_RED_SCALE+        GetPostColorMatrixGreenScale -> Just GL_POST_COLOR_MATRIX_GREEN_SCALE+        GetPostColorMatrixBlueScale -> Just GL_POST_COLOR_MATRIX_BLUE_SCALE+        GetPostColorMatrixAlphaScale -> Just GL_POST_COLOR_MATRIX_ALPHA_SCALE+        GetPostColorMatrixRedBias -> Just GL_POST_COLOR_MATRIX_RED_BIAS+        GetPostColorMatrixGreenBias -> Just GL_POST_COLOR_MATRIX_GREEN_BIAS+        GetPostColorMatrixBlueBias -> Just GL_POST_COLOR_MATRIX_BLUE_BIAS+        GetPostColorMatrixAlphaBias -> Just GL_POST_COLOR_MATRIX_ALPHA_BIAS+        GetDepthScale -> Just GL_DEPTH_SCALE+        GetDepthBias -> Just GL_DEPTH_BIAS+        -- Polygons+        GetPolygonOffsetFactor -> Just GL_POLYGON_OFFSET_FACTOR+        GetPolygonOffsetUnits -> Just GL_POLYGON_OFFSET_UNITS+        -- Texture parameters+        GetMaxTextureMaxAnisotropy -> Just GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT+        GetMaxTextureLODBias -> Just GL_MAX_TEXTURE_LOD_BIAS++-----------------------------------------------------------------------------++data IPName1I =+      GetAtomicCounterBuffer+    | GetAtomicCounterBufferStart+    | GetAtomicCounterBufferSize+    | GetShaderStorageBuffer+    | GetShaderStorageBufferStart+    | GetShaderStorageBufferSize+    | GetTransformFeedbackBuffer+    | GetTransformFeedbackBufferStart+    | GetTransformFeedbackBufferSize+    | GetUniformBuffer+    | GetUniformBufferStart+    | GetUniformBufferSize++instance GetIPName1I IPName1I where++instance GetPName IPName1I where+    marshalGetPName pn = case pn of+        GetAtomicCounterBuffer -> Just GL_ATOMIC_COUNTER_BUFFER+        GetAtomicCounterBufferStart -> Just GL_ATOMIC_COUNTER_BUFFER_START+        GetAtomicCounterBufferSize -> Just GL_ATOMIC_COUNTER_BUFFER_SIZE+        GetShaderStorageBuffer -> Just GL_SHADER_STORAGE_BUFFER+        GetShaderStorageBufferStart -> Just GL_SHADER_STORAGE_BUFFER_START+        GetShaderStorageBufferSize -> Just GL_SHADER_STORAGE_BUFFER_SIZE+        GetTransformFeedbackBuffer -> Just GL_TRANSFORM_FEEDBACK_BUFFER+        GetTransformFeedbackBufferStart -> Just GL_TRANSFORM_FEEDBACK_BUFFER_START+        GetTransformFeedbackBufferSize -> Just GL_TRANSFORM_FEEDBACK_BUFFER_SIZE+        GetUniformBuffer -> Just GL_UNIFORM_BUFFER+        GetUniformBufferStart -> Just GL_UNIFORM_BUFFER_START+        GetUniformBufferSize -> Just GL_UNIFORM_BUFFER_SIZE++-----------------------------------------------------------------------------++data PName2I+    -- coordtrans+    = GetMaxViewportDims -- ^ sizei+    -- Evaluators+    | GetMap2GridSegments+    -- Polygons+    | GetPolygonMode++instance GetPName2I PName2I where++instance GetPName PName2I where+    marshalGetPName pn = case pn of+        -- coordtrans+        GetMaxViewportDims -> Just GL_MAX_VIEWPORT_DIMS+        -- Evaluators+        GetMap2GridSegments -> Just GL_MAP2_GRID_SEGMENTS+        -- Polygons+        GetPolygonMode -> Just GL_POLYGON_MODE++-----------------------------------------------------------------------------++data PName2F+    -- coordtrans+    = GetDepthRange -- ^ clamp+    -- Evaluators+    | GetMap1GridDomain -- ^ float2?+    -- Point+    | GetAliasedPointSizeRange  -- ^ float+    | GetSmoothPointSizeRange   -- ^ float+    -- LineSegments+    | GetAliasedLineWidthRange  -- ^ float+    | GetSmoothLineWidthRange   -- ^ float+    -- PerFragment+    | GetDepthBounds            -- ^ clampd+    -- Tessellation+    | GetPatchDefaultInnerLevel -- ^ float++instance GetPName2F PName2F where++instance GetPName PName2F where+    marshalGetPName pn = case pn of+        -- coord trans+        GetDepthRange -> Just GL_DEPTH_RANGE+        -- Evaluators+        GetMap1GridDomain -> Just GL_MAP1_GRID_DOMAIN+        -- Point+        GetAliasedPointSizeRange -> Just GL_ALIASED_POINT_SIZE_RANGE+        GetSmoothPointSizeRange -> Just GL_POINT_SIZE_RANGE+        -- LineSegments+        GetAliasedLineWidthRange -> Just GL_ALIASED_LINE_WIDTH_RANGE+        GetSmoothLineWidthRange -> Just GL_SMOOTH_LINE_WIDTH_RANGE+        -- PerFragment+        GetDepthBounds -> Just GL_DEPTH_BOUNDS_EXT+        -- Tessellation+        GetPatchDefaultInnerLevel -> Just GL_PATCH_DEFAULT_INNER_LEVEL++-----------------------------------------------------------------------------++data PName3F+    = GetCurrentNormal -- ^ Float3+    -- Point+    | GetPointDistanceAttenuation -- ^ float++instance GetPName3F PName3F where++instance GetPName PName3F where+    marshalGetPName pn = case pn of+        GetCurrentNormal -> Just GL_CURRENT_NORMAL+        -- Point+        GetPointDistanceAttenuation -> Just GL_POINT_DISTANCE_ATTENUATION++-----------------------------------------------------------------------------++data PName4I+    -- coordtrans+    = GetViewport               -- ^ int+    -- Framebuffer+    | GetRGBASignedComponents   -- ^ int+    -- PerFragment+    | GetScissorBox             -- ^ int+++instance GetPName4I PName4I where++instance GetPName PName4I where+    marshalGetPName pn = case pn of+        -- coordtrans+        GetViewport -> Just GL_VIEWPORT+        -- Framebuffer+        GetRGBASignedComponents -> Just GL_RGBA_SIGNED_COMPONENTS_EXT+        -- PerFragement+        GetScissorBox -> Just GL_SCISSOR_BOX+++-- | Both indexed and unindexed+data PName4ISemiIndexed+    = GetColorWritemask         -- ^ bool++instance GetPName4I  PName4ISemiIndexed where++instance GetIPName4I PName4ISemiIndexed where++instance GetPName PName4ISemiIndexed where+    marshalGetPName pn = case pn of+        GetColorWritemask -> Just GL_COLOR_WRITEMASK++-----------------------------------------------------------------------------++data PName4F+    = GetCurrentColor -- ^ ?+    | GetCurrentTextureCoords   -- ^ Float+    | GetCurrentSecondaryColor  -- ^ Float+    -- Colors+    | GetLightModelAmbient  -- ^ float+    -- Evaluators+    | GetMap2GridDomain     -- ^ float?+    -- Fog+    | GetFogColor           -- ^ clampf+    -- Framebuffer+    | GetColorClearValue    -- ^ clampf+    | GetAccumClearValue    -- ^ float+    -- RasterPos+    | GetCurrentRasterColor             -- ^ float+    | GetCurrentRasterSecondaryColor    -- ^ float+    | GetCurrentRasterTextureCoords     -- ^ float+    | GetCurrentRasterPosition          -- ^ float+    -- PerFragment+    | GetBlendColor                     -- ^ clampf+    -- Tessellation+    | GetPatchDefaultOuterLevel         -- ^ float++instance GetPName4F PName4F where++instance GetPName PName4F where+    marshalGetPName pn = case pn of+        GetCurrentColor -> Just GL_CURRENT_COLOR+        GetCurrentTextureCoords -> Just GL_CURRENT_TEXTURE_COORDS+        GetCurrentSecondaryColor -> Just GL_CURRENT_SECONDARY_COLOR+        -- Colors+        GetLightModelAmbient -> Just GL_LIGHT_MODEL_AMBIENT+        -- Evaluators+        GetMap2GridDomain -> Just GL_MAP2_GRID_DOMAIN+        -- Fog+        GetFogColor -> Just GL_FOG_COLOR+        -- Framebuffer+        GetColorClearValue -> Just GL_COLOR_CLEAR_VALUE+        GetAccumClearValue -> Just GL_ACCUM_CLEAR_VALUE+        -- RasterPos+        GetCurrentRasterColor -> Just GL_CURRENT_RASTER_COLOR+        GetCurrentRasterSecondaryColor -> Just GL_CURRENT_RASTER_SECONDARY_COLOR+        GetCurrentRasterTextureCoords -> Just GL_CURRENT_RASTER_TEXTURE_COORDS+        GetCurrentRasterPosition -> Just GL_CURRENT_RASTER_POSITION+        -- PerFragment+        GetBlendColor -> Just GL_BLEND_COLOR+        -- Tessellation+        GetPatchDefaultOuterLevel -> Just GL_PATCH_DEFAULT_OUTER_LEVEL++-- 0x3000 through 0x3FFF are reserved for clip planes+clipPlaneIndexToEnum :: GLsizei -> Maybe GLenum+clipPlaneIndexToEnum i+   | 0 <= i && i <= maxClipPlaneIndex = Just (GL_CLIP_DISTANCE0 + fromIntegral i)+   | otherwise = Nothing++maxClipPlaneIndex :: GLsizei+maxClipPlaneIndex = 0xFFF++-----------------------------------------------------------------------------++data PNameNI+    = GetCompressedTextureFormats+    | GetShaderBinaryFormats+    | GetProgramBinaryFormats++instance GetPNameNI PNameNI where++instance GetPName   PNameNI where+   marshalGetPName pn = case pn of+      GetCompressedTextureFormats -> Just GL_COMPRESSED_TEXTURE_FORMATS+      GetShaderBinaryFormats -> Just GL_SHADER_BINARY_FORMATS+      GetProgramBinaryFormats -> Just GL_PROGRAM_BINARY_FORMATS++-----------------------------------------------------------------------------++data PNameMatrix+    -- coordtrans+    = GetModelviewMatrix+    | GetProjectionMatrix+    | GetTextureMatrix+    | GetColorMatrix+    | GetMatrixPalette++instance GetPNameMatrix PNameMatrix where++instance GetPName PNameMatrix where+    marshalGetPName pn = case pn of+        -- coordtrans+        GetModelviewMatrix -> Just GL_MODELVIEW_MATRIX+        GetProjectionMatrix -> Just GL_PROJECTION_MATRIX+        GetTextureMatrix -> Just GL_TEXTURE_MATRIX+        GetColorMatrix -> Just GL_COLOR_MATRIX+        GetMatrixPalette -> Just GL_MATRIX_PALETTE_ARB++--------------------------------------------------------------------------------++data GetPointervPName =+   -- core profile+     DebugCallbackFunction+   | DebugCallbackUserParam+   -- compatibility profile+   | SelectionBufferPointer+   | FeedbackBufferPointer+   | VertexArrayPointer+   | NormalArrayPointer+   | ColorArrayPointer+   | SecondaryColorArrayPointer+   | IndexArrayPointer+   | TextureCoordArrayPointer+   | FogCoordArrayPointer+   | EdgeFlagArrayPointer+   -- GL_ARB_vertex_blend+   | WeightArrayPointer+   -- GL_ARB_matrix_palette+   | MatrixIndexArrayPointer++marshalGetPointervPName :: GetPointervPName -> GLenum+marshalGetPointervPName x = case x of+   DebugCallbackFunction -> GL_DEBUG_CALLBACK_FUNCTION+   DebugCallbackUserParam -> GL_DEBUG_CALLBACK_USER_PARAM+   SelectionBufferPointer -> GL_SELECTION_BUFFER_POINTER+   FeedbackBufferPointer -> GL_FEEDBACK_BUFFER_POINTER+   VertexArrayPointer -> GL_VERTEX_ARRAY_POINTER+   NormalArrayPointer -> GL_NORMAL_ARRAY_POINTER+   ColorArrayPointer -> GL_COLOR_ARRAY_POINTER+   SecondaryColorArrayPointer -> GL_SECONDARY_COLOR_ARRAY_POINTER+   IndexArrayPointer -> GL_INDEX_ARRAY_POINTER+   TextureCoordArrayPointer -> GL_TEXTURE_COORD_ARRAY_POINTER+   FogCoordArrayPointer -> GL_FOG_COORD_ARRAY_POINTER+   EdgeFlagArrayPointer -> GL_EDGE_FLAG_ARRAY_POINTER+   WeightArrayPointer -> GL_WEIGHT_ARRAY_POINTER_ARB+   MatrixIndexArrayPointer -> GL_MATRIX_INDEX_ARRAY_POINTER_ARB++--------------------------------------------------------------------------------++getPointer :: GetPointervPName -> IO (Ptr a)+getPointer n = with nullPtr $ \buf -> do+   glGetPointerv (marshalGetPointervPName n) buf+   peek buf
+ src/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs view
@@ -0,0 +1,98 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib+-- Copyright   :  (c) Sven Panne 2009-2019, Lars Corbijn 2009-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib (+    AttribLocation(..), GetVertexAttribPName(..),+    getVertexAttribInteger1, getVertexAttribEnum1, getVertexAttribBoolean1,+    getVertexAttribFloat4, getVertexAttribIInteger4, getVertexAttribIuInteger4,+    GetVertexAttribPointerPName(..), getVertexAttribPointer+) where++import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.GL++--------------------------------------------------------------------------------++newtype AttribLocation = AttribLocation GLuint+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data GetVertexAttribPName =+     GetVertexAttribArrayEnabled+   | GetVertexAttribArraySize+   | GetVertexAttribArrayStride+   | GetVertexAttribArrayType+   | GetVertexAttribArrayNormalized+   | GetCurrentVertexAttrib+   | GetVertexAttribArrayBufferBinding+   | GetVertexAttribArrayInteger++marshalGetVertexAttribPName :: GetVertexAttribPName -> GLenum+marshalGetVertexAttribPName x = case x of+   GetVertexAttribArrayEnabled -> GL_VERTEX_ATTRIB_ARRAY_ENABLED+   GetVertexAttribArraySize -> GL_VERTEX_ATTRIB_ARRAY_SIZE+   GetVertexAttribArrayStride -> GL_VERTEX_ATTRIB_ARRAY_STRIDE+   GetVertexAttribArrayType -> GL_VERTEX_ATTRIB_ARRAY_TYPE+   GetVertexAttribArrayNormalized -> GL_VERTEX_ATTRIB_ARRAY_NORMALIZED+   GetCurrentVertexAttrib -> GL_CURRENT_VERTEX_ATTRIB+   GetVertexAttribArrayBufferBinding -> GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING+   GetVertexAttribArrayInteger -> GL_VERTEX_ATTRIB_ARRAY_INTEGER++--------------------------------------------------------------------------------++getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribInteger1 f (AttribLocation location) n = with 0 $ \buf -> do+   glGetVertexAttribiv location (marshalGetVertexAttribPName n) buf+   peek1 f buf++getVertexAttribEnum1 :: (GLenum -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribEnum1 f = getVertexAttribInteger1 (f . fromIntegral)++getVertexAttribBoolean1 :: (GLboolean -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribBoolean1 f = getVertexAttribInteger1 (f . fromIntegral)++getVertexAttribFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribFloat4 f (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribfv location (marshalGetVertexAttribPName n) buf+   peek4 f buf++getVertexAttribIInteger4 :: (GLint -> GLint -> GLint -> GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribIInteger4 f (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribIiv location (marshalGetVertexAttribPName n) buf+   peek4 f buf++getVertexAttribIuInteger4 :: (GLuint -> GLuint -> GLuint -> GLuint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribIuInteger4 f (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribIuiv location (marshalGetVertexAttribPName n) buf+   peek4 f buf++--------------------------------------------------------------------------------++data GetVertexAttribPointerPName =+   VertexAttribArrayPointer++marshalGetVertexAttribPointerPName :: GetVertexAttribPointerPName -> GLenum+marshalGetVertexAttribPointerPName x = case x of+   VertexAttribArrayPointer -> GL_VERTEX_ATTRIB_ARRAY_POINTER++--------------------------------------------------------------------------------++getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a)+getVertexAttribPointer (AttribLocation location) n = with nullPtr $ \buf -> do+   glGetVertexAttribPointerv location (marshalGetVertexAttribPointerPName n) buf+   peek buf
+ src/Graphics/Rendering/OpenGL/GL/RasterPos.hs view
@@ -0,0 +1,187 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.RasterPos+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.13 (Current Raster Position) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++module Graphics.Rendering.OpenGL.GL.RasterPos (+   currentRasterPosition, RasterPosComponent, RasterPos(..),+   WindowPosComponent, WindowPos(..),+   currentRasterDistance, currentRasterColor, currentRasterSecondaryColor,+   currentRasterIndex, currentRasterTexCoords, currentRasterPositionValid,+   rasterPositionUnclipped+) where++import Data.StateVar+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++currentRasterPosition :: StateVar (Vertex4 GLfloat)+currentRasterPosition =+   makeStateVar (getFloat4 Vertex4 GetCurrentRasterPosition) rasterPos++--------------------------------------------------------------------------------++class RasterPosComponent a where+   rasterPos2 :: a -> a -> IO ()+   rasterPos3 :: a -> a -> a -> IO ()+   rasterPos4 :: a -> a -> a -> a -> IO ()++   rasterPos2v :: Ptr a -> IO ()+   rasterPos3v :: Ptr a -> IO ()+   rasterPos4v :: Ptr a -> IO ()++instance RasterPosComponent GLshort where+   rasterPos2 = glRasterPos2s+   rasterPos3 = glRasterPos3s+   rasterPos4 = glRasterPos4s++   rasterPos2v = glRasterPos2sv+   rasterPos3v = glRasterPos3sv+   rasterPos4v = glRasterPos4sv++instance RasterPosComponent GLint where+   rasterPos2 = glRasterPos2i+   rasterPos3 = glRasterPos3i+   rasterPos4 = glRasterPos4i++   rasterPos2v = glRasterPos2iv+   rasterPos3v = glRasterPos3iv+   rasterPos4v = glRasterPos4iv++instance RasterPosComponent GLfloat where+   rasterPos2 = glRasterPos2f+   rasterPos3 = glRasterPos3f+   rasterPos4 = glRasterPos4f++   rasterPos2v = glRasterPos2fv+   rasterPos3v = glRasterPos3fv+   rasterPos4v = glRasterPos4fv++instance RasterPosComponent GLdouble where+   rasterPos2 = glRasterPos2d+   rasterPos3 = glRasterPos3d+   rasterPos4 = glRasterPos4d++   rasterPos2v = glRasterPos2dv+   rasterPos3v = glRasterPos3dv+   rasterPos4v = glRasterPos4dv++--------------------------------------------------------------------------------++class RasterPos a where+   rasterPos  ::     a -> IO ()+   rasterPosv :: Ptr a -> IO ()++instance RasterPosComponent a => RasterPos (Vertex2 a) where+   rasterPos (Vertex2 x y) = rasterPos2 x y+   rasterPosv = rasterPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)++instance RasterPosComponent a => RasterPos (Vertex3 a) where+   rasterPos (Vertex3 x y z) = rasterPos3 x y z+   rasterPosv = rasterPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)++instance RasterPosComponent a => RasterPos (Vertex4 a) where+   rasterPos (Vertex4 x y z w) = rasterPos4 x y z w+   rasterPosv = rasterPos4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)++--------------------------------------------------------------------------------++class WindowPosComponent a where+   windowPos2 :: a -> a -> IO ()+   windowPos3 :: a -> a -> a -> IO ()++   windowPos2v :: Ptr a -> IO ()+   windowPos3v :: Ptr a -> IO ()++instance WindowPosComponent GLshort where+   windowPos2 = glWindowPos2s+   windowPos3 = glWindowPos3s++   windowPos2v = glWindowPos2sv+   windowPos3v = glWindowPos3sv++instance WindowPosComponent GLint where+   windowPos2 = glWindowPos2i+   windowPos3 = glWindowPos3i++   windowPos2v = glWindowPos2iv+   windowPos3v = glWindowPos3iv++instance WindowPosComponent GLfloat where+   windowPos2 = glWindowPos2f+   windowPos3 = glWindowPos3f++   windowPos2v = glWindowPos2fv+   windowPos3v = glWindowPos3fv++instance WindowPosComponent GLdouble where+   windowPos2 = glWindowPos2d+   windowPos3 = glWindowPos3d++   windowPos2v = glWindowPos2dv+   windowPos3v = glWindowPos3dv++--------------------------------------------------------------------------------++class WindowPos a where+   windowPos  ::     a -> IO ()+   windowPosv :: Ptr a -> IO ()++instance WindowPosComponent a => WindowPos (Vertex2 a) where+   windowPos (Vertex2 x y) = windowPos2 x y+   windowPosv = windowPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)++instance WindowPosComponent a => WindowPos (Vertex3 a) where+   windowPos (Vertex3 x y z) = windowPos3 x y z+   windowPosv = windowPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)++--------------------------------------------------------------------------------++currentRasterDistance :: GettableStateVar GLfloat+currentRasterDistance =+   makeGettableStateVar (getFloat1 id GetCurrentRasterDistance)++currentRasterColor :: GettableStateVar (Color4 GLfloat)+currentRasterColor =+   makeGettableStateVar (getFloat4 Color4 GetCurrentRasterColor)++currentRasterSecondaryColor :: GettableStateVar (Color4 GLfloat)+currentRasterSecondaryColor =+   makeGettableStateVar (getFloat4 Color4 GetCurrentRasterSecondaryColor)++currentRasterIndex :: GettableStateVar (Index1 GLint)+currentRasterIndex =+   makeGettableStateVar (getInteger1 Index1 GetCurrentRasterIndex)++currentRasterTexCoords :: GettableStateVar (TexCoord4 GLfloat)+currentRasterTexCoords =+   makeGettableStateVar (getFloat4 TexCoord4 GetCurrentRasterTextureCoords)++currentRasterPositionValid :: GettableStateVar Bool+currentRasterPositionValid =+   makeGettableStateVar+      (getBoolean1 unmarshalGLboolean GetCurrentRasterPositionValid)++--------------------------------------------------------------------------------++rasterPositionUnclipped :: StateVar Capability+rasterPositionUnclipped = makeCapability CapRasterPositionUnclipped
+ src/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs view
@@ -0,0 +1,103 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ReadCopyPixels+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 4.3 (Drawing, Reading, and Copying Pixels)+-- of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.ReadCopyPixels (+   -- * Reading Pixels+   readPixels, readBuffer,++   -- * Copying Pixels+   PixelCopyType(..), copyPixels,++   -- * Copying Pixels for framebuffers+   BlitBuffer(..), blitFramebuffer+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.BufferMode+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.Filter+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++readPixels :: Position -> Size -> PixelData a -> IO ()+readPixels (Position x y) (Size w h) pd =+   withPixelData pd $ glReadPixels x y w h++--------------------------------------------------------------------------------++readBuffer :: StateVar BufferMode+readBuffer =+   makeStateVar+      (getEnum1 unmarshalBufferMode GetReadBuffer)+      (maybe recordInvalidValue glReadBuffer . marshalBufferMode)++--------------------------------------------------------------------------------++data PixelCopyType =+     CopyColor+   | CopyDepth+   | CopyStencil+   deriving ( Eq, Ord, Show )++marshalPixelCopyType :: PixelCopyType -> GLenum+marshalPixelCopyType x = case x of+   CopyColor -> GL_COLOR+   CopyDepth -> GL_DEPTH+   CopyStencil -> GL_STENCIL++--------------------------------------------------------------------------------++copyPixels :: Position -> Size -> PixelCopyType -> IO ()+copyPixels (Position x y) (Size w h) t =+   glCopyPixels x y w h (marshalPixelCopyType t)++--------------------------------------------------------------------------------++-- | The buffers which can be copied with 'blitFramebuffer'.++data BlitBuffer =+     ColorBuffer'+   | StencilBuffer'+   | DepthBuffer'+   deriving ( Eq, Ord, Show )++marshalBlitBuffer :: BlitBuffer -> GLbitfield+marshalBlitBuffer x = case x of+   ColorBuffer' -> GL_COLOR_BUFFER_BIT+   StencilBuffer' -> GL_STENCIL_BUFFER_BIT+   DepthBuffer' -> GL_DEPTH_BUFFER_BIT++--------------------------------------------------------------------------------++blitFramebuffer :: Position+                -> Position+                -> Position+                -> Position+                -> [BlitBuffer]+                -> TextureFilter+                -> IO ()+blitFramebuffer (Position sx0 sy0)+                (Position sx1 sy1)+                (Position dx0 dy0)+                (Position dx1 dy1)+                buffers+                filt =+   glBlitFramebuffer sx0 sy0 sx1 sy1 dx0 dy0 dx1 dy1+                     (sum (map marshalBlitBuffer buffers))+                     (fromIntegral (marshalMagnificationFilter filt))
+ src/Graphics/Rendering/OpenGL/GL/Rectangles.hs view
@@ -0,0 +1,65 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Rectangles+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 10.9 (Rectangles) of the OpenGL 4.4 specs.+--+--------------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++module Graphics.Rendering.OpenGL.GL.Rectangles (+   Rect(..)+) where++import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.GL++--------------------------------------------------------------------------------++-- | 'rect' and 'rectv' support efficient specification of rectangles as two+-- corner points. Each rectangle command takes four arguments, organized either+-- as two consecutive pairs of (/x/, /y/) coordinates, or as two pointers to+-- arrays, each containing an (/x/, /y/) pair. The resulting rectangle is+-- defined in the /z/ = 0 plane.+--+-- @'rect' ('Vertex2' x1 y1) ('Vertex2' x2, y2)@ is exactly equivalent to the+-- following sequence:+--+-- @+--    'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' 'Graphics.Rendering.OpenGL.GL.BeginEnd.Polygon' $ do+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y1)+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y1)+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y2)+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y2)+-- @+--+-- Note that if the second vertex is above and to the right of the first vertex,+-- the rectangle is constructed with a counterclockwise winding.++class Rect a where+   rect  :: Vertex2 a -> Vertex2 a -> IO ()+   rectv :: Ptr     a -> Ptr     a -> IO ()++instance Rect GLshort where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRects x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectsv ptr1 ptr2++instance Rect GLint where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRecti x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectiv ptr1 ptr2++instance Rect GLfloat where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectf x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectfv ptr1 ptr2++instance Rect GLdouble where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectd x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectdv ptr1 ptr2
+ src/Graphics/Rendering/OpenGL/GL/RenderMode.hs view
@@ -0,0 +1,60 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.RenderMode+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module related to the current render mode.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.RenderMode (+   RenderMode(..), withRenderMode, renderMode+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++data RenderMode =+     Render+   | Feedback+   | Select+   deriving ( Eq, Ord, Show )++marshalRenderMode :: RenderMode -> GLenum+marshalRenderMode x = case x of+   Render -> GL_RENDER+   Feedback -> GL_FEEDBACK+   Select -> GL_SELECT++unmarshalRenderMode :: GLenum -> RenderMode+unmarshalRenderMode x+   | x == GL_RENDER = Render+   | x == GL_FEEDBACK = Feedback+   | x == GL_SELECT = Select+   | otherwise = error ("unmarshalRenderMode: illegal value " ++ show x)++--------------------------------------------------------------------------------++withRenderMode :: RenderMode -> IO a -> IO (a, GLint)+withRenderMode newMode action = do+   oldMode <- get renderMode+   _ <- setRenderMode newMode+   action `finallyRet` setRenderMode oldMode++setRenderMode :: RenderMode -> IO GLint+setRenderMode = glRenderMode . marshalRenderMode++--------------------------------------------------------------------------------++renderMode :: GettableStateVar RenderMode+renderMode = makeGettableStateVar $ getEnum1 unmarshalRenderMode GetRenderMode
+ src/Graphics/Rendering/OpenGL/GL/SavingState.hs view
@@ -0,0 +1,105 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.SavingState+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 6.1.14 (Saving and Restoring State) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.SavingState (+   ServerAttributeGroup(..), preservingAttrib,+   ClientAttributeGroup(..), preservingClientAttrib+) where++import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )+import Graphics.GL++--------------------------------------------------------------------------------++data ServerAttributeGroup =+     CurrentAttributes+   | PointAttributes+   | LineAttributes+   | PolygonAttributes+   | PolygonStippleAttributes+   | PixelModeAttributes+   | LightingAttributes+   | FogAttributes+   | DepthBufferAttributes+   | AccumBufferAttributes+   | StencilBufferAttributes+   | ViewportAttributes+   | TransformAttributes+   | EnableAttributes+   | ColorBufferAttributes+   | HintAttributes+   | EvalAttributes+   | ListAttributes+   | TextureAttributes+   | ScissorAttributes+   | MultisampleAttributes+   | AllServerAttributes+   deriving ( Eq, Ord, Show )++marshalServerAttributeGroup :: ServerAttributeGroup -> GLbitfield+marshalServerAttributeGroup x = case x of+   CurrentAttributes -> GL_CURRENT_BIT+   PointAttributes -> GL_POINT_BIT+   LineAttributes -> GL_LINE_BIT+   PolygonAttributes -> GL_POLYGON_BIT+   PolygonStippleAttributes -> GL_POLYGON_STIPPLE_BIT+   PixelModeAttributes -> GL_PIXEL_MODE_BIT+   LightingAttributes -> GL_LIGHTING_BIT+   FogAttributes -> GL_FOG_BIT+   DepthBufferAttributes -> GL_DEPTH_BUFFER_BIT+   AccumBufferAttributes -> GL_ACCUM_BUFFER_BIT+   StencilBufferAttributes -> GL_STENCIL_BUFFER_BIT+   ViewportAttributes -> GL_VIEWPORT_BIT+   TransformAttributes -> GL_TRANSFORM_BIT+   EnableAttributes -> GL_ENABLE_BIT+   ColorBufferAttributes -> GL_COLOR_BUFFER_BIT+   HintAttributes -> GL_HINT_BIT+   EvalAttributes -> GL_EVAL_BIT+   ListAttributes -> GL_LIST_BIT+   TextureAttributes -> GL_TEXTURE_BIT+   ScissorAttributes -> GL_SCISSOR_BIT+   MultisampleAttributes -> GL_MULTISAMPLE_BIT+   AllServerAttributes -> GL_ALL_ATTRIB_BITS++--------------------------------------------------------------------------------++preservingAttrib :: [ServerAttributeGroup] -> IO a -> IO a+preservingAttrib groups = bracket_ (pushAttrib groups) glPopAttrib++pushAttrib :: [ServerAttributeGroup] -> IO ()+pushAttrib = glPushAttrib . sum . map marshalServerAttributeGroup++--------------------------------------------------------------------------------++data ClientAttributeGroup =+     PixelStoreAttributes+   | VertexArrayAttributes+   | AllClientAttributes+   deriving ( Eq, Ord, Show )++marshalClientAttributeGroup :: ClientAttributeGroup -> GLbitfield+marshalClientAttributeGroup x = case x of+   PixelStoreAttributes -> GL_CLIENT_PIXEL_STORE_BIT+   VertexArrayAttributes -> GL_CLIENT_VERTEX_ARRAY_BIT+   AllClientAttributes -> GL_CLIENT_ALL_ATTRIB_BITS++--------------------------------------------------------------------------------++preservingClientAttrib :: [ClientAttributeGroup] -> IO a -> IO a+preservingClientAttrib groups =+   bracket_ (pushClientAttrib groups) glPopClientAttrib++pushClientAttrib :: [ClientAttributeGroup] -> IO ()+pushClientAttrib = glPushClientAttrib . sum . map marshalClientAttributeGroup
+ src/Graphics/Rendering/OpenGL/GL/Selection.hs view
@@ -0,0 +1,88 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Selection+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 5.2 (Selection) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Selection (+   HitRecord(..), getHitRecords,+   Name(..), withName, loadName, maxNameStackDepth, nameStackDepth,+   RenderMode(..), renderMode+) where++import Data.StateVar+import Foreign.Marshal.Array+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.IOState+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.RenderMode+import Graphics.GL++--------------------------------------------------------------------------------++data HitRecord = HitRecord GLfloat GLfloat [Name]+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++getHitRecords :: GLsizei -> IO a -> IO (a, Maybe [HitRecord])+getHitRecords bufSize action =+   allocaArray (fromIntegral bufSize) $ \buf -> do+      glSelectBuffer bufSize buf+      (value, numHits) <- withRenderMode Select $ do+         glInitNames+         action+      hits <- parseSelectionBuffer numHits buf+      return (value, hits)++--------------------------------------------------------------------------------++parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])+parseSelectionBuffer numHits buf+   | numHits < 0 = return Nothing+   | otherwise = fmap Just $ evalIOState (nTimes numHits parseSelectionHit) buf++type Parser a = IOState GLuint a++parseSelectionHit :: Parser HitRecord+parseSelectionHit = do+   numNames <- parseGLuint+   minZ <- parseGLfloat+   maxZ <- parseGLfloat+   nameStack <- nTimes numNames parseName+   return $ HitRecord minZ maxZ nameStack++parseGLuint :: Parser GLuint+parseGLuint = peekIOState++parseGLfloat :: Parser GLfloat+parseGLfloat = fmap (\x -> fromIntegral x / 0xffffffff) parseGLuint++parseName :: Parser Name+parseName = fmap Name parseGLuint++--------------------------------------------------------------------------------++newtype Name = Name GLuint+   deriving ( Eq, Ord, Show )++withName :: Name -> IO a -> IO a+withName (Name name) = bracket_ (glPushName name) glPopName++loadName :: Name -> IO ()+loadName (Name n) = glLoadName n++maxNameStackDepth :: GettableStateVar GLsizei+maxNameStackDepth = makeGettableStateVar (getSizei1 id GetMaxNameStackDepth)++nameStackDepth :: GettableStateVar GLsizei+nameStackDepth = makeGettableStateVar (getSizei1 id GetNameStackDepth)
+ src/Graphics/Rendering/OpenGL/GL/Shaders.hs view
@@ -0,0 +1,32 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 7 (Programs and Shaders) of the OpenGL 4.4+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders (+   module Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects,+   module Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries,+   module Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects,+   module Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries,+   module Graphics.Rendering.OpenGL.GL.Shaders.Attribs,+   module Graphics.Rendering.OpenGL.GL.Shaders.Uniform,+   module Graphics.Rendering.OpenGL.GL.Shaders.Limits+) where++import Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects+import Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries+import Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects+import Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries+import Graphics.Rendering.OpenGL.GL.Shaders.Attribs+import Graphics.Rendering.OpenGL.GL.Shaders.Uniform+import Graphics.Rendering.OpenGL.GL.Shaders.Limits
+ src/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs view
@@ -0,0 +1,61 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Attribs+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module contains functions related to shader attributes, corresponding+-- to section 2.20.3 of the OpenGL 3.1 spec (Shader Variables).+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.Attribs (+   attribLocation, VariableType(..), activeAttribs,+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Program+import Graphics.Rendering.OpenGL.GL.Shaders.Variables+import Graphics.GL++--------------------------------------------------------------------------------++activeAttributes :: Program -> GettableStateVar GLuint+activeAttributes = programVar1 fromIntegral ActiveAttributes++activeAttributeMaxLength :: Program -> GettableStateVar GLsizei+activeAttributeMaxLength = programVar1 fromIntegral ActiveAttributeMaxLength++--------------------------------------------------------------------------------++attribLocation :: Program -> String -> StateVar AttribLocation+attribLocation program name =+   makeStateVar (getAttribLocation program name)+                (\location -> bindAttribLocation program location name)++getAttribLocation :: Program -> String -> IO AttribLocation+getAttribLocation (Program program) name =+   fmap (AttribLocation . fromIntegral) $+      withGLstring name $+         glGetAttribLocation program++bindAttribLocation :: Program -> AttribLocation -> String -> IO ()+bindAttribLocation (Program program) (AttribLocation location) name =+   withGLstring name $+      glBindAttribLocation program location++--------------------------------------------------------------------------------++activeAttribs :: Program -> GettableStateVar [(GLint,VariableType,String)]+activeAttribs =+   activeVars+      activeAttributes+      activeAttributeMaxLength+      glGetActiveAttrib+      unmarshalVariableType
+ src/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs view
@@ -0,0 +1,80 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Limits+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module contains functions related to shader limits.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.Limits (+   maxVertexTextureImageUnits, maxTextureImageUnits,+   maxCombinedTextureImageUnits, maxTextureCoords, maxVertexUniformComponents,+   maxFragmentUniformComponents, maxVertexAttribs, maxVaryingFloats+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++-----------------------------------------------------------------------------++-- | Contains the number of hardware units that can be used to access texture+-- maps from the vertex processor. The minimum legal value is 0.++maxVertexTextureImageUnits :: GettableStateVar GLsizei+maxVertexTextureImageUnits = getLimit GetMaxVertexTextureImageUnits++-- | Contains the total number of hardware units that can be used to access+-- texture maps from the fragment processor. The minimum legal value is 2.++maxTextureImageUnits :: GettableStateVar GLsizei+maxTextureImageUnits = getLimit GetMaxTextureImageUnits++-- | Contains the total number of hardware units that can be used to access+-- texture maps from the vertex processor and the fragment processor combined.+-- Note: If the vertex shader and the fragment processing stage access the same+-- texture image unit, then that counts as using two texture image units. The+-- minimum legal value is 2.++maxCombinedTextureImageUnits :: GettableStateVar GLsizei+maxCombinedTextureImageUnits = getLimit GetMaxCombinedTextureImageUnits++-- | Contains the number of texture coordinate sets that are available. The+-- minimum legal value is 2.++maxTextureCoords :: GettableStateVar GLsizei+maxTextureCoords = getLimit GetMaxTextureCoords++-- | Contains the number of individual components (i.e., floating-point, integer+-- or boolean values) that are available for vertex shader uniform variables.+-- The minimum legal value is 512.+maxVertexUniformComponents :: GettableStateVar GLsizei+maxVertexUniformComponents = getLimit GetMaxVertexUniformComponents++-- | Contains the number of individual components (i.e., floating-point, integer+-- or boolean values) that are available for fragment shader uniform variables.+-- The minimum legal value is 64.++maxFragmentUniformComponents :: GettableStateVar GLsizei+maxFragmentUniformComponents = getLimit GetMaxFragmentUniformComponents++-- | Contains the number of active vertex attributes that are available. The+-- minimum legal value is 16.++maxVertexAttribs :: GettableStateVar GLsizei+maxVertexAttribs = getLimit GetMaxVertexAttribs++-- | Contains the number of individual floating-point values available for+-- varying variables. The minimum legal value is 32.++maxVaryingFloats :: GettableStateVar GLsizei+maxVaryingFloats = getLimit GetMaxVaryingFloats++getLimit :: PName1I -> GettableStateVar GLsizei+getLimit = makeGettableStateVar . getSizei1 id
+ src/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs view
@@ -0,0 +1,120 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Program+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling program objects and related+-- queries.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.Program (+   Program(..),+   GetProgramPName(..), marshalGetProgramPName,+   programVar1, programVar3+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Data.StateVar+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( Ptr )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++newtype Program = Program { programID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName Program where+   isObjectName = liftIO . fmap unmarshalGLboolean . glIsProgram . programID+   deleteObjectName = liftIO . glDeleteProgram . programID++instance CanBeLabeled Program where+   objectLabel = objectNameLabel GL_PROGRAM . programID++--------------------------------------------------------------------------------++data GetProgramPName =+     ProgramDeleteStatus+   | LinkStatus+   | ValidateStatus+   | ProgramInfoLogLength+   | AttachedShaders+   | ActiveAttributes+   | ActiveAttributeMaxLength+   | ActiveUniforms+   | ActiveUniformMaxLength+   | TransformFeedbackBufferMode+   | TransformFeedbackVaryings+   | TransformFeedbackVaryingMaxLength+   | ActiveUniformBlocks+   | ActiveUniformBlockMaxNameLength+   | GeometryVerticesOut+   | GeometryInputType+   | GeometryOutputType+   | GeometryShaderInvocations+   | TessControlOutputVertices+   | TessGenMode+   | TessGenSpacing+   | TessGenVertexOrder+   | TessGenPointMode+   | ComputeWorkGroupSize  -- 3 integers!+   | ProgramSeparable+   | ProgramBinaryRetrievableHint+   | ActiveAtomicCounterBuffers+   | ProgramBinaryLength++marshalGetProgramPName :: GetProgramPName -> GLenum+marshalGetProgramPName x = case x of+   ProgramDeleteStatus -> GL_DELETE_STATUS+   LinkStatus -> GL_LINK_STATUS+   ValidateStatus -> GL_VALIDATE_STATUS+   ProgramInfoLogLength -> GL_INFO_LOG_LENGTH+   AttachedShaders -> GL_ATTACHED_SHADERS+   ActiveAttributes -> GL_ACTIVE_ATTRIBUTES+   ActiveAttributeMaxLength -> GL_ACTIVE_ATTRIBUTE_MAX_LENGTH+   ActiveUniforms -> GL_ACTIVE_UNIFORMS+   ActiveUniformMaxLength -> GL_ACTIVE_UNIFORM_MAX_LENGTH+   TransformFeedbackBufferMode -> GL_TRANSFORM_FEEDBACK_BUFFER_MODE+   TransformFeedbackVaryings -> GL_TRANSFORM_FEEDBACK_VARYINGS+   TransformFeedbackVaryingMaxLength -> GL_TRANSFORM_FEEDBACK_VARYING_MAX_LENGTH+   ActiveUniformBlocks -> GL_ACTIVE_UNIFORM_BLOCKS+   ActiveUniformBlockMaxNameLength -> GL_ACTIVE_UNIFORM_BLOCK_MAX_NAME_LENGTH+   GeometryVerticesOut -> GL_GEOMETRY_VERTICES_OUT+   GeometryInputType -> GL_GEOMETRY_INPUT_TYPE+   GeometryOutputType -> GL_GEOMETRY_OUTPUT_TYPE+   GeometryShaderInvocations -> GL_GEOMETRY_SHADER_INVOCATIONS+   TessControlOutputVertices -> GL_TESS_CONTROL_OUTPUT_VERTICES+   TessGenMode -> GL_TESS_GEN_MODE+   TessGenSpacing -> GL_TESS_GEN_SPACING+   TessGenVertexOrder -> GL_TESS_GEN_VERTEX_ORDER+   TessGenPointMode -> GL_TESS_GEN_POINT_MODE+   ComputeWorkGroupSize -> GL_COMPUTE_WORK_GROUP_SIZE+   ProgramSeparable -> GL_PROGRAM_SEPARABLE+   ProgramBinaryRetrievableHint -> GL_PROGRAM_BINARY_RETRIEVABLE_HINT+   ActiveAtomicCounterBuffers -> GL_ACTIVE_ATOMIC_COUNTER_BUFFERS+   ProgramBinaryLength -> GL_PROGRAM_BINARY_LENGTH++programVar1 :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a+programVar1 = programVarN . peek1++programVar3 :: (GLint -> GLint -> GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a+programVar3 = programVarN . peek3++programVarN :: (Ptr GLint -> IO a) -> GetProgramPName -> Program -> GettableStateVar a+programVarN f p program =+   makeGettableStateVar $+      with 0 $ \buf -> do+         glGetProgramiv (programID program) (marshalGetProgramPName p) buf+         f buf
+ src/Graphics/Rendering/OpenGL/GL/Shaders/ProgramBinaries.hs view
@@ -0,0 +1,63 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 7.5 (Program Binaries) of the OpenGL 4.4+-- spec.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries (+   ProgramBinaryFormat(..), programBinaryFormats,+   ProgramBinary(..), programBinary+) where++import Data.StateVar+import Foreign.Marshal.Alloc+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Program+import Graphics.GL++--------------------------------------------------------------------------------++newtype ProgramBinaryFormat = ProgramBinaryFormat GLenum+   deriving ( Eq, Ord, Show )++programBinaryFormats :: GettableStateVar [ProgramBinaryFormat]+programBinaryFormats =+   makeGettableStateVar $ do+      n <- getInteger1 fromIntegral GetNumProgramBinaryFormats+      getEnumN ProgramBinaryFormat GetProgramBinaryFormats n++data ProgramBinary = ProgramBinary ProgramBinaryFormat ByteString+   deriving ( Eq, Ord, Show )++programBinary :: Program -> StateVar ProgramBinary+programBinary program =+   makeStateVar (getProgramBinary program) (setProgramBinary program)++getProgramBinary :: Program -> IO ProgramBinary+getProgramBinary program =+   alloca $ \formatBuf -> do+      let getBin = bind4th formatBuf (glGetProgramBinary . programID)+      bs <- stringQuery programBinaryLength getBin program+      format <- peek1 ProgramBinaryFormat formatBuf+      return $ ProgramBinary format bs++bind4th :: d -> (a -> b -> c -> d -> e) -> (a -> b -> c -> e)+bind4th x = ((.) . (.) . (.)) ($ x)++setProgramBinary :: Program -> ProgramBinary -> IO ()+setProgramBinary program (ProgramBinary (ProgramBinaryFormat format) bs) = do+   withByteString bs $ glProgramBinary (programID program) format++programBinaryLength :: Program -> GettableStateVar GLsizei+programBinaryLength = programVar1 fromIntegral ProgramBinaryLength
+ src/Graphics/Rendering/OpenGL/GL/Shaders/ProgramObjects.hs view
@@ -0,0 +1,163 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 7.3 (Program Objects) of the OpenGL 4.4+-- spec.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects (+   -- * Program Objects+   Program, createProgram, programDeleteStatus,+   attachShader, detachShader, attachedShaders,+   linkProgram, linkStatus,+   validateProgram, validateStatus,+   programInfoLog,+   currentProgram,+   programSeparable, programBinaryRetrievableHint,++   -- TODOs:+   --    glCreateShaderProgramv+   --    ProgramInterface type (from 7.3.1)+   --    glGetProgramInterfaceiv+   --    glGetProgramResourceIndex+   --    glGetProgramResourceName+   --    glGetProgramResourceiv+   --    glGetProgramResourceLocation+   --    glGetProgramResourceLocationIndex++   -- * Fragment Data+   bindFragDataLocation, getFragDataLocation+) where++import Data.List+import Data.Maybe+import Data.StateVar+import Foreign.Marshal.Array+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.Framebuffer+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Program+import Graphics.Rendering.OpenGL.GL.Shaders.Shader+import Graphics.GL++--------------------------------------------------------------------------------++createProgram :: IO Program+createProgram = fmap Program glCreateProgram++--------------------------------------------------------------------------------++attachShader :: Program -> Shader -> IO ()+attachShader p s = glAttachShader (programID p) (shaderID s)++detachShader :: Program -> Shader -> IO ()+detachShader p s = glDetachShader (programID p) (shaderID s)++attachedShaders :: Program -> StateVar [Shader]+attachedShaders program =+   makeStateVar (getAttachedShaders program) (setAttachedShaders program)++getAttachedShaders :: Program -> IO [Shader]+getAttachedShaders program = do+   numShaders <- get (numAttachedShaders program)+   ids <- allocaArray (fromIntegral numShaders) $ \buf -> do+      glGetAttachedShaders (programID program) numShaders nullPtr buf+      peekArray (fromIntegral numShaders) buf+   return $ map Shader ids++setAttachedShaders :: Program -> [Shader] -> IO ()+setAttachedShaders program newShaders = do+   currentShaders <- getAttachedShaders program+   mapM_ (attachShader program) (newShaders \\ currentShaders)+   mapM_ (detachShader program) (currentShaders \\ newShaders)++--------------------------------------------------------------------------------++linkProgram :: Program -> IO ()+linkProgram = glLinkProgram . programID++currentProgram :: StateVar (Maybe Program)+currentProgram =+   makeStateVar+      (do p <- fmap Program $ getInteger1 fromIntegral GetCurrentProgram+          return $ if p == noProgram then Nothing else Just p)+      (glUseProgram . programID . fromMaybe noProgram)++noProgram :: Program+noProgram = Program 0++validateProgram :: Program -> IO ()+validateProgram = glValidateProgram . programID++programInfoLog :: Program -> GettableStateVar String+programInfoLog =+   makeGettableStateVar .+      fmap unpackUtf8 .+         stringQuery programInfoLogLength (glGetProgramInfoLog . programID)++--------------------------------------------------------------------------------++programSeparable :: Program -> StateVar Bool+programSeparable = programStateVarBool ProgramSeparable++programBinaryRetrievableHint :: Program -> StateVar Bool+programBinaryRetrievableHint = programStateVarBool ProgramBinaryRetrievableHint++programStateVarBool :: GetProgramPName -> Program -> StateVar Bool+programStateVarBool pname program =+   makeStateVar+      (get (programVar1 unmarshalGLboolean pname program))+      (glProgramParameteri (programID program)+                           (marshalGetProgramPName pname) . marshalGLboolean)++--------------------------------------------------------------------------------++programDeleteStatus :: Program -> GettableStateVar Bool+programDeleteStatus = programVar1 unmarshalGLboolean ProgramDeleteStatus++linkStatus :: Program -> GettableStateVar Bool+linkStatus = programVar1 unmarshalGLboolean LinkStatus++validateStatus :: Program -> GettableStateVar Bool+validateStatus = programVar1 unmarshalGLboolean ValidateStatus++programInfoLogLength :: Program -> GettableStateVar GLsizei+programInfoLogLength = programVar1 fromIntegral ProgramInfoLogLength++numAttachedShaders :: Program -> GettableStateVar GLsizei+numAttachedShaders = programVar1 fromIntegral AttachedShaders++--------------------------------------------------------------------------------++-- | 'bindFragDataLocation' binds a varying variable, specified by program and name, to a+-- drawbuffer. The effects only take place after succesfull linking of the program.+-- invalid arguments and conditions are+-- - an index larger than maxDrawBufferIndex+-- - names starting with 'gl_'+-- linking failure will ocure when+-- - one of the arguments was invalid+-- - more than one varying varuable name is bound to the same index+-- It's not an error to specify unused variables, those will be ingored.+bindFragDataLocation :: Program -> String -> SettableStateVar DrawBufferIndex+bindFragDataLocation (Program program) varName = makeSettableStateVar $ \ind ->+   withGLstring varName $ glBindFragDataLocation program ind++-- | query the binding of a given variable, specified by program and name. The program has to be+-- linked. The result is Nothing if an error occures or the name is not a name of a varying+-- variable. If the program hasn't been linked an 'InvalidOperation' error is generated.+getFragDataLocation :: Program -> String -> IO (Maybe DrawBufferIndex)+getFragDataLocation (Program program) varName = do+   r <- withGLstring varName $ glGetFragDataLocation program+   if r < 0+    then return Nothing+    else return . Just $ fromIntegral r
+ src/Graphics/Rendering/OpenGL/GL/Shaders/Shader.hs view
@@ -0,0 +1,37 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Shader+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling shader objects.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.Shader (+   Shader(..)+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++newtype Shader = Shader { shaderID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName Shader where+   isObjectName = liftIO . fmap unmarshalGLboolean . glIsShader . shaderID+   deleteObjectName = liftIO . glDeleteShader . shaderID++instance CanBeLabeled Shader where+   objectLabel = objectNameLabel GL_SHADER . shaderID
+ src/Graphics/Rendering/OpenGL/GL/Shaders/ShaderBinaries.hs view
@@ -0,0 +1,47 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 7.2 (Shader Binaries) of the OpenGL 4.4+-- spec.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries (+   ShaderBinaryFormat(..), shaderBinaryFormats,+   ShaderBinary(..), shaderBinary,+) where++import Data.StateVar+import Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Shader+import Graphics.GL++--------------------------------------------------------------------------------++newtype ShaderBinaryFormat = ShaderBinaryFormat GLenum+   deriving ( Eq, Ord, Show )++shaderBinaryFormats :: GettableStateVar [ShaderBinaryFormat]+shaderBinaryFormats =+   makeGettableStateVar $ do+      n <- getInteger1 fromIntegral GetNumShaderBinaryFormats+      getEnumN ShaderBinaryFormat GetShaderBinaryFormats n++data ShaderBinary = ShaderBinary ShaderBinaryFormat ByteString+   deriving ( Eq, Ord, Show )++shaderBinary :: [Shader] -> SettableStateVar ShaderBinary+shaderBinary shaders =+   makeSettableStateVar $ \(ShaderBinary (ShaderBinaryFormat format) bs) ->+      withArrayLen (map shaderID shaders) $ \numShaders shadersBuf ->+         withByteString bs $+            glShaderBinary (fromIntegral numShaders) shadersBuf format
+ src/Graphics/Rendering/OpenGL/GL/Shaders/ShaderObjects.hs view
@@ -0,0 +1,196 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 7.1 (Shader Objects) and 7.13 (Shader,+-- Program, and Program Pipeline Queries) of the OpenGL 4.4 spec.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects (+   -- * Shader Objects+   shaderCompiler,+   ShaderType(..), Shader, createShader,+   shaderSourceBS, shaderSource, compileShader, releaseShaderCompiler,++   -- * Shader Queries+   shaderType, shaderDeleteStatus, compileStatus, shaderInfoLog,+   PrecisionType, shaderPrecisionFormat,++   -- * Bytestring utilities+   packUtf8, unpackUtf8+) where++import Control.Monad+import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Shader+import Graphics.GL++--------------------------------------------------------------------------------++shaderCompiler :: GettableStateVar Bool+shaderCompiler =+   makeGettableStateVar (getBoolean1 unmarshalGLboolean GetShaderCompiler)++--------------------------------------------------------------------------------++data ShaderType =+     VertexShader+   | TessControlShader+   | TessEvaluationShader+   | GeometryShader+   | FragmentShader+   | ComputeShader+   deriving ( Eq, Ord, Show )++marshalShaderType :: ShaderType -> GLenum+marshalShaderType x = case x of+   VertexShader -> GL_VERTEX_SHADER+   TessControlShader -> GL_TESS_CONTROL_SHADER+   TessEvaluationShader -> GL_TESS_EVALUATION_SHADER+   GeometryShader -> GL_GEOMETRY_SHADER+   FragmentShader -> GL_FRAGMENT_SHADER+   ComputeShader -> GL_COMPUTE_SHADER++unmarshalShaderType :: GLenum -> ShaderType+unmarshalShaderType x+   | x == GL_VERTEX_SHADER = VertexShader+   | x == GL_TESS_CONTROL_SHADER = TessControlShader+   | x == GL_TESS_EVALUATION_SHADER = TessEvaluationShader+   | x == GL_GEOMETRY_SHADER = GeometryShader+   | x == GL_FRAGMENT_SHADER = FragmentShader+   | x == GL_COMPUTE_SHADER = ComputeShader+   | otherwise = error ("unmarshalShaderType: illegal value " ++ show x)++--------------------------------------------------------------------------------++createShader :: ShaderType -> IO Shader+createShader = fmap Shader . glCreateShader . marshalShaderType++--------------------------------------------------------------------------------++-- | UTF8 encoded.+shaderSourceBS :: Shader -> StateVar ByteString+shaderSourceBS shader =+   makeStateVar (getShaderSource shader) (setShaderSource shader)++getShaderSource :: Shader -> IO ByteString+getShaderSource = stringQuery shaderSourceLength (glGetShaderSource . shaderID)++shaderSourceLength :: Shader -> GettableStateVar GLsizei+shaderSourceLength = shaderVar fromIntegral ShaderSourceLength++setShaderSource :: Shader -> ByteString -> IO ()+setShaderSource shader src =+   withByteString src $ \srcPtr srcLength ->+      with srcPtr $ \srcPtrBuf ->+         with srcLength $ \srcLengthBuf ->+            glShaderSource (shaderID shader) 1 srcPtrBuf srcLengthBuf++{-# DEPRECATED shaderSource "Use a combination of 'shaderSourceBS' and 'packUtf8' or 'unpackUtf8' instead." #-}+shaderSource :: Shader -> StateVar [String]+shaderSource shader =+   makeStateVar+     (fmap ((:[]) . unpackUtf8) $ get (shaderSourceBS shader))+     ((shaderSourceBS shader $=) . packUtf8 . concat)++--------------------------------------------------------------------------------++compileShader :: Shader -> IO ()+compileShader = glCompileShader . shaderID++releaseShaderCompiler :: IO ()+releaseShaderCompiler = glReleaseShaderCompiler++--------------------------------------------------------------------------------++shaderType :: Shader -> GettableStateVar ShaderType+shaderType = shaderVar (unmarshalShaderType . fromIntegral) ShaderType++shaderDeleteStatus :: Shader -> GettableStateVar Bool+shaderDeleteStatus = shaderVar unmarshalGLboolean ShaderDeleteStatus++compileStatus :: Shader -> GettableStateVar Bool+compileStatus = shaderVar unmarshalGLboolean CompileStatus++shaderInfoLog :: Shader -> GettableStateVar String+shaderInfoLog =+   makeGettableStateVar .+      fmap unpackUtf8 .+         stringQuery shaderInfoLogLength (glGetShaderInfoLog . shaderID)++shaderInfoLogLength :: Shader -> GettableStateVar GLsizei+shaderInfoLogLength = shaderVar fromIntegral ShaderInfoLogLength++--------------------------------------------------------------------------------++data GetShaderPName =+     ShaderDeleteStatus+   | CompileStatus+   | ShaderInfoLogLength+   | ShaderSourceLength+   | ShaderType++marshalGetShaderPName :: GetShaderPName -> GLenum+marshalGetShaderPName x = case x of+   ShaderDeleteStatus -> GL_DELETE_STATUS+   CompileStatus -> GL_COMPILE_STATUS+   ShaderInfoLogLength -> GL_INFO_LOG_LENGTH+   ShaderSourceLength -> GL_SHADER_SOURCE_LENGTH+   ShaderType -> GL_SHADER_TYPE++shaderVar :: (GLint -> a) -> GetShaderPName -> Shader -> GettableStateVar a+shaderVar f p shader =+   makeGettableStateVar $+      with 0 $ \buf -> do+         glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf+         peek1 f buf++--------------------------------------------------------------------------------++data PrecisionType =+     LowFloat+   | MediumFloat+   | HighFloat+   | LowInt+   | MediumInt+   | HighInt+   deriving ( Eq, Ord, Show )++marshalPrecisionType :: PrecisionType -> GLenum+marshalPrecisionType x = case x of+   LowFloat -> GL_LOW_FLOAT+   MediumFloat -> GL_MEDIUM_FLOAT+   HighFloat -> GL_HIGH_FLOAT+   LowInt -> GL_LOW_INT+   MediumInt -> GL_MEDIUM_INT+   HighInt -> GL_HIGH_INT++--------------------------------------------------------------------------------++shaderPrecisionFormat :: ShaderType+                      -> PrecisionType+                      -> GettableStateVar ((GLint,GLint),GLint)+shaderPrecisionFormat st pt =+   makeGettableStateVar $+      allocaArray 2 $ \rangeBuf ->+         alloca $ \precisionBuf -> do+            glGetShaderPrecisionFormat (marshalShaderType st)+                                       (marshalPrecisionType pt)+                                       rangeBuf+                                       precisionBuf+            liftM2 (,) (peek2 (,) rangeBuf) (peek precisionBuf)
+ src/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Uniform+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module contains functions related to shader uniforms, this corresponds+-- to section 2.20.3 of the OpenGL 3.1 spec (Shader Variables).+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.Uniform (+   -- * Uniform variables+   UniformLocation(..), uniformLocation, activeUniforms, Uniform(..),+   UniformComponent,++   -- TODO: glGetUniformSubroutineuiv+) where++import Data.Maybe+import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.MatrixComponent+import Graphics.Rendering.OpenGL.GL.Shaders.Program+import Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects+import Graphics.Rendering.OpenGL.GL.Shaders.Variables+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++numActiveUniforms :: Program -> GettableStateVar GLuint+numActiveUniforms = programVar1 fromIntegral ActiveUniforms++activeUniformMaxLength :: Program -> GettableStateVar GLsizei+activeUniformMaxLength = programVar1 fromIntegral ActiveUniformMaxLength++--------------------------------------------------------------------------------++newtype UniformLocation = UniformLocation GLint+   deriving ( Eq, Ord, Show )++uniformLocation :: Program -> String -> GettableStateVar UniformLocation+uniformLocation (Program program) name =+   makeGettableStateVar $+      fmap UniformLocation $+         withGLstring name $+            glGetUniformLocation program++--------------------------------------------------------------------------------++activeUniforms :: Program -> GettableStateVar [(GLint,VariableType,String)]+activeUniforms =+   activeVars+      numActiveUniforms+      activeUniformMaxLength+      glGetActiveUniform+      unmarshalVariableType++--------------------------------------------------------------------------------++class Storable a => UniformComponent a where+   uniform1 :: UniformLocation -> a -> IO ()+   uniform2 :: UniformLocation -> a -> a -> IO ()+   uniform3 :: UniformLocation -> a -> a -> a -> IO ()+   uniform4 :: UniformLocation -> a -> a -> a -> a -> IO ()++   getUniform :: Storable (b a) => GLuint -> GLint -> Ptr (b a) -> IO ()++   uniform1v :: UniformLocation -> GLsizei -> Ptr a -> IO ()+   uniform2v :: UniformLocation -> GLsizei -> Ptr a -> IO ()+   uniform3v :: UniformLocation -> GLsizei -> Ptr a -> IO ()+   uniform4v :: UniformLocation -> GLsizei -> Ptr a -> IO ()++instance UniformComponent GLint where+   uniform1 (UniformLocation ul) = glUniform1i ul+   uniform2 (UniformLocation ul) = glUniform2i ul+   uniform3 (UniformLocation ul) = glUniform3i ul+   uniform4 (UniformLocation ul) = glUniform4i ul++   getUniform p ul = glGetUniformiv p ul . castPtr++   uniform1v (UniformLocation ul) = glUniform1iv ul+   uniform2v (UniformLocation ul) = glUniform2iv ul+   uniform3v (UniformLocation ul) = glUniform3iv ul+   uniform4v (UniformLocation ul) = glUniform4iv ul++instance UniformComponent GLuint where+   uniform1 (UniformLocation ul) = glUniform1ui ul+   uniform2 (UniformLocation ul) = glUniform2ui ul+   uniform3 (UniformLocation ul) = glUniform3ui ul+   uniform4 (UniformLocation ul) = glUniform4ui ul++   getUniform p ul = glGetUniformuiv p ul . castPtr++   uniform1v (UniformLocation ul) = glUniform1uiv ul+   uniform2v (UniformLocation ul) = glUniform2uiv ul+   uniform3v (UniformLocation ul) = glUniform3uiv ul+   uniform4v (UniformLocation ul) = glUniform4uiv ul++instance UniformComponent GLfloat where+   uniform1 (UniformLocation ul) = glUniform1f ul+   uniform2 (UniformLocation ul) = glUniform2f ul+   uniform3 (UniformLocation ul) = glUniform3f ul+   uniform4 (UniformLocation ul) = glUniform4f ul++   getUniform p ul = glGetUniformfv p ul . castPtr++   uniform1v (UniformLocation ul) = glUniform1fv ul+   uniform2v (UniformLocation ul) = glUniform2fv ul+   uniform3v (UniformLocation ul) = glUniform3fv ul+   uniform4v (UniformLocation ul) = glUniform4fv ul++instance UniformComponent GLdouble where+   uniform1 (UniformLocation ul) = glUniform1d ul+   uniform2 (UniformLocation ul) = glUniform2d ul+   uniform3 (UniformLocation ul) = glUniform3d ul+   uniform4 (UniformLocation ul) = glUniform4d ul++   getUniform p ul = glGetUniformdv p ul . castPtr++   uniform1v (UniformLocation ul) = glUniform1dv ul+   uniform2v (UniformLocation ul) = glUniform2dv ul+   uniform3v (UniformLocation ul) = glUniform3dv ul+   uniform4v (UniformLocation ul) = glUniform4dv ul++--------------------------------------------------------------------------------++class Uniform a where+   uniform :: UniformLocation -> StateVar a+   uniformv :: UniformLocation -> GLsizei -> Ptr a -> IO ()++maxComponentSize :: Int+maxComponentSize = sizeOf (undefined :: GLint) `max` sizeOf (undefined :: GLfloat)++maxNumComponents :: Int+maxNumComponents = 16++maxUniformBufferSize :: Int+maxUniformBufferSize = maxComponentSize * maxNumComponents++makeUniformVar :: (UniformComponent a, Storable (b a))+               => (UniformLocation -> b a -> IO ())+               -> UniformLocation -> StateVar (b a)+makeUniformVar setter location = makeStateVar getter (setter location)+   where getter = allocaBytes maxUniformBufferSize $ \buf -> do+                     getUniformWith getUniform location buf+                     peek buf++single :: (UniformLocation -> StateVar (Vertex1 a))+       -> (UniformLocation -> StateVar a)+single var location = makeStateVar (do Vertex1 x <- get (var location); return x)+                                   (\x -> var location $= Vertex1 x)++instance Uniform GLfloat where+   uniform = single uniform+   uniformv = uniform1v++instance Uniform GLint where+   uniform = single uniform+   uniformv = uniform1v++instance Uniform GLuint where+   uniform = single uniform+   uniformv = uniform1v++instance Uniform GLdouble where+   uniform = single uniform+   uniformv = uniform1v++instance UniformComponent a => Uniform (Vertex1 a) where+   uniform = makeUniformVar $ \location (Vertex1 x) -> uniform1 location x+   uniformv location count = uniform1v location count . (castPtr :: Ptr (Vertex1 b) -> Ptr b)++instance UniformComponent a => Uniform (Vertex2 a) where+   uniform = makeUniformVar $ \location (Vertex2 x y) -> uniform2 location x y+   uniformv location count = uniform2v location count . (castPtr :: Ptr (Vertex2 b) -> Ptr b)++instance UniformComponent a => Uniform (Vertex3 a) where+   uniform = makeUniformVar $ \location (Vertex3 x y z) -> uniform3 location x y z+   uniformv location count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b)++instance UniformComponent a => Uniform (Vertex4 a) where+   uniform = makeUniformVar $ \location (Vertex4 x y z w) -> uniform4 location x y z w+   uniformv location count = uniform4v location count . (castPtr :: Ptr (Vertex4 b) -> Ptr b)++instance UniformComponent a => Uniform (Vector1 a) where+   uniform = makeUniformVar $ \location (Vector1 x) -> uniform1 location x+   uniformv location count = uniform1v location count . (castPtr :: Ptr (Vector1 b) -> Ptr b)++instance UniformComponent a => Uniform (Vector2 a) where+   uniform = makeUniformVar $ \location (Vector2 x y) -> uniform2 location x y+   uniformv location count = uniform2v location count . (castPtr :: Ptr (Vector2 b) -> Ptr b)++instance UniformComponent a => Uniform (Vector3 a) where+   uniform = makeUniformVar $ \location (Vector3 x y z) -> uniform3 location x y z+   uniformv location count = uniform3v location count . (castPtr :: Ptr (Vector3 b) -> Ptr b)++instance UniformComponent a => Uniform (Vector4 a) where+   uniform = makeUniformVar $ \location (Vector4 x y z w) -> uniform4 location x y z w+   uniformv location count = uniform4v location count . (castPtr :: Ptr (Vector4 b) -> Ptr b)++instance UniformComponent a => Uniform (TexCoord1 a) where+   uniform = makeUniformVar $ \location (TexCoord1 s) -> uniform1 location s+   uniformv location count = uniform1v location count . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)++instance UniformComponent a => Uniform (TexCoord2 a) where+   uniform = makeUniformVar $ \location (TexCoord2 s t) -> uniform2 location s t+   uniformv location count = uniform2v location count . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)++instance UniformComponent a => Uniform (TexCoord3 a) where+   uniform = makeUniformVar $ \location (TexCoord3 s t r) -> uniform3 location s t  r+   uniformv location count = uniform3v location count . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)++instance UniformComponent a => Uniform (TexCoord4 a) where+   uniform = makeUniformVar $ \location (TexCoord4 s t r q) -> uniform4 location s t  r q+   uniformv location count = uniform4v location count . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)++instance UniformComponent a => Uniform (Normal3 a) where+   uniform = makeUniformVar $ \location (Normal3 x y z) -> uniform3 location x y z+   uniformv location count = uniform3v location count . (castPtr :: Ptr (Normal3 b) -> Ptr b)++instance UniformComponent a => Uniform (FogCoord1 a) where+   uniform = makeUniformVar $ \location (FogCoord1 c) -> uniform1 location c+   uniformv location count = uniform1v location count . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)++instance UniformComponent a => Uniform (Color3 a) where+   uniform = makeUniformVar $ \location (Color3 r g b) -> uniform3 location r g b+   uniformv location count = uniform3v location count . (castPtr :: Ptr (Color3 b) -> Ptr b)++instance UniformComponent a => Uniform (Color4 a) where+   uniform = makeUniformVar $ \location (Color4 r g b a) -> uniform4 location r g b a+   uniformv location count = uniform4v location count . (castPtr :: Ptr (Color4 b) -> Ptr b)++instance UniformComponent a => Uniform (Index1 a) where+   uniform = makeUniformVar $ \location (Index1 i) -> uniform1 location i+   uniformv location count = uniform1v location count . (castPtr :: Ptr (Index1 b) -> Ptr b)++-- Nasty instance declaration as TextureUnit is not of the form Storable (b a) as required for+-- getUniform. Even worse is that it requires the `GLint` uniforms while it is an enum or+-- uint.+instance Uniform TextureUnit where+    uniform loc = makeStateVar getter setter+        where getter = allocaBytes (sizeOf (undefined :: GLint))  $ \buf -> do+                          getUniformWith glGetUniformiv loc buf+                          fmap (TextureUnit . fromIntegral) $ peek buf+              setter (TextureUnit tu) = uniform1 loc (fromIntegral tu :: GLint)+    uniformv location count = uniform1v location count . (castPtr :: Ptr TextureUnit -> Ptr GLint)++-- | Note: 'uniformv' expects all matrices to be in 'ColumnMajor' form.+instance MatrixComponent a => Uniform (GLmatrix a) where+   uniform loc@(UniformLocation ul) = makeStateVar getter setter+      where getter = withNewMatrix ColumnMajor $ getUniformWith getUniformv loc+            setter m = withMatrix m $ uniformMatrix4v ul 1 . isRowMajor+   uniformv (UniformLocation ul) count buf =+      uniformMatrix4v ul count (marshalGLboolean False) (castPtr buf `asTypeOf` elemType buf)+      where elemType = undefined :: MatrixComponent c => Ptr (GLmatrix c) -> Ptr c++isRowMajor :: MatrixOrder -> GLboolean+isRowMajor = marshalGLboolean . (RowMajor ==)++getUniformWith :: (GLuint -> GLint -> Ptr a -> IO ()) -> UniformLocation -> Ptr a -> IO ()+getUniformWith getter (UniformLocation ul) buf = do+   program <- fmap (programID . fromJust) $ get currentProgram+   getter program ul buf++--------------------------------------------------------------------------------
+ src/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs view
@@ -0,0 +1,163 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Variables+-- Copyright   :  (c) Sven Panne 2006-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This internal module contains the functions and data types used by the+-- Uniform and Attribs modules.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Shaders.Variables (+    VariableType(..), unmarshalVariableType, activeVars+) where++import Control.Monad+import Data.StateVar+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.Shaders.Program+import Graphics.GL++--------------------------------------------------------------------------------++-- Table 2.9 of the OpenGL 3.1 spec: OpenGL Shading Language type tokens+data VariableType =+     Float'+   | FloatVec2+   | FloatVec3+   | FloatVec4+   | Int'+   | IntVec2+   | IntVec3+   | IntVec4+   | UnsignedInt'+   | UnsignedIntVec2+   | UnsignedIntVec3+   | UnsignedIntVec4+   | Bool+   | BoolVec2+   | BoolVec3+   | BoolVec4+   | FloatMat2+   | FloatMat3+   | FloatMat4+   | FloatMat2x3+   | FloatMat2x4+   | FloatMat3x2+   | FloatMat3x4+   | FloatMat4x2+   | FloatMat4x3+   | Sampler1D+   | Sampler2D+   | Sampler3D+   | SamplerCube+   | Sampler1DShadow+   | Sampler2DShadow+   | Sampler1DArray+   | Sampler2DArray+   | Sampler1DArrayShadow+   | Sampler2DArrayShadow+   | SamplerCubeShadow+   | Sampler2DRect+   | Sampler2DRectShadow+   | IntSampler1D+   | IntSampler2D+   | IntSampler3D+   | IntSamplerCube+   | IntSampler1DArray+   | IntSampler2DArray+   | UnsignedIntSampler1D+   | UnsignedIntSampler2D+   | UnsignedIntSampler3D+   | UnsignedIntSamplerCube+   | UnsignedIntSampler1DArray+   | UnsignedIntSampler2DArray+   deriving ( Eq, Ord, Show )++unmarshalVariableType :: GLenum -> VariableType+unmarshalVariableType x+   | x == GL_FLOAT = Float'+   | x == GL_FLOAT_VEC2 = FloatVec2+   | x == GL_FLOAT_VEC3 = FloatVec3+   | x == GL_FLOAT_VEC4 = FloatVec4+   | x == GL_INT = Int'+   | x == GL_INT_VEC2 = IntVec2+   | x == GL_INT_VEC3 = IntVec3+   | x == GL_INT_VEC4 = IntVec4+   | x == GL_UNSIGNED_INT = UnsignedInt'+   | x == GL_UNSIGNED_INT_VEC2 = UnsignedIntVec2+   | x == GL_UNSIGNED_INT_VEC3 = UnsignedIntVec3+   | x == GL_UNSIGNED_INT_VEC4 = UnsignedIntVec4+   | x == GL_BOOL = Bool+   | x == GL_BOOL_VEC2 = BoolVec2+   | x == GL_BOOL_VEC3 = BoolVec3+   | x == GL_BOOL_VEC4 = BoolVec4+   | x == GL_FLOAT_MAT2 = FloatMat2+   | x == GL_FLOAT_MAT3 = FloatMat3+   | x == GL_FLOAT_MAT4 = FloatMat4+   | x == GL_FLOAT_MAT2x3 = FloatMat2x3+   | x == GL_FLOAT_MAT2x4 = FloatMat2x4+   | x == GL_FLOAT_MAT3x2 = FloatMat3x2+   | x == GL_FLOAT_MAT3x4 = FloatMat3x4+   | x == GL_FLOAT_MAT4x2 = FloatMat4x2+   | x == GL_FLOAT_MAT4x3 = FloatMat4x3+   | x == GL_SAMPLER_1D = Sampler1D+   | x == GL_SAMPLER_2D = Sampler2D+   | x == GL_SAMPLER_3D = Sampler3D+   | x == GL_SAMPLER_CUBE = SamplerCube+   | x == GL_SAMPLER_1D_SHADOW = Sampler1DShadow+   | x == GL_SAMPLER_2D_SHADOW = Sampler2DShadow+   | x == GL_SAMPLER_1D_ARRAY = Sampler1DArray+   | x == GL_SAMPLER_2D_ARRAY = Sampler2DArray+   | x == GL_SAMPLER_1D_ARRAY_SHADOW = Sampler1DArrayShadow+   | x == GL_SAMPLER_2D_ARRAY_SHADOW = Sampler2DArrayShadow+   | x == GL_SAMPLER_CUBE_SHADOW = SamplerCubeShadow+   | x == GL_SAMPLER_2D_RECT = Sampler2DRect+   | x == GL_SAMPLER_2D_RECT_SHADOW = Sampler2DRectShadow+   | x == GL_INT_SAMPLER_1D = IntSampler1D+   | x == GL_INT_SAMPLER_2D = IntSampler2D+   | x == GL_INT_SAMPLER_3D = IntSampler3D+   | x == GL_INT_SAMPLER_CUBE = IntSamplerCube+   | x == GL_INT_SAMPLER_1D_ARRAY = IntSampler1DArray+   | x == GL_INT_SAMPLER_2D_ARRAY = IntSampler2DArray+   | x == GL_UNSIGNED_INT_SAMPLER_1D = UnsignedIntSampler1D+   | x == GL_UNSIGNED_INT_SAMPLER_2D = UnsignedIntSampler2D+   | x == GL_UNSIGNED_INT_SAMPLER_3D = UnsignedIntSampler3D+   | x == GL_UNSIGNED_INT_SAMPLER_CUBE = UnsignedIntSamplerCube+   | x == GL_UNSIGNED_INT_SAMPLER_1D_ARRAY = UnsignedIntSampler1DArray+   | x == GL_UNSIGNED_INT_SAMPLER_2D_ARRAY = UnsignedIntSampler2DArray+   | otherwise = error ("unmarshalVariableType: illegal value " ++ show x)++--------------------------------------------------------------------------------++activeVars :: (Program -> GettableStateVar GLuint)+           -> (Program -> GettableStateVar GLsizei)+           -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())+           -> (GLenum -> a)+           -> Program+           -> GettableStateVar [(GLint,a,String)]+activeVars numVars maxLength getter unmarshalType p@(Program program) =+   makeGettableStateVar $ do+      numActiveVars <- get (numVars p)+      maxLen <- get (maxLength p)+      with 0 $ \nameLengthBuf ->+         with 0 $ \sizeBuf ->+            with 0 $ \typeBuf ->+               let ixs = if numActiveVars > 0 then [0 .. numActiveVars-1] else []+               in forM ixs $ \i -> do+                  n <- createAndTrimByteString maxLen $ \nameBuf -> do+                     getter program i maxLen nameLengthBuf sizeBuf typeBuf nameBuf+                     peek nameLengthBuf+                  s <- peek1 fromIntegral sizeBuf+                  t <- peek1 unmarshalType typeBuf+                  return (s, t, unpackUtf8 n)
+ src/Graphics/Rendering/OpenGL/GL/StringQueries.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.StringQueries+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to parts of section 6.1.5 (String Queries) of the+-- OpenGL 3.2 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.StringQueries (+   vendor, renderer, glVersion, glExtensions, extensionSupported,+   shadingLanguageVersion, majorMinor, ContextProfile'(..), contextProfile+) where++import Data.Bits+import Data.Char+#if !MIN_VERSION_base(4,8,0)+import Data.Functor( (<$>), (<$) )+#endif+import Data.Set ( member, toList )+import Data.StateVar as S+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL+import Text.ParserCombinators.ReadP as R++--------------------------------------------------------------------------------++vendor :: GettableStateVar String+vendor = makeStringVar GL_VENDOR++renderer :: GettableStateVar String+renderer = makeStringVar GL_RENDERER++glVersion :: GettableStateVar String+glVersion = makeStringVar GL_VERSION++glExtensions :: GettableStateVar [String]+glExtensions = makeGettableStateVar (toList <$> getExtensions)++extensionSupported :: String -> GettableStateVar Bool+extensionSupported ext =+  makeGettableStateVar (getExtensions >>= (return . member ext))++shadingLanguageVersion :: GettableStateVar String+shadingLanguageVersion = makeStringVar GL_SHADING_LANGUAGE_VERSION++--------------------------------------------------------------------------------++data ContextProfile'+   = CoreProfile'+   | CompatibilityProfile'+   deriving ( Eq, Ord, Show )++marshalContextProfile' :: ContextProfile' -> GLbitfield+marshalContextProfile' x = case x of+   CoreProfile' -> GL_CONTEXT_CORE_PROFILE_BIT+   CompatibilityProfile' -> GL_CONTEXT_COMPATIBILITY_PROFILE_BIT++contextProfile :: GettableStateVar [ContextProfile']+contextProfile = makeGettableStateVar (getInteger1 i2cps GetContextProfileMask)++i2cps :: GLint -> [ContextProfile']+i2cps bitfield =+   [ c | c <- [ CoreProfile', CompatibilityProfile' ]+       , (fromIntegral bitfield .&. marshalContextProfile' c) /= 0 ]++--------------------------------------------------------------------------------++makeStringVar :: GLenum -> GettableStateVar String+makeStringVar = makeGettableStateVar . getStringWith . glGetString++--------------------------------------------------------------------------------++-- | A utility function to be used with e.g. 'glVersion' or+-- 'shadingLanguageVersion', transforming a variable containing a string of the+-- form /major.minor[optional rest]/ into a variable containing a numeric+-- major\/minor version. If the string is malformed, which should never happen+-- with a sane OpenGL implementation, it is transformed to @(-1,-1)@.++majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)+majorMinor =+  makeGettableStateVar . (runParser parseVersion (-1, -1) <$>) . S.get++--------------------------------------------------------------------------------+-- Copy from Graphics.Rendering.OpenGL.Raw.GetProcAddress... :-/++runParser :: ReadP a -> a -> String -> a+runParser parser failed str =+  case readP_to_S parser str of+    [(v, "")] -> v+    _ -> failed++-- This does quite a bit more than we need for "normal" OpenGL, but at least it+-- documents the convoluted format of the version string in detail.+parseVersion :: ReadP (Int, Int)+parseVersion = do+  _prefix <-+    -- Too lazy to define a type for the API...+    ("CL" <$ string "OpenGL ES-CL ") <++  -- OpenGL ES 1.x Common-Lite+    ("CM" <$ string "OpenGL ES-CM ") <++  -- OpenGL ES 1.x Common+    ("ES" <$ string "OpenGL ES "   ) <++  -- OpenGL ES 2.x or 3.x+    ("GL" <$ string ""             )      -- OpenGL+  major <- read <$> munch1 isDigit+  minor <- char '.' >> read <$> munch1 isDigit+  _release <- (char '.' >> munch1 (/= ' ')) <++ return ""+  _vendorStuff <- (char ' ' >> R.get `manyTill` eof) <++ ("" <$ eof)+  return (major, minor)
+ src/Graphics/Rendering/OpenGL/GL/SyncObjects.hs view
@@ -0,0 +1,118 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.SyncObjects+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 4.1 (Sync Objects and Fences) of the+-- OpenGL 4.4 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.SyncObjects (+   -- * Sync Objects and Fences+   SyncObject, syncGpuCommandsComplete,++   -- * Waiting for Sync Objects+   WaitTimeout, WaitFlag(..), WaitResult(..), clientWaitSync,+   waitSync, maxServerWaitTimeout,++   -- * Sync Object Queries+   SyncStatus(..), syncStatus+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Data.StateVar+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( nullPtr )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++newtype SyncObject = SyncObject { syncID :: GLsync }+   deriving ( Eq, Ord, Show )++instance ObjectName SyncObject where+   isObjectName = liftIO . fmap unmarshalGLboolean . glIsSync . syncID+   deleteObjectName = liftIO . glDeleteSync . syncID++instance CanBeLabeled SyncObject where+   objectLabel = objectPtrLabel . syncID++syncGpuCommandsComplete :: IO SyncObject+syncGpuCommandsComplete =+   fmap SyncObject $ glFenceSync GL_SYNC_GPU_COMMANDS_COMPLETE 0++--------------------------------------------------------------------------------++type WaitTimeout = GLuint64++--------------------------------------------------------------------------------++data WaitFlag = SyncFlushCommands+   deriving ( Eq, Ord, Show )++marshalWaitFlag :: WaitFlag -> GLbitfield+marshalWaitFlag x = case x of+   SyncFlushCommands -> GL_SYNC_FLUSH_COMMANDS_BIT++--------------------------------------------------------------------------------++data WaitResult =+     AlreadySignaled+   | TimeoutExpired+   | ConditionSatisfied+   | WaitFailed+   deriving ( Eq, Ord, Show )++unmarshalWaitResult :: GLenum -> WaitResult+unmarshalWaitResult x+   | x == GL_ALREADY_SIGNALED = AlreadySignaled+   | x == GL_TIMEOUT_EXPIRED = TimeoutExpired+   | x == GL_CONDITION_SATISFIED = ConditionSatisfied+   | x == GL_WAIT_FAILED = WaitFailed+   | otherwise = error ("unmarshalWaitResult: illegal value " ++ show x)++--------------------------------------------------------------------------------++clientWaitSync :: SyncObject -> [WaitFlag] -> WaitTimeout -> IO WaitResult+clientWaitSync syncObject flags =+   fmap unmarshalWaitResult .+      glClientWaitSync (syncID syncObject) (sum (map marshalWaitFlag flags))++waitSync :: SyncObject -> IO ()+waitSync syncObject =+   glWaitSync (syncID syncObject) 0 (fromIntegral GL_TIMEOUT_IGNORED)++maxServerWaitTimeout :: GettableStateVar WaitTimeout+maxServerWaitTimeout =+   makeGettableStateVar (getInteger64 fromIntegral GetMaxServerWaitTimeout)++--------------------------------------------------------------------------------++data SyncStatus =+     Unsignaled+   | Signaled+   deriving ( Eq, Ord, Show )++unmarshalSyncStatus :: GLenum -> SyncStatus+unmarshalSyncStatus x+   | x == GL_UNSIGNALED = Unsignaled+   | x == GL_SIGNALED = Signaled+   | otherwise = error ("unmarshalSyncStatus: illegal value " ++ show x)++syncStatus :: SyncObject -> GettableStateVar SyncStatus+syncStatus syncObject =+   makeGettableStateVar $+      with 0 $ \buf -> do+         glGetSynciv (syncID syncObject) GL_SYNC_STATUS 1 nullPtr buf+         peek1 (unmarshalSyncStatus . fromIntegral) buf
+ src/Graphics/Rendering/OpenGL/GL/Tensor.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE DeriveDataTypeable, CPP #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Tensor+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This package contains tensor data types and their instances for some basic+-- type classes.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Tensor (+   Vertex1(..), Vertex2(..), Vertex3(..), Vertex4(..),+   Vector1(..), Vector2(..), Vector3(..), Vector4(..)+) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ( Applicative(..) )+import Data.Foldable ( Foldable(..) )+#endif+import Control.Monad ( ap )+import Data.Foldable ( foldlM )+import Data.Ix ( Ix )+import Data.Traversable ( Traversable(..), mapAccumL )+import Data.Typeable ( Typeable )+import Foreign.Marshal.Array ( advancePtr )+import Foreign.Ptr ( Ptr, plusPtr, castPtr )+import Foreign.Storable ( Storable(..) )++--------------------------------------------------------------------------------++-- | A vertex with /y/=0, /z/=0 and /w/=1.+newtype Vertex1 a = Vertex1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vertex1 where+   fmap f (Vertex1 x) = Vertex1 (f x)++instance Applicative Vertex1 where+   pure a = Vertex1 a+   Vertex1 f <*> Vertex1 x = Vertex1 (f x)++instance Foldable Vertex1 where+   foldr f a (Vertex1 x) = x `f ` a+   foldl f a (Vertex1 x) = a `f` x+   foldr1 _ (Vertex1 x) = x+   foldl1 _ (Vertex1 x) = x++instance Traversable Vertex1 where+   traverse f (Vertex1 x) = pure Vertex1 <*> f x+   sequenceA (Vertex1 x) =  pure Vertex1 <*> x+   mapM f (Vertex1 x) = return Vertex1 `ap` f x+   sequence (Vertex1 x) = return Vertex1 `ap` x++instance Storable a => Storable (Vertex1 a) where+   sizeOf    ~(Vertex1 s) = sizeOf s+   alignment ~(Vertex1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A vertex with /z/=0 and /w/=1.+data Vertex2 a = Vertex2 !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vertex2 where+   fmap f (Vertex2 x y) = Vertex2 (f x) (f y)++instance Applicative Vertex2 where+   pure a = Vertex2 a a+   Vertex2 f g <*> Vertex2 x y = Vertex2 (f x) (g y)++instance Foldable Vertex2 where+   foldr f a (Vertex2 x y) = x `f ` (y `f` a)+   foldl f a (Vertex2 x y) = (a `f` x) `f` y+   foldr1 f (Vertex2 x y) = x `f` y+   foldl1 f (Vertex2 x y) = x `f` y++instance Traversable Vertex2 where+   traverse f (Vertex2 x y) = pure Vertex2 <*> f x <*> f y+   sequenceA (Vertex2 x y) =  pure Vertex2 <*> x <*> y+   mapM f (Vertex2 x y) = return Vertex2 `ap` f x `ap` f y+   sequence (Vertex2 x y) = return Vertex2 `ap` x `ap` y++instance Storable a => Storable (Vertex2 a) where+   sizeOf ~(Vertex2 x _) = 2 * sizeOf x+   alignment ~(Vertex2 x _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A vertex with /w/=1.+data Vertex3 a = Vertex3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vertex3 where+   fmap f (Vertex3 x y z) = Vertex3 (f x) (f y) (f z)++instance Applicative Vertex3 where+   pure a = Vertex3 a a a+   Vertex3 f g h <*> Vertex3 x y z = Vertex3 (f x) (g y) (h z)++instance Foldable Vertex3 where+   foldr f a (Vertex3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Vertex3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Vertex3 x y z) = x `f` (y `f` z)+   foldl1 f (Vertex3 x y z) = (x `f` y) `f` z++instance Traversable Vertex3 where+   traverse f (Vertex3 x y z) = pure Vertex3 <*> f x <*> f y <*> f z+   sequenceA (Vertex3 x y z) =  pure Vertex3 <*> x <*> y <*> z+   mapM f (Vertex3 x y z) = return Vertex3 `ap` f x `ap` f y `ap` f z+   sequence (Vertex3 x y z) = return Vertex3 `ap` x `ap` y `ap` z++instance Storable a => Storable (Vertex3 a) where+   sizeOf ~(Vertex3 x _ _) = 3 * sizeOf x+   alignment ~(Vertex3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A fully-fledged four-dimensional vertex.+data Vertex4 a = Vertex4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vertex4 where+   fmap f (Vertex4 x y z w) = Vertex4 (f x) (f y) (f z) (f w)++instance Applicative Vertex4 where+   pure a = Vertex4 a a a a+   Vertex4 f g h i <*> Vertex4 x y z w = Vertex4 (f x) (g y) (h z) (i w)++instance Foldable Vertex4 where+   foldr f a (Vertex4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (Vertex4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (Vertex4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (Vertex4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable Vertex4 where+   traverse f (Vertex4 x y z w) = pure Vertex4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (Vertex4 x y z w) =  pure Vertex4 <*> x <*> y <*> z <*> w+   mapM f (Vertex4 x y z w) = return Vertex4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (Vertex4 x y z w) = return Vertex4 `ap` x `ap` y `ap` z `ap` w++instance Storable a => Storable (Vertex4 a) where+   sizeOf ~(Vertex4 x _ _ _) = 4 * sizeOf x+   alignment ~(Vertex4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A one-dimensional vector.+newtype Vector1 a = Vector1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vector1 where+   fmap f (Vector1 x) = Vector1 (f x)++instance Applicative Vector1 where+   pure a = Vector1 a+   Vector1 f <*> Vector1 x = Vector1 (f x)++instance Foldable Vector1 where+   foldr f a (Vector1 x) = x `f ` a+   foldl f a (Vector1 x) = a `f` x+   foldr1 _ (Vector1 x) = x+   foldl1 _ (Vector1 x) = x++instance Traversable Vector1 where+   traverse f (Vector1 x) = pure Vector1 <*> f x+   sequenceA (Vector1 x) =  pure Vector1 <*> x+   mapM f (Vector1 x) = return Vector1 `ap` f x+   sequence (Vector1 x) = return Vector1 `ap` x++instance Storable a => Storable (Vector1 a) where+   sizeOf    ~(Vector1 s) = sizeOf s+   alignment ~(Vector1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A two-dimensional vector.+data Vector2 a = Vector2 !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vector2 where+   fmap f (Vector2 x y) = Vector2 (f x) (f y)++instance Applicative Vector2 where+   pure a = Vector2 a a+   Vector2 f g <*> Vector2 x y = Vector2 (f x) (g y)++instance Foldable Vector2 where+   foldr f a (Vector2 x y) = x `f ` (y `f` a)+   foldl f a (Vector2 x y) = (a `f` x) `f` y+   foldr1 f (Vector2 x y) = x `f` y+   foldl1 f (Vector2 x y) = x `f` y++instance Traversable Vector2 where+   traverse f (Vector2 x y) = pure Vector2 <*> f x <*> f y+   sequenceA (Vector2 x y) =  pure Vector2 <*> x <*> y+   mapM f (Vector2 x y) = return Vector2 `ap` f x `ap` f y+   sequence (Vector2 x y) = return Vector2 `ap` x `ap` y++instance Storable a => Storable (Vector2 a) where+   sizeOf ~(Vector2 x _) = 2 * sizeOf x+   alignment ~(Vector2 x _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A three-dimensional vector.+data Vector3 a = Vector3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vector3 where+   fmap f (Vector3 x y z) = Vector3 (f x) (f y) (f z)++instance Applicative Vector3 where+   pure a = Vector3 a a a+   Vector3 f g h <*> Vector3 x y z = Vector3 (f x) (g y) (h z)++instance Foldable Vector3 where+   foldr f a (Vector3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Vector3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Vector3 x y z) = x `f` (y `f` z)+   foldl1 f (Vector3 x y z) = (x `f` y) `f` z++instance Traversable Vector3 where+   traverse f (Vector3 x y z) = pure Vector3 <*> f x <*> f y <*> f z+   sequenceA (Vector3 x y z) =  pure Vector3 <*> x <*> y <*> z+   mapM f (Vector3 x y z) = return Vector3 `ap` f x `ap` f y `ap` f z+   sequence (Vector3 x y z) = return Vector3 `ap` x `ap` y `ap` z++instance Storable a => Storable (Vector3 a) where+   sizeOf ~(Vector3 x _ _) = 3 * sizeOf x+   alignment ~(Vector3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A four-dimensional vector.+data Vector4 a = Vector4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Vector4 where+   fmap f (Vector4 x y z w) = Vector4 (f x) (f y) (f z) (f w)++instance Applicative Vector4 where+   pure a = Vector4 a a a a+   Vector4 f g h i <*> Vector4 x y z w = Vector4 (f x) (g y) (h z) (i w)++instance Foldable Vector4 where+   foldr f a (Vector4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (Vector4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (Vector4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (Vector4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable Vector4 where+   traverse f (Vector4 x y z w) = pure Vector4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (Vector4 x y z w) =  pure Vector4 <*> x <*> y <*> z <*> w+   mapM f (Vector4 x y z w) = return Vector4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (Vector4 x y z w) = return Vector4 `ap` x `ap` y `ap` z `ap` w++instance Storable a => Storable (Vector4 a) where+   sizeOf ~(Vector4 x _ _ _) = 4 * sizeOf x+   alignment ~(Vector4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++peekApplicativeTraversable :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> IO (t a)+peekApplicativeTraversable = Data.Traversable.mapM peek . addresses++addresses :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> t (Ptr a)+addresses = snd . mapAccumL nextPtr 0 . pure . castPtr++nextPtr :: Storable a => Int -> Ptr a -> (Int, Ptr a)+nextPtr offset ptr = (offset + 1, advancePtr ptr offset)++--------------------------------------------------------------------------------++pokeFoldable :: (Foldable t, Storable a) => Ptr (t a) -> t a -> IO ()+pokeFoldable ptr xs = foldlM pokeAndAdvance (castPtr ptr) xs >> return ()++pokeAndAdvance :: Storable a => Ptr a -> a -> IO (Ptr a)+pokeAndAdvance ptr value = do+   poke ptr value+   return $ ptr `plusPtr` sizeOf value
+ src/Graphics/Rendering/OpenGL/GL/Texturing.hs view
@@ -0,0 +1,29 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.8 (Texturing) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing (+   module Graphics.Rendering.OpenGL.GL.Texturing.Specification,+   module Graphics.Rendering.OpenGL.GL.Texturing.Parameters,+   module Graphics.Rendering.OpenGL.GL.Texturing.Objects,+   module Graphics.Rendering.OpenGL.GL.Texturing.Environments,+   module Graphics.Rendering.OpenGL.GL.Texturing.Application,+   module Graphics.Rendering.OpenGL.GL.Texturing.Queries+) where++import Graphics.Rendering.OpenGL.GL.Texturing.Specification+import Graphics.Rendering.OpenGL.GL.Texturing.Parameters+import Graphics.Rendering.OpenGL.GL.Texturing.Objects+import Graphics.Rendering.OpenGL.GL.Texturing.Environments+import Graphics.Rendering.OpenGL.GL.Texturing.Application+import Graphics.Rendering.OpenGL.GL.Texturing.Queries
+ src/Graphics/Rendering/OpenGL/GL/Texturing/Application.hs view
@@ -0,0 +1,27 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Application+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.8.15 (Texture Application) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.Application (+   texture+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget++--------------------------------------------------------------------------------++texture :: ParameterizedTextureTarget t => t -> StateVar Capability+texture = makeCapability . marshalParameterizedTextureTargetEnableCap
+ src/Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs view
@@ -0,0 +1,354 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Environments+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.8.13 (Texture Environments and Texture+-- Functions) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.Environments (+   TextureFunction(..), textureFunction,+   TextureCombineFunction(..), combineRGB, combineAlpha,+   ArgNum(..), Arg(..), Src(..), argRGB, argAlpha,+   rgbScale, alphaScale,+   constantColor, textureUnitLODBias+) where++import Control.Monad+import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.BlendingFactor+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.Texturing.Parameters+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++data TextureEnvTarget =+     TextureEnv+   | TextureFilterControl   -- GL_TEXTURE_LOD_BIAS_EXT+   | PointSprite            -- GL_COORD_REPLACE_NV++marshalTextureEnvTarget :: TextureEnvTarget -> GLenum+marshalTextureEnvTarget x = case x of+   TextureEnv -> GL_TEXTURE_ENV+   TextureFilterControl -> GL_TEXTURE_FILTER_CONTROL+   PointSprite -> GL_POINT_SPRITE++--------------------------------------------------------------------------------++data TextureEnvParameter =+     TexEnvParamTextureEnvMode+   | TexEnvParamTextureEnvColor+   | TexEnvParamCombineRGB+   | TexEnvParamCombineAlpha+   | TexEnvParamSrc0RGB+   | TexEnvParamSrc1RGB+   | TexEnvParamSrc2RGB+   | TexEnvParamSrc3RGB+   | TexEnvParamSrc0Alpha+   | TexEnvParamSrc1Alpha+   | TexEnvParamSrc2Alpha+   | TexEnvParamSrc3Alpha+   | TexEnvParamOperand0RGB+   | TexEnvParamOperand1RGB+   | TexEnvParamOperand2RGB+   | TexEnvParamOperand3RGB+   | TexEnvParamOperand0Alpha+   | TexEnvParamOperand1Alpha+   | TexEnvParamOperand2Alpha+   | TexEnvParamOperand3Alpha+   | TexEnvParamRGBScale+   | TexEnvParamAlphaScale+   | TexEnvParamLODBias++marshalTextureEnvParameter :: TextureEnvParameter -> GLenum+marshalTextureEnvParameter x = case x of+   TexEnvParamTextureEnvMode -> GL_TEXTURE_ENV_MODE+   TexEnvParamTextureEnvColor -> GL_TEXTURE_ENV_COLOR+   TexEnvParamCombineRGB -> GL_COMBINE_RGB+   TexEnvParamCombineAlpha -> GL_COMBINE_ALPHA+   TexEnvParamSrc0RGB -> GL_SRC0_RGB+   TexEnvParamSrc1RGB -> GL_SRC1_RGB+   TexEnvParamSrc2RGB -> GL_SRC2_RGB+   TexEnvParamSrc3RGB -> GL_SOURCE3_RGB_NV+   TexEnvParamSrc0Alpha -> GL_SRC0_ALPHA+   TexEnvParamSrc1Alpha -> GL_SRC1_ALPHA+   TexEnvParamSrc2Alpha -> GL_SRC2_ALPHA+   TexEnvParamSrc3Alpha -> GL_SOURCE3_ALPHA_NV+   TexEnvParamOperand0RGB -> GL_OPERAND0_RGB+   TexEnvParamOperand1RGB -> GL_OPERAND1_RGB+   TexEnvParamOperand2RGB -> GL_OPERAND2_RGB+   TexEnvParamOperand3RGB -> GL_OPERAND3_RGB_NV+   TexEnvParamOperand0Alpha -> GL_OPERAND0_ALPHA+   TexEnvParamOperand1Alpha -> GL_OPERAND1_ALPHA+   TexEnvParamOperand2Alpha -> GL_OPERAND2_ALPHA+   TexEnvParamOperand3Alpha -> GL_OPERAND3_ALPHA_NV+   TexEnvParamRGBScale -> GL_RGB_SCALE+   TexEnvParamAlphaScale -> GL_ALPHA_SCALE+   TexEnvParamLODBias -> GL_TEXTURE_LOD_BIAS++--------------------------------------------------------------------------------++texEnv :: (GLenum -> GLenum -> b -> IO ())+       -> (a -> (b -> IO ()) -> IO ())+       -> TextureEnvTarget -> TextureEnvParameter -> a -> IO ()+texEnv glTexEnv marshalAct t p x =+   marshalAct x $+      glTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p)++glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glTexEnvC4f t p ptr = glTexEnvfv t p (castPtr ptr)+++--------------------------------------------------------------------------------++getTexEnv :: Storable b+          => (GLenum -> GLenum -> Ptr b -> IO ())+          -> (b -> a)+          -> TextureEnvTarget -> TextureEnvParameter -> IO a+getTexEnv glGetTexEnv unmarshal t p =+   alloca $ \buf -> do+     glGetTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p) buf+     peek1 unmarshal buf++glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glGetTexEnvC4f t p ptr = glGetTexEnvfv t p (castPtr ptr)++--------------------------------------------------------------------------------++m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()+m2a marshal x act = act (marshal x)++texEnvi ::+   (GLint -> a) -> (a -> GLint) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a+texEnvi unmarshal marshal t p =+   makeStateVar+      (getTexEnv glGetTexEnviv unmarshal     t p)+      (texEnv    glTexEnvi     (m2a marshal) t p)++texEnvf ::+   (GLfloat -> a) -> (a -> GLfloat) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a+texEnvf unmarshal marshal t p =+   makeStateVar+      (getTexEnv glGetTexEnvfv unmarshal     t p)+      (texEnv    glTexEnvf     (m2a marshal) t p)++texEnvC4f :: TextureEnvTarget -> TextureEnvParameter -> StateVar (Color4 GLfloat)+texEnvC4f t p =+   makeStateVar+      (getTexEnv glGetTexEnvC4f id   t p)+      (texEnv    glTexEnvC4f    with t p)++--------------------------------------------------------------------------------++data TextureFunction =+     Modulate+   | Decal+   | Blend+   | Replace+   | AddUnsigned+   | Combine+   | Combine4+   deriving ( Eq, Ord, Show )++marshalTextureFunction :: TextureFunction -> GLint+marshalTextureFunction x = fromIntegral $ case x of+   Modulate -> GL_MODULATE+   Decal -> GL_DECAL+   Blend -> GL_BLEND+   Replace -> GL_REPLACE+   AddUnsigned -> GL_ADD+   Combine -> GL_COMBINE+   Combine4 -> GL_COMBINE4_NV++unmarshalTextureFunction :: GLint -> TextureFunction+unmarshalTextureFunction x+   | y == GL_MODULATE = Modulate+   | y == GL_DECAL = Decal+   | y == GL_BLEND = Blend+   | y == GL_REPLACE = Replace+   | y == GL_ADD = AddUnsigned+   | y == GL_COMBINE = Combine+   | y == GL_COMBINE4_NV = Combine4+   | otherwise = error ("unmarshalTextureFunction: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++textureFunction :: StateVar TextureFunction+textureFunction =+   texEnvi unmarshalTextureFunction marshalTextureFunction TextureEnv TexEnvParamTextureEnvMode++--------------------------------------------------------------------------------++data TextureCombineFunction =+     Replace'+   | Modulate'+   | AddUnsigned'+   | AddSigned+   | Interpolate+   | Subtract+   | Dot3RGB+   | Dot3RGBA+   deriving ( Eq, Ord, Show )++marshalTextureCombineFunction :: TextureCombineFunction -> GLint+marshalTextureCombineFunction x = fromIntegral $ case x of+   Replace' -> GL_REPLACE+   Modulate' -> GL_MODULATE+   AddUnsigned' -> GL_ADD+   AddSigned -> GL_ADD_SIGNED+   Interpolate -> GL_INTERPOLATE+   Subtract -> GL_SUBTRACT+   Dot3RGB -> GL_DOT3_RGB+   Dot3RGBA -> GL_DOT3_RGBA++unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction+unmarshalTextureCombineFunction x+   | y == GL_REPLACE = Replace'+   | y == GL_MODULATE = Modulate'+   | y == GL_ADD = AddUnsigned'+   | y == GL_ADD_SIGNED = AddSigned+   | y == GL_INTERPOLATE = Interpolate+   | y == GL_SUBTRACT = Subtract+   | y == GL_DOT3_RGB = Dot3RGB+   | y == GL_DOT3_RGBA = Dot3RGBA+   | otherwise = error ("unmarshalTextureCombineFunction: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++combineRGB :: StateVar TextureCombineFunction+combineRGB = combine TexEnvParamCombineRGB++combineAlpha :: StateVar TextureCombineFunction+combineAlpha = combine TexEnvParamCombineAlpha++combine :: TextureEnvParameter -> StateVar TextureCombineFunction+combine =+   texEnvi unmarshalTextureCombineFunction marshalTextureCombineFunction TextureEnv++--------------------------------------------------------------------------------++data ArgNum =+     Arg0+   | Arg1+   | Arg2+   | Arg3+   deriving ( Eq, Ord, Show )++argNumToOperandRGB :: ArgNum -> TextureEnvParameter+argNumToOperandRGB x = case x of+   Arg0 -> TexEnvParamOperand0RGB+   Arg1 -> TexEnvParamOperand1RGB+   Arg2 -> TexEnvParamOperand2RGB+   Arg3 -> TexEnvParamOperand3RGB++argNumToOperandAlpha :: ArgNum -> TextureEnvParameter+argNumToOperandAlpha x = case x of+   Arg0 -> TexEnvParamOperand0Alpha+   Arg1 -> TexEnvParamOperand1Alpha+   Arg2 -> TexEnvParamOperand2Alpha+   Arg3 -> TexEnvParamOperand3Alpha++argNumToSrcRGB :: ArgNum -> TextureEnvParameter+argNumToSrcRGB x = case x of+   Arg0 -> TexEnvParamSrc0RGB+   Arg1 -> TexEnvParamSrc1RGB+   Arg2 -> TexEnvParamSrc2RGB+   Arg3 -> TexEnvParamSrc3RGB++argNumToSrcAlpha :: ArgNum -> TextureEnvParameter+argNumToSrcAlpha x = case x of+   Arg0 -> TexEnvParamSrc0Alpha+   Arg1 -> TexEnvParamSrc1Alpha+   Arg2 -> TexEnvParamSrc2Alpha+   Arg3 -> TexEnvParamSrc3Alpha++--------------------------------------------------------------------------------++data Arg = Arg BlendingFactor Src+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data Src =+     CurrentUnit+   | Previous+   | Crossbar TextureUnit+   | Constant+   | PrimaryColor+   deriving ( Eq, Ord, Show )++marshalSrc :: Src -> GLint+marshalSrc x = fromIntegral $ case x of+   CurrentUnit -> GL_TEXTURE+   Previous -> GL_PREVIOUS+   Crossbar u -> fromIntegral (marshalTextureUnit u)+   Constant -> GL_CONSTANT+   PrimaryColor -> GL_PRIMARY_COLOR++unmarshalSrc :: GLint -> Src+unmarshalSrc x+   | y == GL_TEXTURE = CurrentUnit+   | y == GL_PREVIOUS = Previous+   | y == GL_CONSTANT = Constant+   | y == GL_PRIMARY_COLOR = PrimaryColor+   | otherwise = Crossbar (unmarshalTextureUnit (fromIntegral x))+   where y = fromIntegral x++--------------------------------------------------------------------------------++argRGB :: ArgNum -> StateVar Arg+argRGB n = arg (argNumToOperandRGB n) (argNumToSrcRGB n)++argAlpha :: ArgNum -> StateVar Arg+argAlpha n = arg (argNumToOperandAlpha n) (argNumToSrcAlpha n)++arg :: TextureEnvParameter -> TextureEnvParameter -> StateVar Arg+arg op src = combineArg (textureEnvOperand op) (textureEnvSrc src)+   where combineArg :: StateVar BlendingFactor -> StateVar Src -> StateVar Arg+         combineArg v w = makeStateVar+                             (liftM2 Arg (get v) (get w))+                             (\(Arg x y) -> do v $= x; w $= y)++textureEnvOperand :: TextureEnvParameter -> StateVar BlendingFactor+textureEnvOperand =+   texEnvi (unmarshalBlendingFactor . fromIntegral) (fromIntegral . marshalBlendingFactor) TextureEnv++textureEnvSrc :: TextureEnvParameter -> StateVar Src+textureEnvSrc = texEnvi unmarshalSrc marshalSrc TextureEnv++--------------------------------------------------------------------------------++rgbScale :: StateVar GLfloat+rgbScale = scale TexEnvParamRGBScale++alphaScale :: StateVar GLfloat+alphaScale = scale TexEnvParamAlphaScale++scale :: TextureEnvParameter -> StateVar GLfloat+scale = texEnvf id id TextureEnv++--------------------------------------------------------------------------------++constantColor :: StateVar (Color4 GLfloat)+constantColor = texEnvC4f TextureEnv TexEnvParamTextureEnvColor++--------------------------------------------------------------------------------++textureUnitLODBias :: StateVar LOD+textureUnitLODBias = texEnvf id id TextureFilterControl TexEnvParamLODBias
+ src/Graphics/Rendering/OpenGL/GL/Texturing/Filter.hs view
@@ -0,0 +1,67 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Filter+-- Copyright   :  (c) Sven Panne 2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling texture filtering modes.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.Filter (+   TextureFilter(..),+   MinificationFilter, marshalMinificationFilter, unmarshalMinificationFilter,+   MagnificationFilter, marshalMagnificationFilter, unmarshalMagnificationFilter+) where++import Graphics.GL++--------------------------------------------------------------------------------++data TextureFilter =+     Nearest+   | Linear'+   deriving ( Eq, Ord, Show )++type MinificationFilter = (TextureFilter, Maybe TextureFilter)++type MagnificationFilter = TextureFilter++-- We treat MagnificationFilter as a degenerated case of MinificationFilter+magToMin :: MagnificationFilter -> MinificationFilter+magToMin magFilter = (magFilter, Nothing)++minToMag :: MinificationFilter -> MagnificationFilter+minToMag (magFilter, Nothing) = magFilter+minToMag minFilter = error ("minToMag: illegal value " ++ show minFilter)++marshalMinificationFilter :: MinificationFilter -> GLint+marshalMinificationFilter x = fromIntegral $ case x of+   (Nearest, Nothing     ) -> GL_NEAREST+   (Linear', Nothing     ) -> GL_LINEAR+   (Nearest, Just Nearest) -> GL_NEAREST_MIPMAP_NEAREST+   (Linear', Just Nearest) -> GL_LINEAR_MIPMAP_NEAREST+   (Nearest, Just Linear') -> GL_NEAREST_MIPMAP_LINEAR+   (Linear', Just Linear') -> GL_LINEAR_MIPMAP_LINEAR++marshalMagnificationFilter :: MagnificationFilter -> GLint+marshalMagnificationFilter = marshalMinificationFilter . magToMin++unmarshalMinificationFilter :: GLint -> MinificationFilter+unmarshalMinificationFilter x+   | y == GL_NEAREST = (Nearest, Nothing)+   | y == GL_LINEAR = (Linear', Nothing)+   | y == GL_NEAREST_MIPMAP_NEAREST = (Nearest, Just Nearest)+   | y == GL_LINEAR_MIPMAP_NEAREST = (Linear', Just Nearest)+   | y == GL_NEAREST_MIPMAP_LINEAR = (Nearest, Just Linear')+   | y == GL_LINEAR_MIPMAP_LINEAR = (Linear', Just Linear')+   | otherwise = error ("unmarshalMinificationFilter: illegal value " ++ show x)+   where y = fromIntegral x++unmarshalMagnificationFilter :: GLint -> MagnificationFilter+unmarshalMagnificationFilter = minToMag . unmarshalMinificationFilter
+ src/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs view
@@ -0,0 +1,86 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Objects+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.8.12 (Texture Objects) of the OpenGL 2.1+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.Objects (+   TextureObject(TextureObject), textureBinding,+   textureResident, areTexturesResident,+   TexturePriority, texturePriority, prioritizeTextures,+   generateMipmap'+) where++import Data.List+import Data.Maybe (fromMaybe)+import Data.StateVar+import Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter+import Graphics.Rendering.OpenGL.GL.Texturing.TextureObject+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.GL++--------------------------------------------------------------------------------++textureBinding :: BindableTextureTarget t => t -> StateVar (Maybe TextureObject)+textureBinding t =+   makeStateVar+      (do o <- getEnum1 (TextureObject . fromIntegral) (marshalBindableTextureTargetPName1I t)+          return $ if o == defaultTextureObject then Nothing else Just o)+      (glBindTexture (marshalBindableTextureTarget t) . textureID . (fromMaybe defaultTextureObject))++defaultTextureObject :: TextureObject+defaultTextureObject = TextureObject 0++--------------------------------------------------------------------------------++textureResident :: ParameterizedTextureTarget t => t -> GettableStateVar Bool+textureResident t =+   makeGettableStateVar $+      getTexParameteri unmarshalGLboolean t TextureResident++areTexturesResident :: [TextureObject] -> IO ([TextureObject],[TextureObject])+areTexturesResident texObjs = do+   withArrayLen (map textureID texObjs) $ \len texObjsBuf ->+      allocaArray len $ \residentBuf -> do+         allResident <-+            glAreTexturesResident (fromIntegral len) texObjsBuf residentBuf+         if unmarshalGLboolean allResident+            then return (texObjs, [])+            else do+               tr <- fmap (zip texObjs) $ peekArray len residentBuf+               let (resident, nonResident) = partition (unmarshalGLboolean . snd) tr+               return (map fst resident, map fst nonResident)++--------------------------------------------------------------------------------++type TexturePriority = GLclampf++texturePriority :: ParameterizedTextureTarget t => t -> StateVar TexturePriority+texturePriority = texParamf realToFrac realToFrac TexturePriority++prioritizeTextures :: [(TextureObject,TexturePriority)] -> IO ()+prioritizeTextures tps =+   withArrayLen (map (textureID . fst) tps) $ \len texObjsBuf ->+      withArray (map snd tps) $+         glPrioritizeTextures (fromIntegral len) texObjsBuf++--------------------------------------------------------------------------------++-- | Generate mipmaps for the specified texture target. Note that from OpenGL+-- 3.1 onwards you should use this function instead of the texture parameter+-- 'Graphics.Rendering.OpenGL.GL.Texturing.Parameters.generateMipmap'.++generateMipmap' :: ParameterizedTextureTarget t => t -> IO ()+generateMipmap' = glGenerateMipmap . marshalParameterizedTextureTarget
+ src/Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs view
@@ -0,0 +1,234 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Parameters+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.8.4 (Texture Parameters), section 3.8.7+-- (Texture Wrap Mode), section 3.8.8 (Texture Minification), and section 3.8.9+-- (Texture Magnification) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.Parameters (+   TextureFilter(..), MinificationFilter, MagnificationFilter, textureFilter,+   Repetition(..), Clamping(..), textureWrapMode,+   textureBorderColor, LOD, textureObjectLODBias, maxTextureLODBias,+   textureLODRange, textureMaxAnisotropy, maxTextureMaxAnisotropy,+   textureLevelRange, generateMipmap, depthTextureMode, textureCompareMode,+   textureCompareFailValue, TextureCompareOperator(..), textureCompareOperator+) where++import Control.Monad+import Data.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.ComparisonFunction+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.Filter+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.Texturing.Specification+import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++textureFilter :: ParameterizedTextureTarget t => t -> StateVar (MinificationFilter, MagnificationFilter)+textureFilter =+   combineTexParams+      (texParami unmarshalMinificationFilter  marshalMinificationFilter  TextureMinFilter)+      (texParami unmarshalMagnificationFilter marshalMagnificationFilter TextureMagFilter)++--------------------------------------------------------------------------------++data Repetition =+     Repeated+   | Mirrored+   deriving ( Eq, Ord, Show )++data Clamping =+     Clamp+   | Repeat+   | ClampToEdge+   | ClampToBorder+   deriving ( Eq, Ord, Show )++marshalTextureWrapMode :: (Repetition, Clamping) -> GLint+marshalTextureWrapMode x = fromIntegral $ case x of+   (Repeated, Clamp) -> GL_CLAMP+   (Repeated, Repeat) -> GL_REPEAT+   (Repeated, ClampToEdge) -> GL_CLAMP_TO_EDGE+   (Repeated, ClampToBorder) -> GL_CLAMP_TO_BORDER+   (Mirrored, Clamp) -> GL_MIRROR_CLAMP_EXT+   (Mirrored, Repeat) -> GL_MIRRORED_REPEAT+   (Mirrored, ClampToEdge) -> GL_MIRROR_CLAMP_TO_EDGE+   (Mirrored, ClampToBorder) -> GL_MIRROR_CLAMP_TO_BORDER_EXT++unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)+unmarshalTextureWrapMode x+   | y == GL_CLAMP = (Repeated, Clamp)+   | y == GL_REPEAT = (Repeated, Repeat)+   | y == GL_CLAMP_TO_EDGE = (Repeated, ClampToEdge)+   | y == GL_CLAMP_TO_BORDER = (Repeated, ClampToBorder)+   | y == GL_MIRROR_CLAMP_EXT = (Mirrored, Clamp)+   | y == GL_MIRRORED_REPEAT = (Mirrored, Repeat)+   | y == GL_MIRROR_CLAMP_TO_EDGE = (Mirrored, ClampToEdge)+   | y == GL_MIRROR_CLAMP_TO_BORDER_EXT = (Mirrored, ClampToBorder)+   | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++textureWrapMode :: ParameterizedTextureTarget t => t -> TextureCoordName -> StateVar (Repetition,Clamping)+textureWrapMode t coord = case coord of+   S -> wrap TextureWrapS+   T -> wrap TextureWrapT+   R -> wrap TextureWrapR+   Q -> invalidTextureCoord+   where wrap c = texParami unmarshalTextureWrapMode marshalTextureWrapMode c t++invalidTextureCoord :: StateVar (Repetition,Clamping)+invalidTextureCoord =+   makeStateVar+      (do recordInvalidEnum; return (Repeated, Repeat))+      (const recordInvalidEnum)++--------------------------------------------------------------------------------++textureBorderColor :: ParameterizedTextureTarget t => t -> StateVar (Color4 GLfloat)+textureBorderColor = texParamC4f TextureBorderColor++--------------------------------------------------------------------------------++type LOD = GLfloat++textureObjectLODBias :: ParameterizedTextureTarget t => t -> StateVar LOD+textureObjectLODBias = texParamf id id TextureLODBias++maxTextureLODBias :: GettableStateVar LOD+maxTextureLODBias =+   makeGettableStateVar (getFloat1 id GetMaxTextureLODBias)++textureLODRange :: ParameterizedTextureTarget t => t -> StateVar (LOD,LOD)+textureLODRange =+   combineTexParams+      (texParamf id id TextureMinLOD)+      (texParamf id id TextureMaxLOD)++--------------------------------------------------------------------------------++textureMaxAnisotropy :: ParameterizedTextureTarget t => t -> StateVar GLfloat+textureMaxAnisotropy = texParamf id id TextureMaxAnisotropy++maxTextureMaxAnisotropy :: GettableStateVar GLfloat+maxTextureMaxAnisotropy =+   makeGettableStateVar (getFloat1 id GetMaxTextureMaxAnisotropy)++--------------------------------------------------------------------------------++textureLevelRange :: ParameterizedTextureTarget t => t -> StateVar (Level,Level)+textureLevelRange =+   combineTexParams+      (texParami id id TextureBaseLevel)+      (texParami id id TextureMaxLevel)++--------------------------------------------------------------------------------++-- | Note: OpenGL 3.1 deprecated this texture parameter, use+-- 'Graphics.Rendering.OpenGL.GL.Texturing.Objects.generateMipmap'' instead.++generateMipmap :: ParameterizedTextureTarget t => t -> StateVar Capability+generateMipmap = texParami unmarshal marshal GenerateMipmap+   where unmarshal = unmarshalCapability . fromIntegral+         marshal = fromIntegral . marshalCapability++--------------------------------------------------------------------------------++-- Only Luminance', Intensity, and Alpha' allowed+depthTextureMode :: ParameterizedTextureTarget t => t -> StateVar PixelInternalFormat+depthTextureMode =+   texParami unmarshalPixelInternalFormat marshalPixelInternalFormat DepthTextureMode++--------------------------------------------------------------------------------++marshalTextureCompareMode :: Capability -> GLint+marshalTextureCompareMode x = fromIntegral $ case x of+   Disabled -> GL_NONE+   Enabled -> GL_COMPARE_REF_TO_TEXTURE++unmarshalTextureCompareMode :: GLint -> Capability+unmarshalTextureCompareMode x+   | y == GL_NONE = Disabled+   | y == GL_COMPARE_REF_TO_TEXTURE = Enabled+   | otherwise = error ("unmarshalTextureCompareMode: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++textureCompareMode :: ParameterizedTextureTarget t => t -> StateVar (Maybe ComparisonFunction)+textureCompareMode =+   combineTexParamsMaybe+      (texParami unmarshalTextureCompareMode marshalTextureCompareMode TextureCompareMode)+      (texParami unmarshal marshal TextureCompareFunc)+   where unmarshal = unmarshalComparisonFunction . fromIntegral+         marshal = fromIntegral . marshalComparisonFunction++--------------------------------------------------------------------------------++textureCompareFailValue :: ParameterizedTextureTarget t => t -> StateVar GLclampf+textureCompareFailValue = texParamf realToFrac realToFrac TextureCompareFailValue++--------------------------------------------------------------------------------++data TextureCompareOperator =+     LequalR+   | GequalR+   deriving ( Eq, Ord, Show )++marshalTextureCompareOperator :: TextureCompareOperator -> GLenum+marshalTextureCompareOperator x = case x of+   LequalR -> GL_TEXTURE_LEQUAL_R_SGIX+   GequalR -> GL_TEXTURE_GEQUAL_R_SGIX++unmarshalTextureCompareOperator :: GLenum -> TextureCompareOperator+unmarshalTextureCompareOperator x+   | x == GL_TEXTURE_LEQUAL_R_SGIX = LequalR+   | x == GL_TEXTURE_GEQUAL_R_SGIX = GequalR+   | otherwise = error ("unmarshalTextureCompareOperator: illegal value " ++ show x)++--------------------------------------------------------------------------------++textureCompareOperator :: ParameterizedTextureTarget t => t -> StateVar (Maybe TextureCompareOperator)+textureCompareOperator =+   combineTexParamsMaybe+      (texParami (unmarshalCapability . fromIntegral) (fromIntegral. marshalCapability) TextureCompare)+      (texParami (unmarshalTextureCompareOperator . fromIntegral) (fromIntegral . marshalTextureCompareOperator) TextureCompareOperator)++--------------------------------------------------------------------------------++combineTexParams :: (t -> StateVar a)+                 -> (t -> StateVar b)+                 -> (t -> StateVar (a,b))+combineTexParams v w t =+   makeStateVar+      (liftM2 (,) (get (v t)) (get (w t)))+      (\(x,y) -> do v t $= x; w t $= y)++combineTexParamsMaybe :: (t -> StateVar Capability)+                      -> (t -> StateVar a)+                      -> (t -> StateVar (Maybe a))+combineTexParamsMaybe enab val t =+   makeStateVar+      (do tcm <- get (enab t)+          case tcm of+             Disabled -> return Nothing+             Enabled -> fmap Just $ get (val t))+      (maybe (enab t $= Disabled)+             (\tcf -> do val t $= tcf+                         enab t $= Enabled))
+ src/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs view
@@ -0,0 +1,437 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling PixelInternalFormat.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (+   PixelInternalFormat(..), marshalPixelInternalFormat,+   marshalPixelInternalFormat', unmarshalPixelInternalFormat,+) where++import Graphics.GL++--------------------------------------------------------------------------------++data PixelInternalFormat =+     Alpha'+   | DepthComponent'+   | Luminance'+   | LuminanceAlpha'+   | Intensity+   | R8+   | R16+   | RG8+   | RG16+   | RGB'+   | RGBA'+   | SRGB+   | SRGBAlpha+   | SLuminance+   | SLuminanceAlpha+   | Alpha4+   | Alpha8+   | Alpha12+   | Alpha16+   | DepthComponent16+   | DepthComponent24+   | DepthComponent32+   | Luminance4+   | Luminance8+   | Luminance12+   | Luminance16+   | Luminance4Alpha4+   | Luminance6Alpha2+   | Luminance8Alpha8+   | Luminance12Alpha4+   | Luminance12Alpha12+   | Luminance16Alpha16+   | Intensity4+   | Intensity8+   | Intensity12+   | Intensity16+   | R3G3B2+   | RGB4+   | RGB5+   | RGB8+   | RGB10+   | RGB12+   | RGB16+   | RGBA2+   | RGBA4+   | RGB5A1+   | RGBA8+   | RGB10A2+   | RGBA12+   | RGBA16+   | SRGB8+   | SRGB8Alpha8+   | R16F+   | RG16F+   | RGB16F+   | RGBA16F+   | R32F+   | RG32F+   | RGB32F+   | RGBA32F+   | R8I+   | R8UI+   | R16I+   | R16UI+   | R32I+   | R32UI+   | RG8I+   | RG8UI+   | RG16I+   | RG16UI+   | RG32I+   | RG32UI+   | RGB8I+   | RGB8UI+   | RGB16I+   | RGB16UI+   | RGB32I+   | RGB32UI+   | RGBA8I+   | RGBA8UI+   | RGBA16I+   | RGBA16UI+   | RGBA32I+   | RGBA32UI+   | SLuminance8+   | SLuminance8Alpha8+   | CompressedAlpha+   | CompressedLuminance+   | CompressedLuminanceAlpha+   | CompressedIntensity+   | CompressedRed+   | CompressedRG+   | CompressedRGB+   | CompressedRGBA+   | CompressedSRGB+   | CompressedSRGBAlpha+   | CompressedSLuminance+   | CompressedSLuminanceAlpha+   | CompressedRedRGTC1+   | CompressedSignedRedRGTC1+   | CompressedRG_RGTC2+   | CompressedSignedRG_RGTC2+   | DepthComponent32f+   | Depth32fStencil8+   | RGB9E5+   | R11fG11fB10f+   | StencilIndex1+   | StencilIndex4+   | StencilIndex8+   | StencilIndex16+   | RGBS3TC+   | RGB4S3TC+   | RGBAS3TC+   | RGBA4S3TC+   | RGBADXT5S3TC+   | RGBA4DXT5S3TC+   | CompressedRGBAS3TCDXT1+   | CompressedRGBAS3TCDXT3+   | CompressedRGBAS3TCDXT5+   | CompressedRGBS3TCDXT1+   | Alpha32F+   | Intensity32F+   | Luminance32F+   | LuminanceAlpha32F+   | Alpha16F+   | Intensity16F+   | Luminance16F+   | LuminanceAlpha16F+   | Depth24Stencil8+   deriving ( Eq, Ord, Show )++marshalPixelInternalFormat :: PixelInternalFormat -> GLint+marshalPixelInternalFormat x = fromIntegral $ case x of+   Alpha' -> GL_ALPHA+   DepthComponent' -> GL_DEPTH_COMPONENT+   Luminance' -> GL_LUMINANCE+   LuminanceAlpha' -> GL_LUMINANCE_ALPHA+   R8 -> GL_R8+   R16 -> GL_R16+   RG8 -> GL_RG8+   RG16 -> GL_RG16+   RGB' -> GL_RGB+   RGBA' -> GL_RGBA+   SRGB -> GL_SRGB+   SRGBAlpha -> GL_SRGB_ALPHA+   SLuminance -> GL_SLUMINANCE+   SLuminanceAlpha -> GL_SLUMINANCE_ALPHA+   Alpha4 -> GL_ALPHA4+   Alpha8 -> GL_ALPHA8+   Alpha12 -> GL_ALPHA12+   Alpha16 -> GL_ALPHA16+   DepthComponent16 -> GL_DEPTH_COMPONENT16+   DepthComponent24 -> GL_DEPTH_COMPONENT24+   DepthComponent32 -> GL_DEPTH_COMPONENT32+   Luminance4 -> GL_LUMINANCE4+   Luminance8 -> GL_LUMINANCE8+   Luminance12 -> GL_LUMINANCE12+   Luminance16 -> GL_LUMINANCE16+   Luminance4Alpha4 -> GL_LUMINANCE4_ALPHA4+   Luminance6Alpha2 -> GL_LUMINANCE6_ALPHA2+   Luminance8Alpha8 -> GL_LUMINANCE8_ALPHA8+   Luminance12Alpha4 -> GL_LUMINANCE12_ALPHA4+   Luminance12Alpha12 -> GL_LUMINANCE12_ALPHA12+   Luminance16Alpha16 -> GL_LUMINANCE16_ALPHA16+   Intensity -> GL_INTENSITY+   Intensity4 -> GL_INTENSITY4+   Intensity8 -> GL_INTENSITY8+   Intensity12 -> GL_INTENSITY12+   Intensity16 -> GL_INTENSITY16+   R3G3B2 -> GL_R3_G3_B2+   RGB4 -> GL_RGB4+   RGB5 -> GL_RGB5+   RGB8 -> GL_RGB8+   RGB10 -> GL_RGB10+   RGB12 -> GL_RGB12+   RGB16 -> GL_RGB16+   RGBA2 -> GL_RGBA2+   RGBA4 -> GL_RGBA4+   RGB5A1 -> GL_RGB5_A1+   RGBA8 -> GL_RGBA8+   RGB10A2 -> GL_RGB10_A2+   RGBA12 -> GL_RGBA12+   RGBA16 -> GL_RGBA16+   SRGB8 -> GL_SRGB8+   SRGB8Alpha8 -> GL_SRGB8_ALPHA8+   R16F -> GL_R16F+   RG16F -> GL_RG16F+   RGB16F -> GL_RGB16F+   RGBA16F -> GL_RGBA16F+   R32F -> GL_R32F+   RG32F -> GL_RG32F+   RGB32F -> GL_RGB32F+   RGBA32F -> GL_RGBA32F+   R8I -> GL_R8I+   R8UI -> GL_R8UI+   R16I -> GL_R16I+   R16UI -> GL_R16UI+   R32I -> GL_R32I+   R32UI -> GL_R32UI+   RG8I -> GL_RG8I+   RG8UI -> GL_RG8UI+   RG16I -> GL_RG16I+   RG16UI -> GL_RG16UI+   RG32I -> GL_R32I+   RG32UI -> GL_R32UI+   RGB8I -> GL_RGB8I+   RGB8UI -> GL_RGB8UI+   RGB16I -> GL_RGB16I+   RGB16UI -> GL_RGB16UI+   RGB32I -> GL_RGB32I+   RGB32UI -> GL_RGB32UI+   RGBA8I -> GL_RGBA8I+   RGBA8UI -> GL_RGBA8UI+   RGBA16I -> GL_RGBA16I+   RGBA16UI -> GL_RGBA16UI+   RGBA32I -> GL_RGBA32I+   RGBA32UI -> GL_RGBA32UI+   SLuminance8 -> GL_SLUMINANCE8+   SLuminance8Alpha8 -> GL_SLUMINANCE8_ALPHA8+   CompressedAlpha -> GL_COMPRESSED_ALPHA+   CompressedLuminance -> GL_COMPRESSED_LUMINANCE+   CompressedLuminanceAlpha -> GL_COMPRESSED_LUMINANCE_ALPHA+   CompressedIntensity -> GL_COMPRESSED_INTENSITY+   CompressedRed -> GL_COMPRESSED_RED+   CompressedRG -> GL_COMPRESSED_RG+   CompressedRGB -> GL_COMPRESSED_RGB+   CompressedRGBA -> GL_COMPRESSED_RGBA+   CompressedSRGB -> GL_COMPRESSED_SRGB+   CompressedSRGBAlpha -> GL_COMPRESSED_SRGB_ALPHA+   CompressedSLuminance -> GL_COMPRESSED_SLUMINANCE+   CompressedSLuminanceAlpha -> GL_COMPRESSED_SLUMINANCE_ALPHA+   CompressedRedRGTC1 -> GL_COMPRESSED_RED_RGTC1+   CompressedSignedRedRGTC1 -> GL_COMPRESSED_SIGNED_RED_RGTC1+   CompressedRG_RGTC2 -> GL_COMPRESSED_RG_RGTC2+   CompressedSignedRG_RGTC2 -> GL_COMPRESSED_SIGNED_RG_RGTC2+   DepthComponent32f -> GL_DEPTH_COMPONENT32F+   Depth32fStencil8 -> GL_DEPTH32F_STENCIL8+   RGB9E5 -> GL_RGB9_E5+   R11fG11fB10f -> GL_R11F_G11F_B10F+   StencilIndex1 -> GL_STENCIL_INDEX1+   StencilIndex4 -> GL_STENCIL_INDEX4+   StencilIndex8 -> GL_STENCIL_INDEX8+   StencilIndex16 -> GL_STENCIL_INDEX16+   RGBS3TC -> GL_RGB_S3TC+   RGB4S3TC -> GL_RGB4_S3TC+   RGBAS3TC -> GL_RGBA_S3TC+   RGBA4S3TC -> GL_RGBA4_S3TC+   RGBADXT5S3TC -> GL_RGBA_DXT5_S3TC+   RGBA4DXT5S3TC -> GL_RGBA4_DXT5_S3TC+   CompressedRGBAS3TCDXT1 -> GL_COMPRESSED_RGBA_S3TC_DXT1_EXT+   CompressedRGBAS3TCDXT3 -> GL_COMPRESSED_RGBA_S3TC_DXT3_EXT+   CompressedRGBAS3TCDXT5 -> GL_COMPRESSED_RGBA_S3TC_DXT5_EXT+   CompressedRGBS3TCDXT1 -> GL_COMPRESSED_RGB_S3TC_DXT1_EXT+   Alpha32F -> GL_ALPHA32F_ARB+   Intensity32F -> GL_INTENSITY32F_ARB+   Luminance32F -> GL_LUMINANCE32F_ARB+   LuminanceAlpha32F -> GL_LUMINANCE_ALPHA32F_ARB+   Alpha16F -> GL_ALPHA16F_ARB+   Intensity16F -> GL_INTENSITY16F_ARB+   Luminance16F -> GL_LUMINANCE16F_ARB+   LuminanceAlpha16F -> GL_LUMINANCE_ALPHA16F_ARB+   Depth24Stencil8 -> GL_DEPTH24_STENCIL8_EXT++-- *sigh* The OpenGL API is sometimes a bit creative in its usage of types...+marshalPixelInternalFormat' :: PixelInternalFormat -> GLenum+marshalPixelInternalFormat' = fromIntegral . marshalPixelInternalFormat++unmarshalPixelInternalFormat :: GLint -> PixelInternalFormat+unmarshalPixelInternalFormat x+   | y == GL_ALPHA = Alpha'+   | y == GL_DEPTH_COMPONENT = DepthComponent'+   | y == GL_LUMINANCE = Luminance'+   | y == GL_LUMINANCE_ALPHA = LuminanceAlpha'+   | y == GL_RGB = RGB'+   | y == GL_RGBA = RGBA'+   | y == GL_SRGB = SRGB+   | y == GL_SRGB_ALPHA = SRGBAlpha+   | y == GL_SLUMINANCE = SLuminance+   | y == GL_SLUMINANCE_ALPHA = SLuminanceAlpha+   | y == GL_ALPHA4 = Alpha4+   | y == GL_ALPHA8 = Alpha8+   | y == GL_ALPHA12 = Alpha12+   | y == GL_ALPHA16 = Alpha16+   | y == GL_DEPTH_COMPONENT16 = DepthComponent16+   | y == GL_DEPTH_COMPONENT24 = DepthComponent24+   | y == GL_DEPTH_COMPONENT32 = DepthComponent32+   | y == GL_LUMINANCE4 = Luminance4+   | y == GL_LUMINANCE8 = Luminance8+   | y == GL_LUMINANCE12 = Luminance12+   | y == GL_LUMINANCE16 = Luminance16+   | y == GL_LUMINANCE4_ALPHA4 = Luminance4Alpha4+   | y == GL_LUMINANCE6_ALPHA2 = Luminance6Alpha2+   | y == GL_LUMINANCE8_ALPHA8 = Luminance8Alpha8+   | y == GL_LUMINANCE12_ALPHA4 = Luminance12Alpha4+   | y == GL_LUMINANCE12_ALPHA12 = Luminance12Alpha12+   | y == GL_LUMINANCE16_ALPHA16 = Luminance16Alpha16+   | y == GL_INTENSITY = Intensity+   | y == GL_INTENSITY4 = Intensity4+   | y == GL_INTENSITY8 = Intensity8+   | y == GL_INTENSITY12 = Intensity12+   | y == GL_INTENSITY16 = Intensity16+   | y == GL_R3_G3_B2 = R3G3B2+   | y == GL_RGB4 = RGB4+   | y == GL_RGB5 = RGB5+   | y == GL_RGB8 = RGB8+   | y == GL_RGB10 = RGB10+   | y == GL_RGB12 = RGB12+   | y == GL_RGB16 = RGB16+   | y == GL_RGBA2 = RGBA2+   | y == GL_RGBA4 = RGBA4+   | y == GL_RGB5_A1 = RGB5A1+   | y == GL_RGBA8 = RGBA8+   | y == GL_RGB10_A2 = RGB10A2+   | y == GL_RGBA12 = RGBA12+   | y == GL_RGBA16 = RGBA16+   | y == GL_SRGB8 = SRGB8+   | y == GL_SRGB8_ALPHA8 = SRGB8Alpha8+   | y == GL_R16F = R16F+   | y == GL_RG16F = RG16F+   | y == GL_RGB16F = RGB16F+   | y == GL_RGBA16F = RGBA16F+   | y == GL_R32F = R32F+   | y == GL_RG32F = RG32F+   | y == GL_RGB32F = RGB32F+   | y == GL_RGBA32F = RGBA32F+   | y == GL_R8I = R8I+   | y == GL_R8UI = R8UI+   | y == GL_R16I = R16I+   | y == GL_R16UI = R16UI+   | y == GL_R32I = R32I+   | y == GL_R32UI = R32UI+   | y == GL_RG8I = RG8I+   | y == GL_RG8UI = RG8UI+   | y == GL_RG16I = RG16I+   | y == GL_RG16UI = RG16UI+   | y == GL_R32I = RG32I+   | y == GL_R32UI = RG32UI+   | y == GL_RGB8I = RGB8I+   | y == GL_RGB8UI = RGB8UI+   | y == GL_RGB16I = RGB16I+   | y == GL_RGB16UI = RGB16UI+   | y == GL_RGB32I = RGB32I+   | y == GL_RGB32UI = RGB32UI+   | y == GL_RGBA8I = RGBA8I+   | y == GL_RGBA8UI = RGBA8UI+   | y == GL_RGBA16I = RGBA16I+   | y == GL_RGBA16UI = RGBA16UI+   | y == GL_RGBA32I = RGBA32I+   | y == GL_RGBA32UI = RGBA32UI+   | y == GL_SLUMINANCE8 = SLuminance8+   | y == GL_SLUMINANCE8_ALPHA8 = SLuminance8Alpha8+   | y == GL_COMPRESSED_ALPHA = CompressedAlpha+   | y == GL_COMPRESSED_LUMINANCE = CompressedLuminance+   | y == GL_COMPRESSED_LUMINANCE_ALPHA = CompressedLuminanceAlpha+   | y == GL_COMPRESSED_INTENSITY = CompressedIntensity+   | y == GL_COMPRESSED_RED = CompressedRed+   | y == GL_COMPRESSED_RG = CompressedRG+   | y == GL_COMPRESSED_RGB = CompressedRGB+   | y == GL_COMPRESSED_RGBA = CompressedRGBA+   | y == GL_COMPRESSED_SRGB = CompressedSRGB+   | y == GL_COMPRESSED_SRGB_ALPHA = CompressedSRGBAlpha+   | y == GL_COMPRESSED_SLUMINANCE = CompressedSLuminance+   | y == GL_COMPRESSED_SLUMINANCE_ALPHA = CompressedSLuminanceAlpha+   | y == GL_COMPRESSED_RED_RGTC1 = CompressedRedRGTC1+   | y == GL_COMPRESSED_SIGNED_RED_RGTC1 = CompressedSignedRedRGTC1+   | y == GL_COMPRESSED_RG_RGTC2 = CompressedRG_RGTC2+   | y == GL_COMPRESSED_SIGNED_RG_RGTC2 = CompressedSignedRG_RGTC2+   | y == GL_DEPTH_COMPONENT32F = DepthComponent32f+   | y == GL_DEPTH32F_STENCIL8 = Depth32fStencil8+   | y == GL_RGB9_E5 = RGB9E5+   | y == GL_STENCIL_INDEX1 = StencilIndex1+   | y == GL_STENCIL_INDEX4 = StencilIndex4+   | y == GL_STENCIL_INDEX8 = StencilIndex8+   | y == GL_STENCIL_INDEX16 = StencilIndex16+   | y == GL_RGB_S3TC = RGBS3TC+   | y == GL_RGB4_S3TC = RGB4S3TC+   | y == GL_RGBA_S3TC = RGBAS3TC+   | y == GL_RGBA4_S3TC = RGBA4S3TC+   | y == GL_RGBA_DXT5_S3TC = RGBADXT5S3TC+   | y == GL_RGBA4_DXT5_S3TC = RGBA4DXT5S3TC+   | y == GL_COMPRESSED_RGBA_S3TC_DXT1_EXT = CompressedRGBAS3TCDXT1+   | y == GL_COMPRESSED_RGBA_S3TC_DXT3_EXT = CompressedRGBAS3TCDXT3+   | y == GL_COMPRESSED_RGBA_S3TC_DXT5_EXT = CompressedRGBAS3TCDXT5+   | y == GL_COMPRESSED_RGB_S3TC_DXT1_EXT = CompressedRGBS3TCDXT1+   | y == GL_ALPHA32F_ARB = Alpha32F+   | y == GL_INTENSITY32F_ARB = Intensity32F+   | y == GL_LUMINANCE32F_ARB = Luminance32F+   | y == GL_LUMINANCE_ALPHA32F_ARB = LuminanceAlpha32F+   | y == GL_ALPHA16F_ARB = Alpha16F+   | y == GL_INTENSITY16F_ARB = Intensity16F+   | y == GL_LUMINANCE16F_ARB = Luminance16F+   | y == GL_LUMINANCE_ALPHA16F_ARB = LuminanceAlpha16F+   | y == GL_DEPTH24_STENCIL8_EXT = Depth24Stencil8+   -- legacy values+   | y == 1 = Luminance'+   | y == 2 = LuminanceAlpha'+   | y == 3 = RGB'+   | y == 4 = RGBA'+   | otherwise = error ("unmarshalPixelInternalFormat: illegal value " ++ show x)+   where y = fromIntegral x++-- Note: The following formats are still missing, it's a bit unclear how to+-- handle these nicely. From the EXT_texture_sRGB spec:+--+--    Accepted by the <internalformat> parameter of TexImage2D, CopyTexImage2D,+--    and CompressedTexImage2DARB and the <format> parameter of+--    CompressedTexSubImage2DARB:+--+--       COMPRESSED_SRGB_S3TC_DXT1_EXT                  0x8C4C+--       COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT            0x8C4D+--       COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT            0x8C4E+--       COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT            0x8C4F
+ src/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs view
@@ -0,0 +1,200 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Queries+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module offers various texture queries.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.Queries (+   TextureQuery, textureInternalFormat, textureSize1D, textureSize2D,+   textureSize3D, textureBorder, textureRGBASizes, textureSharedSize,+   textureIntensitySize, textureLuminanceSize, textureIndexSize,+   textureDepthBits, textureCompressedImageSize, textureProxyOK,+   DataRepresentation(..), textureRGBATypes, textureIntensityType,+   textureLuminanceType, textureDepthType+) where++import Control.Monad+import Data.StateVar+import Foreign.Marshal.Utils+import Graphics.Rendering.OpenGL.GL.DataType+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelRectangles+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.Texturing.Specification+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++data TexLevelParameter =+     TextureInternalFormat+   | TextureWidth+   | TextureHeight+   | TextureDepth+   | TextureBorder+   | TextureRedSize+   | TextureGreenSize+   | TextureBlueSize+   | TextureAlphaSize+   | TextureIntensitySize+   | TextureLuminanceSize+   | TextureIndexSize+   | DepthBits+   | TextureCompressedImageSize+   | TextureCompressed+   | TextureSharedSize+   | TextureRedType+   | TextureGreenType+   | TextureBlueType+   | TextureAlphaType+   | TextureLuminanceType+   | TextureIntensityType+   | TextureDepthType++marshalTexLevelParameter :: TexLevelParameter -> GLenum+marshalTexLevelParameter x = case x of+   TextureInternalFormat -> GL_TEXTURE_INTERNAL_FORMAT+   TextureWidth -> GL_TEXTURE_WIDTH+   TextureHeight -> GL_TEXTURE_HEIGHT+   TextureDepth -> GL_TEXTURE_DEPTH+   TextureBorder -> GL_TEXTURE_BORDER+   TextureRedSize -> GL_TEXTURE_RED_SIZE+   TextureGreenSize -> GL_TEXTURE_GREEN_SIZE+   TextureBlueSize -> GL_TEXTURE_BLUE_SIZE+   TextureAlphaSize -> GL_TEXTURE_ALPHA_SIZE+   TextureIntensitySize -> GL_TEXTURE_INTENSITY_SIZE+   TextureLuminanceSize -> GL_TEXTURE_LUMINANCE_SIZE+   TextureIndexSize -> GL_TEXTURE_INDEX_SIZE_EXT+   DepthBits -> GL_DEPTH_BITS+   TextureCompressedImageSize -> GL_TEXTURE_COMPRESSED_IMAGE_SIZE+   TextureCompressed -> GL_TEXTURE_COMPRESSED+   TextureSharedSize -> GL_TEXTURE_SHARED_SIZE+   TextureRedType -> GL_TEXTURE_RED_TYPE_ARB+   TextureGreenType -> GL_TEXTURE_GREEN_TYPE_ARB+   TextureBlueType -> GL_TEXTURE_BLUE_TYPE_ARB+   TextureAlphaType -> GL_TEXTURE_ALPHA_TYPE_ARB+   TextureLuminanceType -> GL_TEXTURE_LUMINANCE_TYPE_ARB+   TextureIntensityType -> GL_TEXTURE_INTENSITY_TYPE_ARB+   TextureDepthType -> GL_TEXTURE_DEPTH_TYPE_ARB++--------------------------------------------------------------------------------++type TextureQuery t a = t -> Level -> GettableStateVar a++textureInternalFormat :: QueryableTextureTarget t => TextureQuery t PixelInternalFormat+textureInternalFormat t level =+   makeGettableStateVar $+      getTexLevelParameteriNoProxy unmarshalPixelInternalFormat t level TextureInternalFormat++textureSize1D :: TextureQuery TextureTarget1D TextureSize1D+textureSize1D t level =+   makeGettableStateVar $+      liftM TextureSize1D+            (getTexLevelParameteriNoProxy fromIntegral t level TextureWidth)++textureSize2D :: TextureQuery TextureTarget2D TextureSize2D+textureSize2D t level =+   makeGettableStateVar $+      liftM2 TextureSize2D+             (getTexLevelParameteriNoProxy fromIntegral t level TextureWidth )+             (getTexLevelParameteriNoProxy fromIntegral t level TextureHeight)++textureSize3D :: TextureQuery TextureTarget3D TextureSize3D+textureSize3D t level =+   makeGettableStateVar $+      liftM3 TextureSize3D+             (getTexLevelParameteriNoProxy fromIntegral t level TextureWidth )+             (getTexLevelParameteriNoProxy fromIntegral t level TextureHeight)+             (getTexLevelParameteriNoProxy fromIntegral t level TextureDepth )++textureBorder :: QueryableTextureTarget t => TextureQuery t Border+textureBorder t level =+   makeGettableStateVar $+      getTexLevelParameteriNoProxy fromIntegral t level TextureBorder++textureRGBASizes :: QueryableTextureTarget t =>  TextureQuery t (Color4 GLsizei)+textureRGBASizes t level =+   makeGettableStateVar $+      liftM4 Color4+             (getTexLevelParameteriNoProxy fromIntegral t level TextureRedSize  )+             (getTexLevelParameteriNoProxy fromIntegral t level TextureGreenSize)+             (getTexLevelParameteriNoProxy fromIntegral t level TextureBlueSize )+             (getTexLevelParameteriNoProxy fromIntegral t level TextureAlphaSize)++textureSharedSize :: QueryableTextureTarget t =>  TextureQuery t GLsizei+textureSharedSize t level =+   makeGettableStateVar $+      getTexLevelParameteriNoProxy fromIntegral t level TextureSharedSize++textureIntensitySize :: QueryableTextureTarget t => TextureQuery t GLsizei+textureIntensitySize t level =+   makeGettableStateVar $+      getTexLevelParameteriNoProxy fromIntegral t level TextureIntensitySize++textureLuminanceSize :: QueryableTextureTarget t =>  TextureQuery t GLsizei+textureLuminanceSize t level =+   makeGettableStateVar $+      getTexLevelParameteriNoProxy fromIntegral t level TextureLuminanceSize++textureIndexSize :: QueryableTextureTarget t => TextureQuery t GLsizei+textureIndexSize t level =+   makeGettableStateVar $+      getTexLevelParameteriNoProxy fromIntegral t level TextureIndexSize++textureDepthBits :: QueryableTextureTarget t => TextureQuery t GLsizei+textureDepthBits t level =+   makeGettableStateVar $+      getTexLevelParameteriNoProxy fromIntegral t level DepthBits++textureCompressedImageSize :: QueryableTextureTarget t => TextureQuery t (Maybe GLsizei)+textureCompressedImageSize t level =+   makeGettableStateVar $ do+      isCompressed <- getTexLevelParameteriNoProxy unmarshalGLboolean t level TextureCompressed+      if isCompressed+         then getTexLevelParameteriNoProxy (Just . fromIntegral) t level TextureCompressedImageSize+         else return Nothing++textureProxyOK :: ParameterizedTextureTarget t => TextureQuery t Bool+textureProxyOK t level =+   makeGettableStateVar $+      getTexLevelParameteri unmarshalGLboolean (marshalParameterizedTextureTargetProxy t) level TextureWidth++textureRGBATypes :: QueryableTextureTarget t =>  TextureQuery t (Color4 (Maybe DataRepresentation))+textureRGBATypes t level =+   makeGettableStateVar $+      liftM4 Color4+             (getDataRepr t level TextureRedType  )+             (getDataRepr t level TextureGreenType)+             (getDataRepr t level TextureBlueType )+             (getDataRepr t level TextureAlphaType)++getDataRepr :: QueryableTextureTarget t => t -> Level -> TexLevelParameter -> IO (Maybe DataRepresentation)+getDataRepr = getTexLevelParameteriNoProxy (unmarshalDataRepresentation . fromIntegral)++textureIntensityType :: QueryableTextureTarget t => TextureQuery t (Maybe DataRepresentation)+textureIntensityType t level = makeGettableStateVar $ getDataRepr t level TextureIntensityType++textureLuminanceType :: QueryableTextureTarget t =>  TextureQuery t (Maybe DataRepresentation)+textureLuminanceType t level = makeGettableStateVar $ getDataRepr t level TextureLuminanceType++textureDepthType :: QueryableTextureTarget t =>  TextureQuery t (Maybe DataRepresentation)+textureDepthType t level = makeGettableStateVar $ getDataRepr t level TextureDepthType++getTexLevelParameteriNoProxy :: QueryableTextureTarget t => (GLint -> a) -> t -> Level -> TexLevelParameter -> IO a+getTexLevelParameteriNoProxy f = getTexLevelParameteri f . marshalQueryableTextureTarget++getTexLevelParameteri :: (GLint -> a) -> GLenum -> Level -> TexLevelParameter -> IO a+getTexLevelParameteri f t level p =+   with 0 $ \buf -> do+      glGetTexLevelParameteriv t level (marshalTexLevelParameter p) buf+      peek1 f buf
+ src/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs view
@@ -0,0 +1,352 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Specification+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 3.8.1 (Texture Image Specification),+-- section 3.8.2 (Alternate Texture Image Specification Commands), and section+-- 3.8.3 (Compressed Texture Images) of the OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.Specification (+   -- * Texture Targets++   -- ** One-Dimensional Texture Targets+   TextureTarget1D(..),++   -- ** Two-Dimensional Texture Targets+   TextureTarget2D(..),+   TextureTarget2DMultisample(..),+   TextureTargetCubeMap(..),+   TextureTargetCubeMapFace(..),++   -- ** Three-Dimensional Texture Targets+   TextureTarget3D(..),+   TextureTarget2DMultisampleArray(..),++   -- ** Texture Buffer Target+   TextureTargetBuffer(..),++   -- ** Texture Target Classification+   BindableTextureTarget,+   ParameterizedTextureTarget,+   OneDimensionalTextureTarget,+   TwoDimensionalTextureTarget,+   ThreeDimensionalTextureTarget,+   QueryableTextureTarget,+   GettableTextureTarget,++   -- * Texture-related Data Types+   Level, Border,+   TexturePosition1D(..), TexturePosition2D(..), TexturePosition3D(..),+   TextureSize1D(..), TextureSize2D(..), TextureSize3D(..),++   -- * Texture Image Specification+   texImage1D, texImage2D, texImage3D,+   copyTexImage1D, copyTexImage2D,+   texSubImage1D, texSubImage2D, texSubImage3D,+   getTexImage,++   -- * Alternate Texture Image Specification Commands+   copyTexSubImage1D, copyTexSubImage2D, copyTexSubImage3D,++   -- * Compressed Texture Images+   CompressedTextureFormat(..), compressedTextureFormats,+   CompressedPixelData(..),+   compressedTexImage1D, compressedTexImage2D, compressedTexImage3D,+   compressedTexSubImage1D, compressedTexSubImage2D, compressedTexSubImage3D,+   getCompressedTexImage,++   -- * Multisample Texture Images+   SampleLocations(..), texImage2DMultisample, texImage3DMultisample,++   -- * Implementation-Dependent Limits+   maxTextureSize, maxCubeMapTextureSize, maxRectangleTextureSize,+   max3DTextureSize, maxArrayTextureLayers, maxSampleMaskWords,+   maxColorTextureSamples, maxDepthTextureSamples, maxIntegerSamples+) where++import Foreign.Ptr+import Data.StateVar+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.PixelRectangles+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.GL++--------------------------------------------------------------------------------++type Level = GLint++type Border = GLint++newtype TexturePosition1D = TexturePosition1D GLint+   deriving ( Eq, Ord, Show )++data TexturePosition2D = TexturePosition2D !GLint !GLint+   deriving ( Eq, Ord, Show )++data TexturePosition3D = TexturePosition3D !GLint !GLint !GLint+   deriving ( Eq, Ord, Show )++newtype TextureSize1D = TextureSize1D GLsizei+   deriving ( Eq, Ord, Show )++data TextureSize2D = TextureSize2D !GLsizei !GLsizei+   deriving ( Eq, Ord, Show )++data TextureSize3D = TextureSize3D !GLsizei !GLsizei !GLsizei+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++texImage1D :: OneDimensionalTextureTarget t => t -> Proxy -> Level -> PixelInternalFormat -> TextureSize1D -> Border -> PixelData a -> IO ()+texImage1D target proxy level int (TextureSize1D w) border pd =+   withPixelData pd $+      glTexImage1D+         (marshalOneDimensionalTextureTarget proxy target)+         level (marshalPixelInternalFormat int) w border++--------------------------------------------------------------------------------++texImage2D :: TwoDimensionalTextureTarget t => t -> Proxy -> Level -> PixelInternalFormat -> TextureSize2D -> Border -> PixelData a -> IO ()+texImage2D target proxy level int (TextureSize2D w h) border pd =+   withPixelData pd $+      glTexImage2D (marshalTwoDimensionalTextureTarget proxy target) level (marshalPixelInternalFormat int) w h border++--------------------------------------------------------------------------------++texImage3D :: ThreeDimensionalTextureTarget t => t -> Proxy -> Level -> PixelInternalFormat -> TextureSize3D -> Border -> PixelData a -> IO ()+texImage3D target proxy level int (TextureSize3D w h d) border pd =+   withPixelData pd $+      glTexImage3D+         (marshalThreeDimensionalTextureTarget proxy target)+         level (marshalPixelInternalFormat int) w h d border++--------------------------------------------------------------------------------++getTexImage :: GettableTextureTarget t => t -> Level -> PixelData a -> IO ()+getTexImage target level pd =+   withPixelData pd $+      glGetTexImage (marshalGettableTextureTarget target) level++--------------------------------------------------------------------------------++copyTexImage1D :: OneDimensionalTextureTarget t => t -> Level -> PixelInternalFormat -> Position -> TextureSize1D -> Border -> IO ()+copyTexImage1D target level int (Position x y) (TextureSize1D w) border =+   glCopyTexImage1D+      (marshalOneDimensionalTextureTarget NoProxy target) level+      (marshalPixelInternalFormat' int) x y w border++--------------------------------------------------------------------------------++copyTexImage2D :: TwoDimensionalTextureTarget t => t -> Level -> PixelInternalFormat -> Position -> TextureSize2D -> Border -> IO ()+copyTexImage2D target level int (Position x y) (TextureSize2D w h) border =+   glCopyTexImage2D+      (marshalTwoDimensionalTextureTarget NoProxy target) level+      (marshalPixelInternalFormat' int) x y w h border++--------------------------------------------------------------------------------++texSubImage1D :: OneDimensionalTextureTarget t => t -> Level -> TexturePosition1D -> TextureSize1D -> PixelData a -> IO ()+texSubImage1D target level (TexturePosition1D xOff) (TextureSize1D w) pd =+   withPixelData pd $+      glTexSubImage1D (marshalOneDimensionalTextureTarget NoProxy target) level xOff w++--------------------------------------------------------------------------------++texSubImage2D :: TwoDimensionalTextureTarget t => t -> Level -> TexturePosition2D -> TextureSize2D -> PixelData a -> IO ()+texSubImage2D target level (TexturePosition2D xOff yOff) (TextureSize2D w h) pd =+   withPixelData pd $+      glTexSubImage2D (marshalTwoDimensionalTextureTarget NoProxy target) level xOff yOff w h++--------------------------------------------------------------------------------++texSubImage3D :: ThreeDimensionalTextureTarget t => t -> Level -> TexturePosition3D -> TextureSize3D -> PixelData a -> IO ()+texSubImage3D target level (TexturePosition3D xOff yOff zOff) (TextureSize3D w h d) pd =+   withPixelData pd $+      glTexSubImage3D (marshalThreeDimensionalTextureTarget NoProxy target) level xOff yOff zOff w h d++--------------------------------------------------------------------------------++copyTexSubImage1D :: OneDimensionalTextureTarget t => t -> Level -> TexturePosition1D -> Position -> TextureSize1D -> IO ()+copyTexSubImage1D target level (TexturePosition1D xOff) (Position x y) (TextureSize1D w) =+   glCopyTexSubImage1D (marshalOneDimensionalTextureTarget NoProxy target) level xOff x y w++--------------------------------------------------------------------------------++copyTexSubImage2D :: TwoDimensionalTextureTarget t => t -> Level -> TexturePosition2D -> Position -> TextureSize2D -> IO ()+copyTexSubImage2D target level (TexturePosition2D xOff yOff) (Position x y) (TextureSize2D w h) =+   glCopyTexSubImage2D (marshalTwoDimensionalTextureTarget NoProxy target) level xOff yOff x y w h++--------------------------------------------------------------------------------++copyTexSubImage3D :: ThreeDimensionalTextureTarget t => t -> Level -> TexturePosition3D -> Position -> TextureSize2D -> IO ()+copyTexSubImage3D target level (TexturePosition3D xOff yOff zOff) (Position x y) (TextureSize2D w h) =+   glCopyTexSubImage3D (marshalThreeDimensionalTextureTarget NoProxy target) level xOff yOff zOff x y w h++--------------------------------------------------------------------------------++newtype CompressedTextureFormat = CompressedTextureFormat GLenum+   deriving ( Eq, Ord, Show )++compressedTextureFormats :: GettableStateVar [CompressedTextureFormat]+compressedTextureFormats =+   makeGettableStateVar $ do+      n <- getInteger1 fromIntegral GetNumCompressedTextureFormats+      getEnumN CompressedTextureFormat GetCompressedTextureFormats n++--------------------------------------------------------------------------------++data CompressedPixelData a =+     CompressedPixelData !CompressedTextureFormat GLsizei (Ptr a)+   deriving ( Eq, Ord, Show )++withCompressedPixelData ::+   CompressedPixelData a -> (GLenum -> GLsizei -> Ptr a -> b) -> b+withCompressedPixelData+   (CompressedPixelData (CompressedTextureFormat fmt) size ptr) f =+   f fmt size ptr++--------------------------------------------------------------------------------++compressedTexImage1D :: OneDimensionalTextureTarget t => t -> Proxy -> Level -> TextureSize1D -> Border -> CompressedPixelData a -> IO ()+compressedTexImage1D target proxy level (TextureSize1D w) border cpd =+   withCompressedPixelData cpd $ \fmt ->+      glCompressedTexImage1D+         (marshalOneDimensionalTextureTarget proxy target) level fmt w border++--------------------------------------------------------------------------------++-- Note that the spec currently disallows TextureRectangle, but then again the+-- extension specification explicitly allows a relaxation in the future.+compressedTexImage2D :: TwoDimensionalTextureTarget t => t -> Proxy -> Level -> TextureSize2D -> Border -> CompressedPixelData a -> IO ()+compressedTexImage2D target proxy level (TextureSize2D w h) border cpd =+   withCompressedPixelData cpd $ \fmt ->+      glCompressedTexImage2D (marshalTwoDimensionalTextureTarget proxy target) level fmt w h border++--------------------------------------------------------------------------------++compressedTexImage3D :: ThreeDimensionalTextureTarget t => t -> Proxy -> Level -> TextureSize3D -> Border -> CompressedPixelData a -> IO ()+compressedTexImage3D target proxy level (TextureSize3D w h d) border cpd =+   withCompressedPixelData cpd $ \fmt ->+      glCompressedTexImage3D+         (marshalThreeDimensionalTextureTarget proxy target) level fmt w h d border++--------------------------------------------------------------------------------++getCompressedTexImage :: GettableTextureTarget t => t -> Level -> Ptr a -> IO ()+getCompressedTexImage = glGetCompressedTexImage . marshalGettableTextureTarget++--------------------------------------------------------------------------------++compressedTexSubImage1D :: OneDimensionalTextureTarget t => t -> Level -> TexturePosition1D -> TextureSize1D -> CompressedPixelData a -> IO ()+compressedTexSubImage1D target level (TexturePosition1D xOff) (TextureSize1D w) cpd =+   withCompressedPixelData cpd $+      glCompressedTexSubImage1D (marshalOneDimensionalTextureTarget NoProxy target) level xOff w++--------------------------------------------------------------------------------++compressedTexSubImage2D :: TwoDimensionalTextureTarget t => t -> Level -> TexturePosition2D -> TextureSize2D -> CompressedPixelData a -> IO ()+compressedTexSubImage2D target  level (TexturePosition2D xOff yOff) (TextureSize2D w h) cpd =+   withCompressedPixelData cpd $+      glCompressedTexSubImage2D (marshalTwoDimensionalTextureTarget NoProxy target) level xOff yOff w h++--------------------------------------------------------------------------------++-- see texImage3D, but no proxies+compressedTexSubImage3D :: ThreeDimensionalTextureTarget t => t -> Level -> TexturePosition3D -> TextureSize3D -> CompressedPixelData a -> IO ()+compressedTexSubImage3D target level (TexturePosition3D xOff yOff zOff) (TextureSize3D w h d) cpd =+   withCompressedPixelData cpd $+      glCompressedTexSubImage3D (marshalThreeDimensionalTextureTarget NoProxy target) level xOff yOff zOff w h d++--------------------------------------------------------------------------------++data SampleLocations =+     FlexibleSampleLocations+   | FixedSampleLocations+   deriving ( Eq, Ord, Show )++marshalSampleLocations :: SampleLocations -> GLboolean+marshalSampleLocations = marshalGLboolean . (FixedSampleLocations ==)++{-+unmarshalSampleLocations :: GLboolean -> SampleLocations+unmarshalSampleLocations x =+   if unmarshalGLboolean x+      then FixedSampleLocations+      else FlexibleSampleLocations+-}++--------------------------------------------------------------------------------++texImage2DMultisample :: TextureTarget2DMultisample+                      -> Proxy+                      -> Samples+                      -> PixelInternalFormat+                      -> TextureSize2D+                      -> SampleLocations+                      -> IO ()+texImage2DMultisample target proxy (Samples s) int (TextureSize2D w h) loc =+   glTexImage2DMultisample+      (marshalMultisample proxy target) s (fromIntegral (marshalPixelInternalFormat int))+      w h (marshalSampleLocations loc)++marshalMultisample :: ParameterizedTextureTarget t => Proxy -> t -> GLenum+marshalMultisample proxy = case proxy of+   NoProxy -> marshalParameterizedTextureTarget+   Proxy -> marshalParameterizedTextureTargetProxy++texImage3DMultisample :: TextureTarget2DMultisampleArray+                      -> Proxy+                      -> Samples+                      -> PixelInternalFormat+                      -> TextureSize3D+                      -> SampleLocations+                      -> IO ()+texImage3DMultisample target proxy (Samples s) int (TextureSize3D w h d) loc =+   glTexImage3DMultisample+      (marshalMultisample proxy target) s (fromIntegral (marshalPixelInternalFormat int))+      w h d (marshalSampleLocations loc)++--------------------------------------------------------------------------------++maxTextureSize :: GettableStateVar GLsizei+maxTextureSize = maxTextureSizeWith GetMaxTextureSize++maxCubeMapTextureSize :: GettableStateVar GLsizei+maxCubeMapTextureSize = maxTextureSizeWith GetMaxCubeMapTextureSize++maxRectangleTextureSize :: GettableStateVar GLsizei+maxRectangleTextureSize = maxTextureSizeWith GetMaxRectangleTextureSize++max3DTextureSize :: GettableStateVar GLsizei+max3DTextureSize = maxTextureSizeWith GetMax3DTextureSize++maxArrayTextureLayers :: GettableStateVar GLsizei+maxArrayTextureLayers = maxTextureSizeWith GetMaxArrayTextureLayers++maxSampleMaskWords :: GettableStateVar GLsizei+maxSampleMaskWords = maxTextureSizeWith GetMaxSampleMaskWords++maxColorTextureSamples :: GettableStateVar GLsizei+maxColorTextureSamples = maxTextureSizeWith GetMaxColorTextureSamples++maxDepthTextureSamples :: GettableStateVar GLsizei+maxDepthTextureSamples = maxTextureSizeWith GetMaxDepthTextureSamples++maxIntegerSamples :: GettableStateVar GLsizei+maxIntegerSamples = maxTextureSizeWith GetMaxIntegerSamples++maxTextureSizeWith :: PName1I -> GettableStateVar GLsizei+maxTextureSizeWith = makeGettableStateVar . getInteger1 fromIntegral
+ src/Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs view
@@ -0,0 +1,132 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TexParameter+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for getting\/setting texture parameters.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.TexParameter (+   TexParameter(..), texParami, texParamf, texParamC4f, getTexParameteri+) where++import Data.StateVar+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.GL++--------------------------------------------------------------------------------++data TexParameter =+     TextureMinFilter+   | TextureMagFilter+   | TextureWrapS+   | TextureWrapT+   | TextureWrapR+   | TextureBorderColor+   | TextureMinLOD+   | TextureMaxLOD+   | TextureBaseLevel+   | TextureMaxLevel+   | TexturePriority+   | TextureMaxAnisotropy+   | TextureCompare+   | TextureCompareOperator+   | TextureCompareFailValue+   | GenerateMipmap+   | TextureCompareMode+   | TextureCompareFunc+   | DepthTextureMode+   | TextureLODBias+   | TextureResident++marshalTexParameter :: TexParameter -> GLenum+marshalTexParameter x = case x of+   TextureMinFilter -> GL_TEXTURE_MIN_FILTER+   TextureMagFilter -> GL_TEXTURE_MAG_FILTER+   TextureWrapS -> GL_TEXTURE_WRAP_S+   TextureWrapT -> GL_TEXTURE_WRAP_T+   TextureWrapR -> GL_TEXTURE_WRAP_R+   TextureBorderColor -> GL_TEXTURE_BORDER_COLOR+   TextureMinLOD -> GL_TEXTURE_MIN_LOD+   TextureMaxLOD -> GL_TEXTURE_MAX_LOD+   TextureBaseLevel -> GL_TEXTURE_BASE_LEVEL+   TextureMaxLevel -> GL_TEXTURE_MAX_LEVEL+   TexturePriority -> GL_TEXTURE_PRIORITY+   TextureMaxAnisotropy -> GL_TEXTURE_MAX_ANISOTROPY_EXT+   TextureCompare -> GL_TEXTURE_COMPARE_SGIX+   TextureCompareOperator -> GL_TEXTURE_COMPARE_OPERATOR_SGIX+   TextureCompareFailValue -> GL_TEXTURE_COMPARE_FAIL_VALUE_ARB+   GenerateMipmap -> GL_GENERATE_MIPMAP+   TextureCompareMode -> GL_TEXTURE_COMPARE_MODE+   TextureCompareFunc -> GL_TEXTURE_COMPARE_FUNC+   DepthTextureMode -> GL_DEPTH_TEXTURE_MODE+   TextureLODBias -> GL_TEXTURE_LOD_BIAS+   TextureResident -> GL_TEXTURE_RESIDENT++--------------------------------------------------------------------------------++texParameter :: ParameterizedTextureTarget t+             => (GLenum -> GLenum -> b -> IO ())+             -> (a -> (b -> IO ()) -> IO ())+             -> t -> TexParameter -> a -> IO ()+texParameter glTexParameter marshalAct t p x =+   marshalAct x $+      glTexParameter (marshalParameterizedTextureTarget t) (marshalTexParameter p)++--------------------------------------------------------------------------------++getTexParameter :: (Storable b, ParameterizedTextureTarget t)+                => (GLenum -> GLenum -> Ptr b -> IO ())+                -> (b -> a)+                -> t -> TexParameter -> IO a+getTexParameter glGetTexParameter unmarshal t p =+   alloca $ \buf -> do+     glGetTexParameter (marshalParameterizedTextureTarget t) (marshalTexParameter p) buf+     peek1 unmarshal buf++--------------------------------------------------------------------------------++m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()+m2a marshal x act = act (marshal x)++texParami :: ParameterizedTextureTarget t =>+   (GLint -> a) -> (a -> GLint) -> TexParameter -> t -> StateVar a+texParami unmarshal marshal p t =+   makeStateVar+      (getTexParameter glGetTexParameteriv unmarshal     t p)+      (texParameter    glTexParameteri     (m2a marshal) t p)++texParamf :: ParameterizedTextureTarget t =>+   (GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> t -> StateVar a+texParamf unmarshal marshal p t =+   makeStateVar+      (getTexParameter glGetTexParameterfv unmarshal     t p)+      (texParameter    glTexParameterf     (m2a marshal) t p)++texParamC4f :: ParameterizedTextureTarget t => TexParameter -> t -> StateVar (Color4 GLfloat)+texParamC4f p t =+   makeStateVar+      (getTexParameter glGetTexParameterC4f id   t p)+      (texParameter    glTexParameterC4f    with t p)++glTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glTexParameterC4f target pname ptr = glTexParameterfv target pname (castPtr ptr)++glGetTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glGetTexParameterC4f target pname ptr = glGetTexParameterfv target pname (castPtr ptr)++getTexParameteri :: ParameterizedTextureTarget t => (GLint -> a) -> t -> TexParameter -> IO a+getTexParameteri = getTexParameter glGetTexParameteriv
+ src/Graphics/Rendering/OpenGL/GL/Texturing/TextureObject.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureObject+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for handling texture objects.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.TextureObject (+   TextureObject(..)+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++--------------------------------------------------------------------------------++newtype TextureObject = TextureObject { textureID :: GLuint }+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++instance ObjectName TextureObject where+   isObjectName = liftIO . fmap unmarshalGLboolean . glIsTexture . textureID++   deleteObjectNames textureObjects =+      liftIO . withArrayLen (map textureID textureObjects) $+         glDeleteTextures . fromIntegral++instance GeneratableObjectName TextureObject where+   genObjectNames n =+      liftIO . allocaArray n $ \buf -> do+        glGenTextures (fromIntegral n) buf+        fmap (map TextureObject) $ peekArray n buf++instance CanBeLabeled TextureObject where+   objectLabel = objectNameLabel GL_TEXTURE . textureID
+ src/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs view
@@ -0,0 +1,297 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for marshaling texture targets.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (+   -- * Texture Target Classification+   BindableTextureTarget(..),+   ParameterizedTextureTarget(..),+   OneDimensionalTextureTarget(..),+   TwoDimensionalTextureTarget(..),+   ThreeDimensionalTextureTarget(..),+   QueryableTextureTarget(..),+   GettableTextureTarget(..),++   -- * One-Dimensional Texture Targets+   TextureTarget1D(..),++   -- * Two-Dimensional Texture Targets+   TextureTarget2D(..),+   TextureTarget2DMultisample(..),+   TextureTargetCubeMap(..),+   TextureTargetCubeMapFace(..),+   unmarshalTextureTargetCubeMapFace,++   -- * Three-Dimensional Texture Targets+   TextureTarget3D(..),+   TextureTarget2DMultisampleArray(..),++   -- * Texture Buffer Target+   TextureTargetBuffer(..)+) where++import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable+import Graphics.Rendering.OpenGL.GL.QueryUtils.PName+import Graphics.GL++--------------------------------------------------------------------------------++class BindableTextureTarget t where+   marshalBindableTextureTarget :: t -> GLenum+   marshalBindableTextureTargetPName1I :: t -> PName1I++class ParameterizedTextureTarget t where+   marshalParameterizedTextureTarget :: t -> GLenum+   marshalParameterizedTextureTargetProxy :: t -> GLenum+   marshalParameterizedTextureTargetEnableCap :: t -> EnableCap++class OneDimensionalTextureTarget t where+   marshalOneDimensionalTextureTarget :: Proxy -> t -> GLenum++class TwoDimensionalTextureTarget t where+   marshalTwoDimensionalTextureTarget :: Proxy -> t -> GLenum++class ThreeDimensionalTextureTarget t where+   marshalThreeDimensionalTextureTarget :: Proxy -> t -> GLenum++class QueryableTextureTarget t where+   marshalQueryableTextureTarget :: t -> GLenum++class GettableTextureTarget t where+   marshalGettableTextureTarget :: t -> GLenum++--------------------------------------------------------------------------------++data TextureTarget1D = Texture1D+   deriving ( Eq, Ord, Show )++instance BindableTextureTarget TextureTarget1D where+   marshalBindableTextureTarget = marshalParameterizedTextureTarget+   marshalBindableTextureTargetPName1I t = case t of+      Texture1D -> GetTextureBinding1D++instance ParameterizedTextureTarget TextureTarget1D where+   marshalParameterizedTextureTarget t = case t of+      Texture1D -> GL_TEXTURE_1D+   marshalParameterizedTextureTargetProxy t = case t of+      Texture1D -> GL_PROXY_TEXTURE_1D+   marshalParameterizedTextureTargetEnableCap t = case t of+      Texture1D -> CapTexture1D++instance OneDimensionalTextureTarget TextureTarget1D where+   marshalOneDimensionalTextureTarget p = case p of+      NoProxy -> marshalParameterizedTextureTarget+      Proxy -> marshalParameterizedTextureTargetProxy++instance QueryableTextureTarget TextureTarget1D where+   marshalQueryableTextureTarget = marshalParameterizedTextureTarget++instance GettableTextureTarget TextureTarget1D where+   marshalGettableTextureTarget = marshalParameterizedTextureTarget++--------------------------------------------------------------------------------++data TextureTarget2D =+     Texture2D+   | Texture1DArray+   | TextureRectangle+   deriving ( Eq, Ord, Show )++instance BindableTextureTarget TextureTarget2D where+   marshalBindableTextureTarget = marshalParameterizedTextureTarget+   marshalBindableTextureTargetPName1I t = case t of+      Texture2D -> GetTextureBinding2D+      Texture1DArray -> GetTextureBinding1DArray+      TextureRectangle -> GetTextureBindingRectangle++instance ParameterizedTextureTarget TextureTarget2D where+   marshalParameterizedTextureTarget t = case t of+      Texture2D -> GL_TEXTURE_2D+      Texture1DArray -> GL_TEXTURE_1D_ARRAY+      TextureRectangle -> GL_TEXTURE_RECTANGLE+   marshalParameterizedTextureTargetProxy t = case t of+      Texture2D -> GL_PROXY_TEXTURE_2D+      Texture1DArray -> GL_PROXY_TEXTURE_1D_ARRAY+      TextureRectangle -> GL_PROXY_TEXTURE_RECTANGLE+   marshalParameterizedTextureTargetEnableCap t = case t of+      Texture2D -> CapTexture2D+      Texture1DArray -> CapTexture1DArray+      TextureRectangle -> CapTextureRectangle++instance TwoDimensionalTextureTarget TextureTarget2D where+   marshalTwoDimensionalTextureTarget p = case p of+      NoProxy -> marshalParameterizedTextureTarget+      Proxy -> marshalParameterizedTextureTargetProxy++instance QueryableTextureTarget TextureTarget2D where+   marshalQueryableTextureTarget = marshalParameterizedTextureTarget++instance GettableTextureTarget TextureTarget2D where+   marshalGettableTextureTarget = marshalParameterizedTextureTarget++--------------------------------------------------------------------------------++data TextureTarget2DMultisample = Texture2DMultisample+   deriving ( Eq, Ord, Show )++instance BindableTextureTarget TextureTarget2DMultisample where+   marshalBindableTextureTarget = marshalParameterizedTextureTarget+   marshalBindableTextureTargetPName1I t = case t of+      Texture2DMultisample -> GetTextureBinding2DMultisample++instance ParameterizedTextureTarget TextureTarget2DMultisample where+   marshalParameterizedTextureTarget t = case t of+      Texture2DMultisample -> GL_TEXTURE_2D_MULTISAMPLE+   marshalParameterizedTextureTargetProxy t = case t of+      Texture2DMultisample -> GL_PROXY_TEXTURE_2D_MULTISAMPLE+   marshalParameterizedTextureTargetEnableCap t = case t of+      Texture2DMultisample -> CapTexture2DMultisample++instance QueryableTextureTarget TextureTarget2DMultisample where+   marshalQueryableTextureTarget = marshalParameterizedTextureTarget++--------------------------------------------------------------------------------++data TextureTargetCubeMap = TextureCubeMap+   deriving ( Eq, Ord, Show )++instance BindableTextureTarget TextureTargetCubeMap where+   marshalBindableTextureTarget = marshalParameterizedTextureTarget+   marshalBindableTextureTargetPName1I t = case t of+      TextureCubeMap -> GetTextureBindingCubeMap++instance ParameterizedTextureTarget TextureTargetCubeMap where+   marshalParameterizedTextureTarget t = case t of+      TextureCubeMap -> GL_TEXTURE_CUBE_MAP+   marshalParameterizedTextureTargetProxy t = case t of+      TextureCubeMap -> GL_PROXY_TEXTURE_CUBE_MAP+   marshalParameterizedTextureTargetEnableCap t = case t of+      TextureCubeMap -> CapTextureCubeMap++instance TwoDimensionalTextureTarget TextureTargetCubeMap where+   marshalTwoDimensionalTextureTarget p = case p of+      NoProxy -> \t -> error ("No non-proxy target for " ++ show t)+      Proxy -> marshalParameterizedTextureTargetProxy++--------------------------------------------------------------------------------++data TextureTargetCubeMapFace =+     TextureCubeMapPositiveX+   | TextureCubeMapNegativeX+   | TextureCubeMapPositiveY+   | TextureCubeMapNegativeY+   | TextureCubeMapPositiveZ+   | TextureCubeMapNegativeZ+   deriving ( Eq, Ord, Show )++instance TwoDimensionalTextureTarget TextureTargetCubeMapFace where+   marshalTwoDimensionalTextureTarget p = case p of+      NoProxy -> marshalQueryableTextureTarget+      -- We could silently map this to TextureCubeMap if we wanted.+      Proxy -> \t -> error ("No proxy target for " ++ show t)++instance QueryableTextureTarget TextureTargetCubeMapFace where+   marshalQueryableTextureTarget t = case t of+      TextureCubeMapPositiveX -> GL_TEXTURE_CUBE_MAP_POSITIVE_X+      TextureCubeMapNegativeX -> GL_TEXTURE_CUBE_MAP_NEGATIVE_X+      TextureCubeMapPositiveY -> GL_TEXTURE_CUBE_MAP_POSITIVE_Y+      TextureCubeMapNegativeY -> GL_TEXTURE_CUBE_MAP_NEGATIVE_Y+      TextureCubeMapPositiveZ -> GL_TEXTURE_CUBE_MAP_POSITIVE_Z+      TextureCubeMapNegativeZ -> GL_TEXTURE_CUBE_MAP_NEGATIVE_Z++instance GettableTextureTarget TextureTargetCubeMapFace where+   marshalGettableTextureTarget = marshalQueryableTextureTarget++unmarshalTextureTargetCubeMapFace :: GLenum -> TextureTargetCubeMapFace+unmarshalTextureTargetCubeMapFace x+   | x == GL_TEXTURE_CUBE_MAP_POSITIVE_X = TextureCubeMapPositiveX+   | x == GL_TEXTURE_CUBE_MAP_NEGATIVE_X = TextureCubeMapNegativeX+   | x == GL_TEXTURE_CUBE_MAP_POSITIVE_Y = TextureCubeMapPositiveY+   | x == GL_TEXTURE_CUBE_MAP_NEGATIVE_Y = TextureCubeMapNegativeY+   | x == GL_TEXTURE_CUBE_MAP_POSITIVE_Z = TextureCubeMapPositiveZ+   | x == GL_TEXTURE_CUBE_MAP_NEGATIVE_Z = TextureCubeMapNegativeZ+   | otherwise = error $ "unmarshalTextureTargetCubeMapFace: unknown enum " ++ show x++--------------------------------------------------------------------------------++data TextureTarget3D =+     Texture3D+   | Texture2DArray+   | TextureCubeMapArray+   deriving ( Eq, Ord, Show )++instance BindableTextureTarget TextureTarget3D where+   marshalBindableTextureTarget = marshalParameterizedTextureTarget+   marshalBindableTextureTargetPName1I t = case t of+      Texture3D -> GetTextureBinding3D+      Texture2DArray -> GetTextureBinding2DArray+      TextureCubeMapArray -> GetTextureBindingCubeMapArray++instance ParameterizedTextureTarget TextureTarget3D where+   marshalParameterizedTextureTarget t = case t of+      Texture3D -> GL_TEXTURE_3D+      Texture2DArray -> GL_TEXTURE_2D_ARRAY+      TextureCubeMapArray -> GL_TEXTURE_CUBE_MAP_ARRAY+   marshalParameterizedTextureTargetProxy t = case t of+      Texture3D -> GL_PROXY_TEXTURE_3D+      Texture2DArray -> GL_PROXY_TEXTURE_2D_ARRAY+      TextureCubeMapArray -> GL_PROXY_TEXTURE_CUBE_MAP_ARRAY+   marshalParameterizedTextureTargetEnableCap t = case t of+      Texture3D -> CapTexture3D+      Texture2DArray -> CapTexture2DArray+      TextureCubeMapArray -> CapTextureCubeMapArray++instance ThreeDimensionalTextureTarget TextureTarget3D where+   marshalThreeDimensionalTextureTarget p = case p of+      NoProxy -> marshalParameterizedTextureTarget+      Proxy -> marshalParameterizedTextureTargetProxy++instance QueryableTextureTarget TextureTarget3D where+   marshalQueryableTextureTarget = marshalParameterizedTextureTarget++instance GettableTextureTarget TextureTarget3D where+   marshalGettableTextureTarget = marshalParameterizedTextureTarget++--------------------------------------------------------------------------------++data TextureTarget2DMultisampleArray = Texture2DMultisampleArray+   deriving ( Eq, Ord, Show )++instance BindableTextureTarget TextureTarget2DMultisampleArray where+   marshalBindableTextureTarget = marshalParameterizedTextureTarget+   marshalBindableTextureTargetPName1I t = case t of+      Texture2DMultisampleArray -> GetTextureBinding2DMultisampleArray++instance ParameterizedTextureTarget TextureTarget2DMultisampleArray where+   marshalParameterizedTextureTarget t = case t of+      Texture2DMultisampleArray -> GL_TEXTURE_2D_MULTISAMPLE_ARRAY+   marshalParameterizedTextureTargetProxy t = case t of+      Texture2DMultisampleArray -> GL_PROXY_TEXTURE_2D_MULTISAMPLE_ARRAY+   marshalParameterizedTextureTargetEnableCap t = case t of+      Texture2DMultisampleArray -> CapTexture2DMultisampleArray++instance QueryableTextureTarget TextureTarget2DMultisampleArray where+   marshalQueryableTextureTarget = marshalParameterizedTextureTarget++--------------------------------------------------------------------------------++data TextureTargetBuffer = TextureBuffer'+   deriving ( Eq, Ord, Show )++instance BindableTextureTarget TextureTargetBuffer where+   marshalBindableTextureTarget t = case t of+      TextureBuffer' -> GL_TEXTURE_BUFFER+   marshalBindableTextureTargetPName1I t = case t of+      TextureBuffer' -> GetTextureBindingBuffer
+ src/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for (un-)marshaling TextureUnit.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit (+   TextureUnit(..), marshalTextureUnit, unmarshalTextureUnit+) where++import Foreign.Ptr+import Foreign.Storable+import Graphics.GL++--------------------------------------------------------------------------------++-- | Identifies a texture unit via its number, which must be in the range of+-- (0 .. 'maxTextureUnit').++newtype TextureUnit = TextureUnit GLuint+   deriving ( Eq, Ord, Show )++-- Internal note, when setting a sampler (TextureUnit) uniform the GLint+-- functions should be used.++instance Storable TextureUnit where+    sizeOf _                 = sizeOf    (undefined :: GLuint)+    alignment _              = alignment (undefined :: GLuint)+    peek pt                  = peek (castPtr pt) >>= return . TextureUnit+    poke pt (TextureUnit tu) = poke (castPtr pt) tu+    peekByteOff pt off       = peekByteOff pt off >>= return . TextureUnit+    pokeByteOff pt off (TextureUnit tu)+                             = pokeByteOff pt off tu++++marshalTextureUnit :: TextureUnit -> GLenum+marshalTextureUnit (TextureUnit x) = GL_TEXTURE0 + fromIntegral x++unmarshalTextureUnit :: GLenum -> TextureUnit+unmarshalTextureUnit x = TextureUnit (fromIntegral (x - GL_TEXTURE0))
+ src/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs view
@@ -0,0 +1,128 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.TransformFeedback+-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.TransformFeedback (+   -- * starting and ending+   beginTransformFeedback, endTransformFeedback,++   -- * TransformFeedbackBufferMode+   TransformFeedbackBufferMode(..), marshalTransformFeedbackBufferMode,+   unmarshalTransformFeedbackBufferMode,++   -- * Shader related+   transformFeedbackBufferMode,+   transformFeedbackVaryings,+   setTransformFeedbackVaryings,++   -- * limits+   maxTransformFeedbackSeparateAttribs,+   maxTransformFeedbackInterleavedComponents,+   maxTransformFeedbackSeparateComponents+) where++import Data.StateVar+import Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.DataType+import Graphics.Rendering.OpenGL.GL.PrimitiveMode+import Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Program+import Graphics.Rendering.OpenGL.GL.Shaders.Variables+import Graphics.GL++--------------------------------------------------------------------------------++beginTransformFeedback :: PrimitiveMode -> IO ()+beginTransformFeedback = glBeginTransformFeedback . marshalPrimitiveMode++endTransformFeedback :: IO ()+endTransformFeedback = glEndTransformFeedback++--------------------------------------------------------------------------------++data TransformFeedbackBufferMode =+     InterleavedAttribs+   | SeparateAttribs+   | SeperateAttribs+   deriving ( Eq, Ord, Show )+{-# DEPRECATED SeperateAttribs "Use 'SeparateAttribs' instead." #-}++marshalTransformFeedbackBufferMode :: TransformFeedbackBufferMode -> GLenum+marshalTransformFeedbackBufferMode x = case x of+   InterleavedAttribs -> GL_INTERLEAVED_ATTRIBS+   SeparateAttribs -> GL_SEPARATE_ATTRIBS+   SeperateAttribs -> GL_SEPARATE_ATTRIBS++unmarshalTransformFeedbackBufferMode :: GLenum -> TransformFeedbackBufferMode+unmarshalTransformFeedbackBufferMode x+   | x == GL_INTERLEAVED_ATTRIBS = InterleavedAttribs+   | x == GL_SEPARATE_ATTRIBS = SeparateAttribs+   | otherwise = error $ "unmarshalTransformFeedbackBufferMode: illegal value " ++ show x++-- limits+-- | Max number of seprate atributes or varyings than can be captured+-- in transformfeedback, initial value 4+maxTransformFeedbackSeparateAttribs :: GettableStateVar GLint+maxTransformFeedbackSeparateAttribs = makeGettableStateVar $+   getInteger1 fromIntegral GetMaxTransformFeedbackSeparateAttribs++-- | Max number of components to write to a single buffer in+-- interleaved mod, initial value 64+maxTransformFeedbackInterleavedComponents :: GettableStateVar GLint+maxTransformFeedbackInterleavedComponents = makeGettableStateVar $+   getInteger1 fromIntegral GetMaxTransformFeedbackInterleavedComponents++-- | Max number of components per attribute or varying in seperate mode+-- initial value 4+maxTransformFeedbackSeparateComponents :: GettableStateVar GLint+maxTransformFeedbackSeparateComponents = makeGettableStateVar $+   getInteger1 fromIntegral GetMaxTransformFeedbackSeparateComponents++--------------------------------------------------------------------------------++-- | Set all the transform feedbacks varyings for this program+-- it overwrites any previous call to this function+setTransformFeedbackVaryings :: Program -> [String]+   -> TransformFeedbackBufferMode -> IO ()+setTransformFeedbackVaryings (Program program) sts tfbm = do+   ptSts <- mapM (\x -> withGLstring x return) sts+   stsPtrs <- newArray ptSts+   glTransformFeedbackVaryings program (fromIntegral . length $ sts)  stsPtrs+      (marshalTransformFeedbackBufferMode tfbm)++-- | Get the currently used transformFeedbackBufferMode+transformFeedbackBufferMode+   :: Program -> GettableStateVar TransformFeedbackBufferMode+transformFeedbackBufferMode = programVar1+   (unmarshalTransformFeedbackBufferMode . fromIntegral)+   TransformFeedbackBufferMode++-- | The number of varyings that are currently recorded when in+-- transform feedback mode+numTransformFeedbackVaryings :: Program -> GettableStateVar GLuint+numTransformFeedbackVaryings =+   programVar1 fromIntegral TransformFeedbackVaryings++-- | The maximum length of a varying's name for transform feedback mode+transformFeedbackVaryingMaxLength :: Program -> GettableStateVar GLsizei+transformFeedbackVaryingMaxLength+   = programVar1 fromIntegral TransformFeedbackVaryingMaxLength++-- | The name, datatype and size of the transform feedback varyings.+transformFeedbackVaryings :: Program -> GettableStateVar [(GLint, DataType, String)]+transformFeedbackVaryings =+   activeVars+      numTransformFeedbackVaryings+      transformFeedbackVaryingMaxLength+      glGetTransformFeedbackVarying+      unmarshalDataType
+ src/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs view
@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrayObjects+-- Copyright   :  (c) Sven Panne 2011-2019, Lars Corbijn 2011-2016+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.VertexArrayObjects (+   VertexArrayObject,+   bindVertexArrayObject+) where++import Control.Monad.IO.Class+import Data.ObjectName+import Data.StateVar+import Foreign.Marshal.Array ( allocaArray, peekArray, withArrayLen )+import Graphics.Rendering.OpenGL.GL.DebugOutput+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.GL++-----------------------------------------------------------------------------++newtype VertexArrayObject = VertexArrayObject { vertexArrayID :: GLuint }+   deriving( Eq, Ord, Show )++instance ObjectName VertexArrayObject where+   isObjectName =+     liftIO . fmap unmarshalGLboolean . glIsVertexArray . vertexArrayID++   deleteObjectNames bufferObjects =+      liftIO . withArrayLen (map vertexArrayID bufferObjects) $+         glDeleteVertexArrays . fromIntegral++instance GeneratableObjectName VertexArrayObject where+   genObjectNames n = liftIO . allocaArray n $ \buf -> do+      glGenVertexArrays (fromIntegral n) buf+      fmap (map VertexArrayObject) $ peekArray n buf++instance CanBeLabeled VertexArrayObject where+   objectLabel = objectNameLabel GL_VERTEX_ARRAY . vertexArrayID++bindVertexArrayObject :: StateVar (Maybe VertexArrayObject)+bindVertexArrayObject = makeStateVar getVAO bindVAO++getVAO :: IO (Maybe VertexArrayObject)+getVAO = do+   vao <- getInteger1 (VertexArrayObject . fromIntegral) GetVertexArrayBinding+   return $ if vao == noVAO then Nothing else Just vao++bindVAO :: Maybe VertexArrayObject -> IO ()+bindVAO = glBindVertexArray . vertexArrayID . maybe noVAO id++noVAO :: VertexArrayObject+noVAO = VertexArrayObject 0
+ src/Graphics/Rendering/OpenGL/GL/VertexArrays.hs view
@@ -0,0 +1,484 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrays+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.8 (Vertex Arrays) of the OpenGL 2.1+-- specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.VertexArrays (+   -- * Describing Data for the Arrays+   NumComponents, DataType(..), Stride, VertexArrayDescriptor(..),++   -- * Specifying Data for the Arrays+   Capability(..),+   ClientArrayType(..), arrayPointer,+   InterleavedArrays(..), interleavedArrays,++   -- * Enabling Arrays+   clientState, clientActiveTexture,++   -- * Dereferencing and Rendering+   ArrayIndex, NumArrayIndices, NumIndexBlocks, NumInstances,+   BaseInstance, BaseVertex,+   arrayElement,++   drawArrays, drawArraysInstancedBaseInstance, drawArraysInstanced,+   multiDrawArrays,++   drawElements, drawElementsInstancedBaseInstance, drawElementsInstanced,+   multiDrawElements, drawRangeElements,++   drawElementsBaseVertex, drawRangeElementsBaseVertex,+   drawElementsInstancedBaseVertex, drawElementsInstancedBaseVertexBaseInstance,+   multiDrawElementsBaseVertex,++   maxElementsVertices, maxElementsIndices, lockArrays,+   primitiveRestartIndex, primitiveRestartIndexNV,++   -- * Generic Vertex Attribute Arrays+   vertexAttribPointer, vertexAttribArray,+) where++import Data.StateVar+import Foreign.Ptr ( Ptr, nullPtr )+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.DataType+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PrimitiveMode+import Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++type NumComponents = GLint++type Stride = GLsizei++data VertexArrayDescriptor a =+   VertexArrayDescriptor !NumComponents !DataType !Stride !(Ptr a)+   deriving ( Eq, Ord, Show )++noVertexArrayDescriptor :: VertexArrayDescriptor a+noVertexArrayDescriptor = VertexArrayDescriptor 0 Byte 0 nullPtr++--------------------------------------------------------------------------------++data ClientArrayType =+     VertexArray+   | NormalArray+   | ColorArray+   | IndexArray+   | TextureCoordArray+   | EdgeFlagArray+   | FogCoordArray+   | SecondaryColorArray+   | MatrixIndexArray+   deriving ( Eq, Ord, Show )++marshalClientArrayType :: ClientArrayType -> GLenum+marshalClientArrayType x = case x of+   VertexArray -> GL_VERTEX_ARRAY+   NormalArray -> GL_NORMAL_ARRAY+   ColorArray -> GL_COLOR_ARRAY+   IndexArray -> GL_INDEX_ARRAY+   TextureCoordArray -> GL_TEXTURE_COORD_ARRAY+   EdgeFlagArray -> GL_EDGE_FLAG_ARRAY+   FogCoordArray -> GL_FOG_COORD_ARRAY+   SecondaryColorArray -> GL_SECONDARY_COLOR_ARRAY+   MatrixIndexArray -> GL_MATRIX_INDEX_ARRAY_ARB++-- Hmmm...+clientArrayTypeToEnableCap :: ClientArrayType -> EnableCap+clientArrayTypeToEnableCap x = case x of+   VertexArray -> CapVertexArray+   NormalArray -> CapNormalArray+   ColorArray -> CapColorArray+   IndexArray -> CapIndexArray+   TextureCoordArray -> CapTextureCoordArray+   EdgeFlagArray -> CapEdgeFlagArray+   FogCoordArray -> CapFogCoordArray+   SecondaryColorArray -> CapSecondaryColorArray+   MatrixIndexArray -> CapMatrixIndexArray++--------------------------------------------------------------------------------++arrayPointer :: ClientArrayType -> StateVar (VertexArrayDescriptor a)+arrayPointer t = case t of+   VertexArray -> vertexPointer+   NormalArray -> normalPointer+   ColorArray -> colorPointer+   IndexArray -> indexPointer+   TextureCoordArray -> texCoordPointer+   EdgeFlagArray -> edgeFlagPointer+   FogCoordArray -> fogCoordPointer+   SecondaryColorArray -> secondaryColorPointer+   MatrixIndexArray ->+      makeStateVar+        (do recordInvalidEnum ; return noVertexArrayDescriptor)+        (const recordInvalidEnum)++check :: Bool -> IO () -> IO ()+check flag val = if flag then val else recordInvalidValue++--------------------------------------------------------------------------------++vertexPointer :: StateVar (VertexArrayDescriptor a)+vertexPointer = makeStateVar getVertexPointer setVertexPointer++getVertexPointer :: IO (VertexArrayDescriptor a)+getVertexPointer = do+   n <- getInteger1 id GetVertexArraySize+   d <- getEnum1 unmarshalDataType GetVertexArrayType+   s <- getInteger1 fromIntegral GetVertexArrayStride+   p <- getPointer VertexArrayPointer+   return $ VertexArrayDescriptor n d s p++setVertexPointer :: VertexArrayDescriptor a -> IO ()+setVertexPointer (VertexArrayDescriptor n d s p) =+   glVertexPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++normalPointer :: StateVar (VertexArrayDescriptor a)+normalPointer = makeStateVar getNormalPointer setNormalPointer++getNormalPointer :: IO (VertexArrayDescriptor a)+getNormalPointer = do+   d <- getEnum1 unmarshalDataType GetNormalArrayType+   s <- getInteger1 fromIntegral GetNormalArrayStride+   p <- getPointer NormalArrayPointer+   return $ VertexArrayDescriptor 3 d s p++setNormalPointer :: VertexArrayDescriptor a -> IO ()+setNormalPointer (VertexArrayDescriptor n d s p) =+   check (n == 3) $ glNormalPointer (marshalDataType d) s p++--------------------------------------------------------------------------------++colorPointer :: StateVar (VertexArrayDescriptor a)+colorPointer = makeStateVar getColorPointer setColorPointer++getColorPointer :: IO (VertexArrayDescriptor a)+getColorPointer = do+   n <- getInteger1 id GetColorArraySize+   d <- getEnum1 unmarshalDataType GetColorArrayType+   s <- getInteger1 fromIntegral GetColorArrayStride+   p <- getPointer ColorArrayPointer+   return $ VertexArrayDescriptor n d s p++setColorPointer :: VertexArrayDescriptor a -> IO ()+setColorPointer (VertexArrayDescriptor n d s p) =+   check (n == 3 || n == 4) $ glColorPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++indexPointer :: StateVar (VertexArrayDescriptor a)+indexPointer = makeStateVar getIndexPointer setIndexPointer++getIndexPointer :: IO (VertexArrayDescriptor a)+getIndexPointer = do+   d <- getEnum1 unmarshalDataType GetIndexArrayType+   s <- getInteger1 fromIntegral GetIndexArrayStride+   p <- getPointer IndexArrayPointer+   return $ VertexArrayDescriptor 1 d s p++setIndexPointer :: VertexArrayDescriptor a -> IO ()+setIndexPointer (VertexArrayDescriptor n d s p) =+   check (n == 1) $ glIndexPointer (marshalDataType d) s p++--------------------------------------------------------------------------------++texCoordPointer :: StateVar (VertexArrayDescriptor a)+texCoordPointer = makeStateVar getTexCoordPointer setTexCoordPointer++getTexCoordPointer :: IO (VertexArrayDescriptor a)+getTexCoordPointer = do+   n <- getInteger1 id GetTextureCoordArraySize+   d <- getEnum1 unmarshalDataType GetTextureCoordArrayType+   s <- getInteger1 fromIntegral GetTextureCoordArrayStride+   p <- getPointer TextureCoordArrayPointer+   return $ VertexArrayDescriptor n d s p++setTexCoordPointer :: VertexArrayDescriptor a -> IO ()+setTexCoordPointer (VertexArrayDescriptor n d s p) =+   glTexCoordPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++edgeFlagPointer :: StateVar (VertexArrayDescriptor a)+edgeFlagPointer = makeStateVar getEdgeFlagPointer setEdgeFlagPointer++getEdgeFlagPointer :: IO (VertexArrayDescriptor a)+getEdgeFlagPointer = do+   s <- getInteger1 fromIntegral GetEdgeFlagArrayStride+   p <- getPointer EdgeFlagArrayPointer+   return $ VertexArrayDescriptor 1 UnsignedByte s p++setEdgeFlagPointer :: VertexArrayDescriptor a -> IO ()+setEdgeFlagPointer (VertexArrayDescriptor n d s p) =+   check (n == 1 && d == UnsignedByte) $ glEdgeFlagPointer s p++--------------------------------------------------------------------------------++fogCoordPointer :: StateVar (VertexArrayDescriptor a)+fogCoordPointer = makeStateVar getFogCoordPointer setFogCoordPointer++getFogCoordPointer :: IO (VertexArrayDescriptor a)+getFogCoordPointer = do+   d <- getEnum1 unmarshalDataType GetFogCoordArrayType+   s <- getInteger1 fromIntegral GetFogCoordArrayStride+   p <- getPointer FogCoordArrayPointer+   return $ VertexArrayDescriptor 1 d s p++setFogCoordPointer :: VertexArrayDescriptor a -> IO ()+setFogCoordPointer (VertexArrayDescriptor n d s p) =+   check (n == 1) $ glFogCoordPointer (marshalDataType d) s p++--------------------------------------------------------------------------------++secondaryColorPointer :: StateVar (VertexArrayDescriptor a)+secondaryColorPointer =+   makeStateVar getSecondaryColorPointer setSecondaryColorPointer++getSecondaryColorPointer :: IO (VertexArrayDescriptor a)+getSecondaryColorPointer = do+   n <- getInteger1 id GetSecondaryColorArraySize+   d <- getEnum1 unmarshalDataType GetSecondaryColorArrayType+   s <- getInteger1 fromIntegral GetSecondaryColorArrayStride+   p <- getPointer SecondaryColorArrayPointer+   return $ VertexArrayDescriptor n d s p++setSecondaryColorPointer :: (VertexArrayDescriptor a) -> IO ()+setSecondaryColorPointer (VertexArrayDescriptor n d s p) =+   glSecondaryColorPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++data InterleavedArrays =+     V2f+   | V3f+   | C4ubV2f+   | C4ubV3f+   | C3fV3f+   | N3fV3f+   | C4fN3fV3f+   | T2fV3f+   | T4fV4f+   | T2fC4ubV3f+   | T2fC3fV3f+   | T2fN3fV3f+   | T2fC4fN3fV3f+   | T4fC4fN3fV4f+   deriving ( Eq, Ord, Show )++marshalInterleavedArrays :: InterleavedArrays -> GLenum+marshalInterleavedArrays x = case x of+   V2f -> GL_V2F+   V3f -> GL_V3F+   C4ubV2f -> GL_C4UB_V2F+   C4ubV3f -> GL_C4UB_V3F+   C3fV3f -> GL_C3F_V3F+   N3fV3f -> GL_N3F_V3F+   C4fN3fV3f -> GL_C4F_N3F_V3F+   T2fV3f -> GL_T2F_V3F+   T4fV4f -> GL_T4F_V4F+   T2fC4ubV3f -> GL_T2F_C4UB_V3F+   T2fC3fV3f -> GL_T2F_C3F_V3F+   T2fN3fV3f -> GL_T2F_N3F_V3F+   T2fC4fN3fV3f -> GL_T2F_C4F_N3F_V3F+   T4fC4fN3fV4f -> GL_T4F_C4F_N3F_V4F++--------------------------------------------------------------------------------++interleavedArrays :: InterleavedArrays -> Stride -> Ptr a -> IO ()+interleavedArrays = glInterleavedArrays . marshalInterleavedArrays++--------------------------------------------------------------------------------++clientState :: ClientArrayType -> StateVar Capability+clientState arrayType =+   makeStateVar (getClientState arrayType) (setClientState arrayType)++getClientState :: ClientArrayType -> IO Capability+getClientState arrayType = get . makeCapability . clientArrayTypeToEnableCap $ arrayType++setClientState :: ClientArrayType -> Capability -> IO ()+setClientState arrayType val =+   (if val == Enabled then glEnableClientState else glDisableClientState)+      (marshalClientArrayType arrayType)++--------------------------------------------------------------------------------++clientActiveTexture :: StateVar TextureUnit+clientActiveTexture =+   makeStateVar (getEnum1 unmarshalTextureUnit GetClientActiveTexture)+                (glClientActiveTexture . marshalTextureUnit)++--------------------------------------------------------------------------------++type ArrayIndex = GLint++type NumArrayIndices = GLsizei++type NumIndexBlocks = GLsizei++type NumInstances = GLsizei++type BaseInstance = GLuint++type BaseVertex = GLint++-- TODO: The ranges (ArrayIndex, ArrayIndex) below should actually use GLuint:+-- type RangeStart = GLuint+-- type RangeEnd = GLuint++--------------------------------------------------------------------------------++arrayElement :: ArrayIndex -> IO ()+arrayElement = glArrayElement++drawArrays :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> IO ()+drawArrays = glDrawArrays . marshalPrimitiveMode++drawArraysInstancedBaseInstance :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> NumInstances -> BaseInstance -> IO ()+drawArraysInstancedBaseInstance = glDrawArraysInstancedBaseInstance . marshalPrimitiveMode++drawArraysInstanced :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> NumInstances -> IO ()+drawArraysInstanced = glDrawArraysInstanced . marshalPrimitiveMode++multiDrawArrays :: PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks -> IO ()+multiDrawArrays = glMultiDrawArrays . marshalPrimitiveMode++drawElements :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> IO ()+drawElements m c = glDrawElements (marshalPrimitiveMode m) c . marshalDataType++drawElementsInstancedBaseInstance :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> BaseInstance -> IO ()+drawElementsInstancedBaseInstance m c = glDrawElementsInstancedBaseInstance (marshalPrimitiveMode m) c . marshalDataType++drawElementsInstanced :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> IO ()+drawElementsInstanced m c = glDrawElementsInstanced (marshalPrimitiveMode m) c . marshalDataType++multiDrawElements :: PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a) -> NumIndexBlocks -> IO ()+multiDrawElements m c = glMultiDrawElements (marshalPrimitiveMode m) c . marshalDataType++drawRangeElements :: PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType -> Ptr a -> IO ()+drawRangeElements m (s, e) c = glDrawRangeElements (marshalPrimitiveMode m) (fromIntegral s) (fromIntegral e) c . marshalDataType++drawElementsBaseVertex :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> BaseVertex -> IO ()+drawElementsBaseVertex m c = glDrawElementsBaseVertex (marshalPrimitiveMode m) c . marshalDataType++drawRangeElementsBaseVertex :: PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType -> Ptr a -> BaseVertex -> IO ()+drawRangeElementsBaseVertex m (s, e) c = glDrawRangeElementsBaseVertex (marshalPrimitiveMode m) (fromIntegral s) (fromIntegral e) c . marshalDataType++drawElementsInstancedBaseVertex :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> BaseVertex -> IO ()+drawElementsInstancedBaseVertex m c = glDrawElementsInstancedBaseVertex (marshalPrimitiveMode m) c . marshalDataType++drawElementsInstancedBaseVertexBaseInstance :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> NumInstances -> BaseVertex -> BaseInstance -> IO ()+drawElementsInstancedBaseVertexBaseInstance m c = glDrawElementsInstancedBaseVertexBaseInstance (marshalPrimitiveMode m) c . marshalDataType++multiDrawElementsBaseVertex :: PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a) -> NumIndexBlocks -> Ptr BaseVertex -> IO ()+multiDrawElementsBaseVertex m c = glMultiDrawElementsBaseVertex (marshalPrimitiveMode m) c . marshalDataType++maxElementsVertices :: GettableStateVar NumArrayIndices+maxElementsVertices = makeGettableStateVar (getSizei1 id GetMaxElementsVertices)++maxElementsIndices :: GettableStateVar NumArrayIndices+maxElementsIndices = makeGettableStateVar (getSizei1 id GetMaxElementsIndices)++--------------------------------------------------------------------------------++lockArrays :: StateVar (Maybe (ArrayIndex, NumArrayIndices))+lockArrays = makeStateVar getLockArrays setLockArrays++getLockArrays :: IO (Maybe (ArrayIndex, NumArrayIndices))+getLockArrays = do+   count <- getInteger1 fromIntegral GetArrayElementLockCount+   if count > 0+      then do first <- getInteger1 id GetArrayElementLockFirst+              return $ Just (first, count)+      else return Nothing++setLockArrays :: Maybe (ArrayIndex, NumArrayIndices) -> IO ()+setLockArrays = maybe glUnlockArraysEXT (uncurry glLockArraysEXT)++--------------------------------------------------------------------------------++primitiveRestartIndex :: StateVar (Maybe ArrayIndex)+primitiveRestartIndex =+   makeStateVarMaybe+      (return CapPrimitiveRestart)+      (getInteger1 id GetPrimitiveRestartIndex)+      (glPrimitiveRestartIndex . fromIntegral)++--------------------------------------------------------------------------------++-- We almost could use makeStateVarMaybe below, but, alas, this is client state.++primitiveRestartIndexNV :: StateVar (Maybe ArrayIndex)+primitiveRestartIndexNV =+   makeStateVar getPrimitiveRestartIndexNV setPrimitiveRestartIndexNV++getPrimitiveRestartIndexNV :: IO (Maybe ArrayIndex)+getPrimitiveRestartIndexNV = do+   on <- getBoolean1 unmarshalGLboolean GetPrimitiveRestartNV+   if on+      then fmap Just $ getInteger1 fromIntegral GetPrimitiveRestartIndexNV+      else return Nothing++setPrimitiveRestartIndexNV :: Maybe ArrayIndex -> IO ()+setPrimitiveRestartIndexNV maybeIdx = case maybeIdx of+   Nothing  -> glDisableClientState GL_PRIMITIVE_RESTART_NV+   Just idx -> do glEnableClientState GL_PRIMITIVE_RESTART_NV+                  glPrimitiveRestartIndexNV (fromIntegral idx)++--------------------------------------------------------------------------------++vertexAttribPointer :: AttribLocation -> StateVar (IntegerHandling, VertexArrayDescriptor a)+vertexAttribPointer location =+   makeStateVar (getVertexAttribPointer_ location) (setVertexAttribPointer location)++getVertexAttribPointer_ :: AttribLocation -> IO (IntegerHandling, VertexArrayDescriptor a)+getVertexAttribPointer_ location = do+   i <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayInteger+   h <- if i+           then return KeepIntegral+           else do f <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayNormalized+                   return $ if f then ToNormalizedFloat else ToFloat+   n <- getVertexAttribInteger1 id location GetVertexAttribArraySize+   d <- getVertexAttribEnum1 unmarshalDataType location GetVertexAttribArrayType+   s <- getVertexAttribInteger1 fromIntegral location GetVertexAttribArrayStride+   p <- getVertexAttribPointer location VertexAttribArrayPointer+   return (h, VertexArrayDescriptor n d s p)++setVertexAttribPointer :: AttribLocation -> (IntegerHandling, VertexArrayDescriptor a) -> IO ()+setVertexAttribPointer (AttribLocation location) (h, VertexArrayDescriptor n d s p) = case h of+   ToFloat -> glVertexAttribPointer location n md (marshalGLboolean False) s p+   ToNormalizedFloat -> glVertexAttribPointer location n md (marshalGLboolean True) s p+   KeepIntegral -> glVertexAttribIPointer location n md s p+  where md = marshalDataType d++--------------------------------------------------------------------------------++vertexAttribArray :: AttribLocation -> StateVar Capability+vertexAttribArray location =+   makeStateVar (getVertexAttribArray location) (flip setVertexAttribArray location)++getVertexAttribArray :: AttribLocation -> IO Capability+getVertexAttribArray location =+   getVertexAttribBoolean1 unmarshalCapability location GetVertexAttribArrayEnabled++setVertexAttribArray :: Capability -> AttribLocation -> IO ()+setVertexAttribArray Disabled (AttribLocation location) = glDisableVertexAttribArray location+setVertexAttribArray Enabled (AttribLocation location) = glEnableVertexAttribArray location
+ src/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE DeriveDataTypeable, CPP #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexAttributes+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module for auxiliary vertex attributes.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.VertexAttributes (+   TexCoord1(..), TexCoord2(..), TexCoord3(..), TexCoord4(..),+   Normal3(..),+   FogCoord1(..),+   Color3(..), Color4(..),+   Index1(..)+) where++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ( Applicative(..) )+#endif+import Control.Monad+import Data.Foldable+import Data.Ix+import Data.Traversable+import Data.Typeable+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable++--------------------------------------------------------------------------------++-- | Texture coordinates with /t/=0, /r/=0, and /q/=1.+newtype TexCoord1 a = TexCoord1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord1 where+   fmap f (TexCoord1 x) = TexCoord1 (f x)++instance Applicative TexCoord1 where+   pure a = TexCoord1 a+   TexCoord1 f <*> TexCoord1 x = TexCoord1 (f x)++instance Foldable TexCoord1 where+   foldr f a (TexCoord1 x) = x `f ` a+   foldl f a (TexCoord1 x) = a `f` x+   foldr1 _ (TexCoord1 x) = x+   foldl1 _ (TexCoord1 x) = x++instance Traversable TexCoord1 where+   traverse f (TexCoord1 x) = pure TexCoord1 <*> f x+   sequenceA (TexCoord1 x) =  pure TexCoord1 <*> x+   mapM f (TexCoord1 x) = return TexCoord1 `ap` f x+   sequence (TexCoord1 x) = return TexCoord1 `ap` x++instance Storable a => Storable (TexCoord1 a) where+   sizeOf    ~(TexCoord1 s) = sizeOf s+   alignment ~(TexCoord1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | Texture coordinates with /r/=0 and /q/=1.+data TexCoord2 a = TexCoord2 !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord2 where+   fmap f (TexCoord2 x y) = TexCoord2 (f x) (f y)++instance Applicative TexCoord2 where+   pure a = TexCoord2 a a+   TexCoord2 f g <*> TexCoord2 x y = TexCoord2 (f x) (g y)++instance Foldable TexCoord2 where+   foldr f a (TexCoord2 x y) = x `f ` (y `f` a)+   foldl f a (TexCoord2 x y) = (a `f` x) `f` y+   foldr1 f (TexCoord2 x y) = x `f` y+   foldl1 f (TexCoord2 x y) = x `f` y++instance Traversable TexCoord2 where+   traverse f (TexCoord2 x y) = pure TexCoord2 <*> f x <*> f y+   sequenceA (TexCoord2 x y) =  pure TexCoord2 <*> x <*> y+   mapM f (TexCoord2 x y) = return TexCoord2 `ap` f x `ap` f y+   sequence (TexCoord2 x y) = return TexCoord2 `ap` x `ap` y++instance Storable a => Storable (TexCoord2 a) where+   sizeOf ~(TexCoord2 x _) = 2 * sizeOf x+   alignment ~(TexCoord2 x _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | Texture coordinates with /q/=1.+data TexCoord3 a = TexCoord3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord3 where+   fmap f (TexCoord3 x y z) = TexCoord3 (f x) (f y) (f z)++instance Applicative TexCoord3 where+   pure a = TexCoord3 a a a+   TexCoord3 f g h <*> TexCoord3 x y z = TexCoord3 (f x) (g y) (h z)++instance Foldable TexCoord3 where+   foldr f a (TexCoord3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (TexCoord3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (TexCoord3 x y z) = x `f` (y `f` z)+   foldl1 f (TexCoord3 x y z) = (x `f` y) `f` z++instance Traversable TexCoord3 where+   traverse f (TexCoord3 x y z) = pure TexCoord3 <*> f x <*> f y <*> f z+   sequenceA (TexCoord3 x y z) =  pure TexCoord3 <*> x <*> y <*> z+   mapM f (TexCoord3 x y z) = return TexCoord3 `ap` f x `ap` f y `ap` f z+   sequence (TexCoord3 x y z) = return TexCoord3 `ap` x `ap` y `ap` z++instance Storable a => Storable (TexCoord3 a) where+   sizeOf ~(TexCoord3 x _ _) = 3 * sizeOf x+   alignment ~(TexCoord3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | Fully-fledged four-dimensional texture coordinates.+data TexCoord4 a = TexCoord4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord4 where+   fmap f (TexCoord4 x y z w) = TexCoord4 (f x) (f y) (f z) (f w)++instance Applicative TexCoord4 where+   pure a = TexCoord4 a a a a+   TexCoord4 f g h i <*> TexCoord4 x y z w = TexCoord4 (f x) (g y) (h z) (i w)++instance Foldable TexCoord4 where+   foldr f a (TexCoord4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (TexCoord4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (TexCoord4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (TexCoord4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable TexCoord4 where+   traverse f (TexCoord4 x y z w) = pure TexCoord4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (TexCoord4 x y z w) =  pure TexCoord4 <*> x <*> y <*> z <*> w+   mapM f (TexCoord4 x y z w) = return TexCoord4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (TexCoord4 x y z w) = return TexCoord4 `ap` x `ap` y `ap` z `ap` w++instance Storable a => Storable (TexCoord4 a) where+   sizeOf ~(TexCoord4 x _ _ _) = 4 * sizeOf x+   alignment ~(TexCoord4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- A three-dimensional normal.+data Normal3 a = Normal3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable) +instance Functor Normal3 where+   fmap f (Normal3 x y z) = Normal3 (f x) (f y) (f z)++instance Applicative Normal3 where+   pure a = Normal3 a a a+   Normal3 f g h <*> Normal3 x y z = Normal3 (f x) (g y) (h z)++instance Foldable Normal3 where+   foldr f a (Normal3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Normal3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Normal3 x y z) = x `f` (y `f` z)+   foldl1 f (Normal3 x y z) = (x `f` y) `f` z++instance Traversable Normal3 where+   traverse f (Normal3 x y z) = pure Normal3 <*> f x <*> f y <*> f z+   sequenceA (Normal3 x y z) =  pure Normal3 <*> x <*> y <*> z+   mapM f (Normal3 x y z) = return Normal3 `ap` f x `ap` f y `ap` f z+   sequence (Normal3 x y z) = return Normal3 `ap` x `ap` y `ap` z++instance Storable a => Storable (Normal3 a) where+   sizeOf ~(Normal3 x _ _) = 3 * sizeOf x+   alignment ~(Normal3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A fog coordinate.+newtype FogCoord1 a = FogCoord1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor FogCoord1 where+   fmap f (FogCoord1 x) = FogCoord1 (f x)++instance Applicative FogCoord1 where+   pure a = FogCoord1 a+   FogCoord1 f <*> FogCoord1 x = FogCoord1 (f x)++instance Foldable FogCoord1 where+   foldr f a (FogCoord1 x) = x `f ` a+   foldl f a (FogCoord1 x)  = a `f` x+   foldr1 _ (FogCoord1 x) = x+   foldl1 _ (FogCoord1 x) = x++instance Traversable FogCoord1 where+   traverse f (FogCoord1 x) = pure FogCoord1 <*> f x+   sequenceA (FogCoord1 x) =  pure FogCoord1 <*> x+   mapM f (FogCoord1 x) = return FogCoord1 `ap` f x+   sequence (FogCoord1 x) = return FogCoord1 `ap` x++instance Storable a => Storable (FogCoord1 a) where+   sizeOf    ~(FogCoord1 s) = sizeOf s+   alignment ~(FogCoord1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- An RGBA color with /A/=1.+data Color3 a = Color3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Color3 where+   fmap f (Color3 x y z) = Color3 (f x) (f y) (f z)++instance Applicative Color3 where+   pure a = Color3 a a a+   Color3 f g h <*> Color3 x y z = Color3 (f x) (g y) (h z)++instance Foldable Color3 where+   foldr f a (Color3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Color3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Color3 x y z) = x `f` (y `f` z)+   foldl1 f (Color3 x y z) = (x `f` y) `f` z++instance Traversable Color3 where+   traverse f (Color3 x y z) = pure Color3 <*> f x <*> f y <*> f z+   sequenceA (Color3 x y z) =  pure Color3 <*> x <*> y <*> z+   mapM f (Color3 x y z) = return Color3 `ap` f x `ap` f y `ap` f z+   sequence (Color3 x y z) = return Color3 `ap` x `ap` y `ap` z++instance Storable a => Storable (Color3 a) where+   sizeOf ~(Color3 x _ _) = 3 * sizeOf x+   alignment ~(Color3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A fully-fledged RGBA color.+data Color4 a = Color4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Color4 where+   fmap f (Color4 x y z w) = Color4 (f x) (f y) (f z) (f w)++instance Applicative Color4 where+   pure a = Color4 a a a a+   Color4 f g h i <*> Color4 x y z w = Color4 (f x) (g y) (h z) (i w)++instance Foldable Color4 where+   foldr f a (Color4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (Color4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (Color4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (Color4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable Color4 where+   traverse f (Color4 x y z w) = pure Color4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (Color4 x y z w) =  pure Color4 <*> x <*> y <*> z <*> w+   mapM f (Color4 x y z w) = return Color4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (Color4 x y z w) = return Color4 `ap` x `ap` y `ap` z `ap` w++instance Storable a => Storable (Color4 a) where+   sizeOf ~(Color4 x _ _ _) = 4 * sizeOf x+   alignment ~(Color4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A color index.+newtype Index1 a = Index1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Index1 where+   fmap f (Index1 x) = Index1 (f x)++instance Applicative Index1 where+   pure a = Index1 a+   Index1 f <*> Index1 x = Index1 (f x)++instance Foldable Index1 where+   foldr f a (Index1 x) = x `f ` a+   foldl f a (Index1 x)  = a `f` x+   foldr1 _ (Index1 x) = x+   foldl1 _ (Index1 x) = x++instance Traversable Index1 where+   traverse f (Index1 x) = pure Index1 <*> f x+   sequenceA (Index1 x) =  pure Index1 <*> x+   mapM f (Index1 x) = return Index1 `ap` f x+   sequence (Index1 x) = return Index1 `ap` x++instance Storable a => Storable (Index1 a) where+   sizeOf    ~(Index1 s) = sizeOf s+   alignment ~(Index1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++peekApplicativeTraversable :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> IO (t a)+peekApplicativeTraversable = Data.Traversable.mapM peek . addresses++addresses :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> t (Ptr a)+addresses = snd . mapAccumL nextPtr 0 . pure . castPtr++nextPtr :: Storable a => Int -> Ptr a -> (Int, Ptr a)+nextPtr offset ptr = (offset + 1, advancePtr ptr offset)++--------------------------------------------------------------------------------++pokeFoldable :: (Foldable t, Storable a) => Ptr (t a) -> t a -> IO ()+pokeFoldable ptr xs = foldlM pokeAndAdvance (castPtr ptr) xs >> return ()++pokeAndAdvance :: Storable a => Ptr a -> a -> IO (Ptr a)+pokeAndAdvance ptr value = do+   poke ptr value+   return $ ptr `plusPtr` sizeOf value
+ src/Graphics/Rendering/OpenGL/GL/VertexSpec.hs view
@@ -0,0 +1,992 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexSpec+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.7 (Vertex Specification) of the+-- OpenGL 2.1 specs.+--+--------------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++module Graphics.Rendering.OpenGL.GL.VertexSpec (+   -- * Vertex Coordinates+   Vertex(..),+   VertexComponent,++   -- * Auxiliary Vertex Attributes+   -- $AuxiliaryVertexAttributes++   -- ** Texture Coordinates+   currentTextureCoords, TexCoord(..),+   TexCoordComponent,+   TexCoord1(..), TexCoord2(..), TexCoord3(..), TexCoord4(..),++   -- ** Normal+   currentNormal, Normal(..),+   NormalComponent,+   Normal3(..),++   -- ** Fog Coordinate+   currentFogCoord, FogCoord(..),+   FogCoordComponent,+   FogCoord1(..),++   -- ** Color and Secondary Color+   rgbaMode,+   currentColor, Color(..),+   currentSecondaryColor, SecondaryColor(..),+   ColorComponent,+   Color3(..), Color4(..),++   currentIndex, Index(..),+   IndexComponent,+   Index1(..),++   -- * Generic Vertex Attributes+   IntegerHandling(..), AttribLocation(..),+   currentVertexAttrib, currentVertexAttribI, currentVertexAttribIu,+   VertexAttrib(..), VertexAttribComponent(..),++   -- * Texture Units+   TextureUnit(..), maxTextureUnit+) where++import Data.StateVar+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GL.VertexAttributes+import Graphics.GL++--------------------------------------------------------------------------------++-- | The class of all types which can be used as a vertex coordinate.++class VertexComponent a where+   vertex2 :: a -> a -> IO ()+   vertex3 :: a -> a -> a -> IO ()+   vertex4 :: a -> a -> a -> a -> IO ()++   vertex2v :: Ptr a -> IO ()+   vertex3v :: Ptr a -> IO ()+   vertex4v :: Ptr a -> IO ()++instance VertexComponent GLshort where+   vertex2 = glVertex2s+   vertex3 = glVertex3s+   vertex4 = glVertex4s++   vertex2v = glVertex2sv+   vertex3v = glVertex3sv+   vertex4v = glVertex4sv++instance VertexComponent GLint where+   vertex2 = glVertex2i+   vertex3 = glVertex3i+   vertex4 = glVertex4i++   vertex2v = glVertex2iv+   vertex3v = glVertex3iv+   vertex4v = glVertex4iv++instance VertexComponent GLfloat where+   vertex2 = glVertex2f+   vertex3 = glVertex3f+   vertex4 = glVertex4f++   vertex2v = glVertex2fv+   vertex3v = glVertex3fv+   vertex4v = glVertex4fv++instance VertexComponent GLdouble where+   vertex2 = glVertex2d+   vertex3 = glVertex3d+   vertex4 = glVertex4d++   vertex2v = glVertex2dv+   vertex3v = glVertex3dv+   vertex4v = glVertex4dv++--------------------------------------------------------------------------------++-- | Specify the (/x/, /y/, /z/, /w/) coordinates of a four-dimensional vertex.+-- This must only be done during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive', otherwise the+-- behaviour is unspecified. The current values of the auxiliary vertex+-- attributes are associated with the vertex.+-- +-- Note that there is no such thing as a \"current vertex\" which could be+-- retrieved.++class Vertex a where+   vertex  ::     a -> IO ()+   vertexv :: Ptr a -> IO ()++instance VertexComponent a => Vertex (Vertex2 a) where+   vertex (Vertex2 x y) = vertex2 x y+   vertexv = vertex2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)++instance VertexComponent a => Vertex (Vertex3 a) where+   vertex (Vertex3 x y z) = vertex3 x y z+   vertexv = vertex3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)++instance VertexComponent a => Vertex (Vertex4 a) where+   vertex (Vertex4 x y z w) = vertex4 x y z w+   vertexv = vertex4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)++--------------------------------------------------------------------------------+-- $AuxiliaryVertexAttributes+-- Apart from its coordinates in four-dimensional space, every vertex has+-- associated /auxiliary attributes/: Its texture coordinates, a normal, a+-- fog coordinate, and a color plus a secondary color. For every attribute, the+-- OpenGL state contains its current value, which can be changed at any time.+--+-- Every attribute has a \"natural\" format via which it can be manipulated+-- directly as part of the OpenGL state, e.g. the current texture coordinates+-- are internally handled as @'TexCoord4' 'GLfloat'@. Different formats are+-- converted to this format, e.g. the /s/, /r/, and /t/ coordinates of a+-- @'TexCoord3' 'GLint'@ are converted to floating point values and a /q/+-- coordinate of 1.0 is implicitly assumed.+--+-- Consequently, the vast majority of classes, functions, and data types in this+-- module are for convenience only and offer no additional functionality.++--------------------------------------------------------------------------------++-- | The current texture coordinates (/s/, /t/, /r/, /q/) for the current+-- texture unit (see 'Graphics.Rendering.OpenGL.GL.CoordTrans.activeTexture').+-- The initial value is (0,0,0,1) for all texture units.++currentTextureCoords :: StateVar (TexCoord4 GLfloat)+currentTextureCoords =+   makeStateVar (getFloat4 TexCoord4 GetCurrentTextureCoords) texCoord++--------------------------------------------------------------------------------++-- | The class of all types which can be used as a texture coordinate.++class TexCoordComponent a where+   texCoord1 :: a -> IO ()+   texCoord2 :: a -> a -> IO ()+   texCoord3 :: a -> a -> a -> IO ()+   texCoord4 :: a -> a -> a -> a -> IO ()++   texCoord1v :: Ptr a -> IO ()+   texCoord2v :: Ptr a -> IO ()+   texCoord3v :: Ptr a -> IO ()+   texCoord4v :: Ptr a -> IO ()++   multiTexCoord1 :: GLenum -> a -> IO ()+   multiTexCoord2 :: GLenum -> a -> a -> IO ()+   multiTexCoord3 :: GLenum -> a -> a -> a -> IO ()+   multiTexCoord4 :: GLenum -> a -> a -> a -> a -> IO ()++   multiTexCoord1v :: GLenum -> Ptr a -> IO ()+   multiTexCoord2v :: GLenum -> Ptr a -> IO ()+   multiTexCoord3v :: GLenum -> Ptr a -> IO ()+   multiTexCoord4v :: GLenum -> Ptr a -> IO ()++instance TexCoordComponent GLshort where+   texCoord1 = glTexCoord1s+   texCoord2 = glTexCoord2s+   texCoord3 = glTexCoord3s+   texCoord4 = glTexCoord4s++   texCoord1v = glTexCoord1sv+   texCoord2v = glTexCoord2sv+   texCoord3v = glTexCoord3sv+   texCoord4v = glTexCoord4sv++   multiTexCoord1 = glMultiTexCoord1s+   multiTexCoord2 = glMultiTexCoord2s+   multiTexCoord3 = glMultiTexCoord3s+   multiTexCoord4 = glMultiTexCoord4s++   multiTexCoord1v = glMultiTexCoord1sv+   multiTexCoord2v = glMultiTexCoord2sv+   multiTexCoord3v = glMultiTexCoord3sv+   multiTexCoord4v = glMultiTexCoord4sv++instance TexCoordComponent GLint where+   texCoord1 = glTexCoord1i+   texCoord2 = glTexCoord2i+   texCoord3 = glTexCoord3i+   texCoord4 = glTexCoord4i++   texCoord1v = glTexCoord1iv+   texCoord2v = glTexCoord2iv+   texCoord3v = glTexCoord3iv+   texCoord4v = glTexCoord4iv++   multiTexCoord1 = glMultiTexCoord1i+   multiTexCoord2 = glMultiTexCoord2i+   multiTexCoord3 = glMultiTexCoord3i+   multiTexCoord4 = glMultiTexCoord4i++   multiTexCoord1v = glMultiTexCoord1iv+   multiTexCoord2v = glMultiTexCoord2iv+   multiTexCoord3v = glMultiTexCoord3iv+   multiTexCoord4v = glMultiTexCoord4iv++instance TexCoordComponent GLfloat where+   texCoord1 = glTexCoord1f+   texCoord2 = glTexCoord2f+   texCoord3 = glTexCoord3f+   texCoord4 = glTexCoord4f++   texCoord1v = glTexCoord1fv+   texCoord2v = glTexCoord2fv+   texCoord3v = glTexCoord3fv+   texCoord4v = glTexCoord4fv++   multiTexCoord1 = glMultiTexCoord1f+   multiTexCoord2 = glMultiTexCoord2f+   multiTexCoord3 = glMultiTexCoord3f+   multiTexCoord4 = glMultiTexCoord4f++   multiTexCoord1v = glMultiTexCoord1fv+   multiTexCoord2v = glMultiTexCoord2fv+   multiTexCoord3v = glMultiTexCoord3fv+   multiTexCoord4v = glMultiTexCoord4fv++instance TexCoordComponent GLdouble where+   texCoord1 = glTexCoord1d+   texCoord2 = glTexCoord2d+   texCoord3 = glTexCoord3d+   texCoord4 = glTexCoord4d++   texCoord1v = glTexCoord1dv+   texCoord2v = glTexCoord2dv+   texCoord3v = glTexCoord3dv+   texCoord4v = glTexCoord4dv++   multiTexCoord1 = glMultiTexCoord1d+   multiTexCoord2 = glMultiTexCoord2d+   multiTexCoord3 = glMultiTexCoord3d+   multiTexCoord4 = glMultiTexCoord4d++   multiTexCoord1v = glMultiTexCoord1dv+   multiTexCoord2v = glMultiTexCoord2dv+   multiTexCoord3v = glMultiTexCoord3dv+   multiTexCoord4v = glMultiTexCoord4dv++--------------------------------------------------------------------------------++-- | Change the current texture coordinates of the current or given texture+-- unit.++class TexCoord a where+   texCoord       ::                    a -> IO ()+   texCoordv      ::                Ptr a -> IO ()+   multiTexCoord  :: TextureUnit ->     a -> IO ()+   multiTexCoordv :: TextureUnit -> Ptr a -> IO ()++instance TexCoordComponent a => TexCoord (TexCoord1 a) where+   texCoord (TexCoord1 s) = texCoord1 s+   texCoordv = texCoord1v . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)+   multiTexCoord u (TexCoord1 s) =+      multiTexCoord1 (marshalTextureUnit u) s+   multiTexCoordv u =+      multiTexCoord1v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)++instance TexCoordComponent a => TexCoord (TexCoord2 a) where+   texCoord (TexCoord2 s t) = texCoord2 s t+   texCoordv = texCoord2v . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)+   multiTexCoord u (TexCoord2 s t) =+      multiTexCoord2 (marshalTextureUnit u) s t+   multiTexCoordv u =+      multiTexCoord2v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)++instance TexCoordComponent a => TexCoord (TexCoord3 a) where+   texCoord (TexCoord3 s t r) = texCoord3 s t r+   texCoordv = texCoord3v . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)+   multiTexCoord u (TexCoord3 s t r) =+      multiTexCoord3 (marshalTextureUnit u) s t r+   multiTexCoordv u =+      multiTexCoord3v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)++instance TexCoordComponent a => TexCoord (TexCoord4 a) where+   texCoord (TexCoord4 s t r q) = texCoord4 s t r q+   texCoordv = texCoord4v . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)+   multiTexCoord u (TexCoord4 s t r q) =+      multiTexCoord4 (marshalTextureUnit u) s t r q+   multiTexCoordv u =+      multiTexCoord4v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)++--------------------------------------------------------------------------------++-- | The current normal (/x/, /y/, /z/). The initial value is the unit vector+-- (0, 0, 1).++currentNormal :: StateVar (Normal3 GLfloat)+currentNormal = makeStateVar (getFloat3 Normal3 GetCurrentNormal) normal++--------------------------------------------------------------------------------++-- | The class of all types which can be used as a component of a normal.++class NormalComponent a where+   normal3 :: a -> a -> a -> IO ()+   normal3v :: Ptr a -> IO ()++instance NormalComponent GLbyte where+   normal3 = glNormal3b+   normal3v = glNormal3bv++instance NormalComponent GLshort where+   normal3 = glNormal3s+   normal3v = glNormal3sv++instance NormalComponent GLint where+   normal3 = glNormal3i+   normal3v = glNormal3iv++instance NormalComponent GLfloat where+   normal3 = glNormal3f+   normal3v = glNormal3fv++instance NormalComponent GLdouble where+   normal3 = glNormal3d+   normal3v = glNormal3dv++--------------------------------------------------------------------------------++-- | Change the current normal. Integral arguments are converted to+-- floating-point with a linear mapping that maps the most positive+-- representable integer value to 1.0, and the most negative representable+-- integer value to -1.0.+--+-- Normals specified with 'normal' or 'normalv' need not have unit length.+-- If 'Graphics.Rendering.OpenGL.GL.CoordTrans.normalize' is enabled, then+-- normals of any length specified with 'normal' or 'normalv' are normalized+-- after transformation. If+-- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' is enabled, normals+-- are scaled by a scaling factor derived from the modelview matrix.+-- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' requires that the+-- originally specified normals were of unit length, and that the modelview+-- matrix contains only uniform scales for proper results. Normalization is +-- initially disabled.++class Normal a where+   normal  ::     a -> IO ()+   normalv :: Ptr a -> IO ()++instance NormalComponent a => Normal (Normal3 a) where+   normal (Normal3 x y z) = normal3 x y z+   normalv = normal3v . (castPtr :: Ptr (Normal3 b) -> Ptr b)++--------------------------------------------------------------------------------++-- | The current fog coordinate. The initial value is 0.++currentFogCoord :: StateVar (FogCoord1 GLfloat)+currentFogCoord =+   makeStateVar (getFloat1 FogCoord1 GetCurrentFogCoord) fogCoord++--------------------------------------------------------------------------------++-- | The class of all types which can be used as the fog coordinate.++class FogCoordComponent a where+   fogCoord1 :: a -> IO ()+   fogCoord1v :: Ptr a -> IO ()++instance FogCoordComponent GLfloat where+   fogCoord1 = glFogCoordf+   fogCoord1v = glFogCoordfv++instance FogCoordComponent GLdouble where+   fogCoord1 = glFogCoordd+   fogCoord1v = glFogCoorddv++--------------------------------------------------------------------------------++-- | Change the current fog coordinate.++class FogCoord a where+   fogCoord  ::     a -> IO ()+   fogCoordv :: Ptr a -> IO ()++instance FogCoordComponent a => FogCoord (FogCoord1 a) where+   fogCoord (FogCoord1 c) = fogCoord1 c+   fogCoordv = fogCoord1v . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)++--------------------------------------------------------------------------------++-- | If 'rgbaMode' contains 'True', the color buffers store RGBA value. If+-- color indexes are stored, it contains 'False'.++rgbaMode :: GettableStateVar Bool+rgbaMode = makeGettableStateVar (getBoolean1 unmarshalGLboolean GetRGBAMode)++--------------------------------------------------------------------------------++-- The current color (/R/, /G/, /B/, /A/). The initial value is (1, 1, 1, 1).+-- Note that this state variable is significant only when the GL is in RGBA+-- mode.++currentColor :: StateVar (Color4 GLfloat)+currentColor =+   makeStateVar (getFloat4 Color4 GetCurrentColor) color++-- The current secondary color (/R/, /G/, /B/). The initial value is (0, 0, 0).+-- Note that this state variable is significant only when the GL is in RGBA+-- mode.++currentSecondaryColor :: StateVar (Color3 GLfloat)+currentSecondaryColor =+   makeStateVar+      (do Color4 r g b _ <- getFloat4 Color4 GetCurrentSecondaryColor+          return $ Color3 r g b)+      secondaryColor++--------------------------------------------------------------------------------++-- | The class of all types which can be used as a color component.++class ColorComponent a where+   color3 :: a -> a -> a -> IO ()+   color4 :: a -> a -> a -> a -> IO ()++   color3v :: Ptr a -> IO ()+   color4v :: Ptr a -> IO ()++   secondaryColor3  :: a -> a -> a -> IO ()+   secondaryColor3v :: Ptr a -> IO ()++instance ColorComponent GLbyte where+   color3 = glColor3b+   color4 = glColor4b++   color3v = glColor3bv+   color4v = glColor4bv++   secondaryColor3 = glSecondaryColor3b+   secondaryColor3v = glSecondaryColor3bv++instance ColorComponent GLshort where+   color3 = glColor3s+   color4 = glColor4s++   color3v = glColor3sv+   color4v = glColor4sv++   secondaryColor3 = glSecondaryColor3s+   secondaryColor3v = glSecondaryColor3sv++instance ColorComponent GLint where+   color3 = glColor3i+   color4 = glColor4i++   color3v = glColor3iv+   color4v = glColor4iv++   secondaryColor3 = glSecondaryColor3i+   secondaryColor3v = glSecondaryColor3iv++instance ColorComponent GLfloat where+   color3 = glColor3f+   color4 = glColor4f++   color3v = glColor3fv+   color4v = glColor4fv++   secondaryColor3 = glSecondaryColor3f+   secondaryColor3v = glSecondaryColor3fv++instance ColorComponent GLdouble where+   color3 = glColor3d+   color4 = glColor4d++   color3v = glColor3dv+   color4v = glColor4dv++   secondaryColor3 = glSecondaryColor3d+   secondaryColor3v = glSecondaryColor3dv++instance ColorComponent GLubyte where+   color3 = glColor3ub+   color4 = glColor4ub++   color3v = glColor3ubv+   color4v = glColor4ubv++   secondaryColor3 = glSecondaryColor3ub+   secondaryColor3v = glSecondaryColor3ubv++instance ColorComponent GLushort where+   color3 = glColor3us+   color4 = glColor4us++   color3v = glColor3usv+   color4v = glColor4usv++   secondaryColor3 = glSecondaryColor3us+   secondaryColor3v = glSecondaryColor3usv++instance ColorComponent GLuint where+   color3 = glColor3ui+   color4 = glColor4ui++   color3v = glColor3uiv+   color4v = glColor4uiv++   secondaryColor3 = glSecondaryColor3ui+   secondaryColor3v = glSecondaryColor3uiv++--------------------------------------------------------------------------------++-- | Change the current color.++class Color a where+   color  ::     a -> IO ()+   colorv :: Ptr a -> IO ()++instance ColorComponent a => Color (Color3 a) where+   color (Color3 r g b) = color3 r g b+   colorv = color3v . (castPtr :: Ptr (Color3 b) -> Ptr b)++instance ColorComponent a => Color (Color4 a) where+   color (Color4 r g b a) = color4 r g b a+   colorv = color4v . (castPtr :: Ptr (Color4 b) -> Ptr b)++--------------------------------------------------------------------------------++-- | Change the current secondary color.++class SecondaryColor a where+   secondaryColor  ::     a -> IO ()+   secondaryColorv :: Ptr a -> IO ()++instance ColorComponent a => SecondaryColor (Color3 a) where+   secondaryColor (Color3 r g b) = secondaryColor3 r g b+   secondaryColorv = secondaryColor3v . (castPtr :: Ptr (Color3 b) -> Ptr b)++--------------------------------------------------------------------------------++-- The current color index. The initial value is 1. Note that this state+-- variable is significant only when the GL is in color index mode.++currentIndex :: StateVar (Index1 GLint)+currentIndex = makeStateVar (getInteger1 Index1 GetCurrentIndex) index++--------------------------------------------------------------------------------++-- | The class of all types which can be used as a color index.++class IndexComponent a where+   index1 :: a -> IO ()+   index1v :: Ptr a -> IO ()++instance IndexComponent GLshort where+   index1 = glIndexs+   index1v = glIndexsv++instance IndexComponent GLint where+   index1 = glIndexi+   index1v = glIndexiv++instance IndexComponent GLfloat where+   index1 = glIndexf+   index1v = glIndexfv++instance IndexComponent GLdouble where+   index1 = glIndexd+   index1v = glIndexdv++instance IndexComponent GLubyte where+   index1 = glIndexub+   index1v = glIndexubv++--------------------------------------------------------------------------------++-- | Change the current color index.++class Index a where+   index  ::     a -> IO ()  -- Collision with Prelude.index+   indexv :: Ptr a -> IO ()++instance IndexComponent a => Index (Index1 a) where+   index (Index1 i) = index1 i+   indexv = index1v . (castPtr :: Ptr (Index1 b) -> Ptr b)++--------------------------------------------------------------------------------++data IntegerHandling =+     ToFloat+   | ToNormalizedFloat+   | KeepIntegral+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++currentVertexAttrib :: AttribLocation -> StateVar (Vertex4 GLfloat)+currentVertexAttrib location =+   makeStateVar+      (getVertexAttribFloat4 Vertex4 location GetCurrentVertexAttrib)+      (vertexAttrib ToFloat location)++currentVertexAttribI :: AttribLocation -> StateVar (Vertex4 GLint)+currentVertexAttribI location =+   makeStateVar+      (getVertexAttribIInteger4 Vertex4 location GetCurrentVertexAttrib)+      (vertexAttrib ToNormalizedFloat location)++currentVertexAttribIu :: AttribLocation -> StateVar (Vertex4 GLuint)+currentVertexAttribIu location =+   makeStateVar+      (getVertexAttribIuInteger4 Vertex4 location GetCurrentVertexAttrib)+      (vertexAttrib KeepIntegral location)++--------------------------------------------------------------------------------+-- The generic vertex attribute API is not as orthogonal as we would like.+-- Minimal methods: vertexAttrib4v and vertexAttrib4Nv and vertexAttrib4Iv++-- | The class of all types which can be used as a generic vertex attribute.+-- NOTE: Do not use the methods of this class directly, they were only exported+-- by accident and will be hidden in future versions of this package.++class (Storable a, Num a) => VertexAttribComponent a where+   vertexAttrib1 :: AttribLocation -> a -> IO ()+   vertexAttrib2 :: AttribLocation -> a -> a -> IO ()+   vertexAttrib3 :: AttribLocation -> a -> a -> a -> IO ()+   vertexAttrib4 :: AttribLocation -> a -> a -> a -> a -> IO ()++   vertexAttrib1N :: AttribLocation -> a -> IO ()+   vertexAttrib2N :: AttribLocation -> a -> a -> IO ()+   vertexAttrib3N :: AttribLocation -> a -> a -> a -> IO ()+   vertexAttrib4N :: AttribLocation -> a -> a -> a -> a -> IO ()++   vertexAttrib1I :: AttribLocation -> a -> IO ()+   vertexAttrib2I :: AttribLocation -> a -> a -> IO ()+   vertexAttrib3I :: AttribLocation -> a -> a -> a -> IO ()+   vertexAttrib4I :: AttribLocation -> a -> a -> a -> a -> IO ()++   vertexAttrib1v :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib2v :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib3v :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib4v :: AttribLocation -> Ptr a -> IO ()++   vertexAttrib1Nv :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib2Nv :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib3Nv :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib4Nv :: AttribLocation -> Ptr a -> IO ()++   vertexAttrib1Iv :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib2Iv :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib3Iv :: AttribLocation -> Ptr a -> IO ()+   vertexAttrib4Iv :: AttribLocation -> Ptr a -> IO ()++   vertexAttrib1 location x = vertexAttrib4 location x 0 0 1+   vertexAttrib2 location x y = vertexAttrib4 location x y 0 1+   vertexAttrib3 location x y z = vertexAttrib4 location x y z 1+   vertexAttrib4 location x y z w = allocaArray 4 $ \buf -> do+                                       poke4 buf x y z w+                                       vertexAttrib4v location buf++   vertexAttrib1N location x = vertexAttrib4N location x 0 0 1+   vertexAttrib2N location x y = vertexAttrib4N location x y 0 1+   vertexAttrib3N location x y z = vertexAttrib4N location x y z 1+   vertexAttrib4N location x y z w = allocaArray 4 $ \buf -> do+                                       poke4 buf x y z w+                                       vertexAttrib4Nv location buf++   vertexAttrib1I location x = vertexAttrib4I location x 0 0 1+   vertexAttrib2I location x y = vertexAttrib4I location x y 0 1+   vertexAttrib3I location x y z = vertexAttrib4I location x y z 1+   vertexAttrib4I location x y z w = allocaArray 4 $ \buf -> do+                                       poke4 buf x y z w+                                       vertexAttrib4Iv location buf++   vertexAttrib1v location = peek1M $ vertexAttrib1 location+   vertexAttrib2v location = peek2M $ vertexAttrib2 location+   vertexAttrib3v location = peek3M $ vertexAttrib3 location++   vertexAttrib1Nv location = peek1M $ vertexAttrib1N location+   vertexAttrib2Nv location = peek2M $ vertexAttrib2N location+   vertexAttrib3Nv location = peek3M $ vertexAttrib3N location++   vertexAttrib1Iv location = peek1M $ vertexAttrib1I location+   vertexAttrib2Iv location = peek2M $ vertexAttrib2I location+   vertexAttrib3Iv location = peek3M $ vertexAttrib3I location++instance VertexAttribComponent GLbyte where+   vertexAttrib4v (AttribLocation al) = glVertexAttrib4bv al+   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nbv al+   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4bv al++instance VertexAttribComponent GLubyte where+   vertexAttrib4N (AttribLocation al) = glVertexAttrib4Nub al+   vertexAttrib4v (AttribLocation al) = glVertexAttrib4ubv al+   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nubv al+   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4ubv al++instance VertexAttribComponent GLshort where+   vertexAttrib1 (AttribLocation al) = glVertexAttrib1s al+   vertexAttrib2 (AttribLocation al) = glVertexAttrib2s al+   vertexAttrib3 (AttribLocation al) = glVertexAttrib3s al+   vertexAttrib4 (AttribLocation al) = glVertexAttrib4s al++   vertexAttrib1v (AttribLocation al) = glVertexAttrib1sv al+   vertexAttrib2v (AttribLocation al) = glVertexAttrib2sv al+   vertexAttrib3v (AttribLocation al) = glVertexAttrib3sv al+   vertexAttrib4v (AttribLocation al) = glVertexAttrib4sv al++   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nsv al++   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4sv al++instance VertexAttribComponent GLushort where+   vertexAttrib4v (AttribLocation al) = glVertexAttrib4usv al+   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nusv al+   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4usv al++instance VertexAttribComponent GLint where+   vertexAttrib1I (AttribLocation al) = glVertexAttribI1i al+   vertexAttrib2I (AttribLocation al) = glVertexAttribI2i al+   vertexAttrib3I (AttribLocation al) = glVertexAttribI3i al+   vertexAttrib4I (AttribLocation al) = glVertexAttribI4i al++   vertexAttrib4v (AttribLocation al) = glVertexAttrib4iv al++   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Niv al++   vertexAttrib1Iv (AttribLocation al) = glVertexAttribI1iv al+   vertexAttrib2Iv (AttribLocation al) = glVertexAttribI2iv al+   vertexAttrib3Iv (AttribLocation al) = glVertexAttribI3iv al+   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4iv al++instance VertexAttribComponent GLuint where+   vertexAttrib1I (AttribLocation al) = glVertexAttribI1ui al+   vertexAttrib2I (AttribLocation al) = glVertexAttribI2ui al+   vertexAttrib3I (AttribLocation al) = glVertexAttribI3ui al+   vertexAttrib4I (AttribLocation al) = glVertexAttribI4ui al++   vertexAttrib4v (AttribLocation al) = glVertexAttrib4uiv al++   vertexAttrib4Nv (AttribLocation al) = glVertexAttrib4Nuiv al++   vertexAttrib1Iv (AttribLocation al) = glVertexAttribI1uiv al+   vertexAttrib2Iv (AttribLocation al) = glVertexAttribI2uiv al+   vertexAttrib3Iv (AttribLocation al) = glVertexAttribI3uiv al+   vertexAttrib4Iv (AttribLocation al) = glVertexAttribI4uiv al++instance VertexAttribComponent GLfloat where+   vertexAttrib1 (AttribLocation al) = glVertexAttrib1f al+   vertexAttrib2 (AttribLocation al) = glVertexAttrib2f al+   vertexAttrib3 (AttribLocation al) = glVertexAttrib3f al+   vertexAttrib4 (AttribLocation al) = glVertexAttrib4f al++   vertexAttrib1v (AttribLocation al) = glVertexAttrib1fv al+   vertexAttrib2v (AttribLocation al) = glVertexAttrib2fv al+   vertexAttrib3v (AttribLocation al) = glVertexAttrib3fv al+   vertexAttrib4v (AttribLocation al) = glVertexAttrib4fv al++   vertexAttrib4Nv = vertexAttrib4v++   vertexAttrib4Iv = vertexAttrib4IvRealFrac++vertexAttrib4IvRealFrac :: (Storable a, RealFrac a) => AttribLocation -> Ptr a -> IO ()+vertexAttrib4IvRealFrac location = peek4M $ \x y z w ->+   vertexAttrib4I location (toGLint x) (toGLint y) (toGLint z) (toGLint w)++-- formula 2.6 from the OpenGL 3.1 spec+toGLint :: RealFrac a => a -> GLint+toGLint = truncate . (fromIntegral (maxBound :: GLint) *). clamp+   where clamp = max (-1.0) . min 1.0++instance VertexAttribComponent GLdouble where+   vertexAttrib1 (AttribLocation al) = glVertexAttrib1d al+   vertexAttrib2 (AttribLocation al) = glVertexAttrib2d al+   vertexAttrib3 (AttribLocation al) = glVertexAttrib3d al+   vertexAttrib4 (AttribLocation al) = glVertexAttrib4d al++   vertexAttrib1v (AttribLocation al) = glVertexAttrib1dv al+   vertexAttrib2v (AttribLocation al) = glVertexAttrib2dv al+   vertexAttrib3v (AttribLocation al) = glVertexAttrib3dv al+   vertexAttrib4v (AttribLocation al) = glVertexAttrib4dv al++   vertexAttrib4Nv = vertexAttrib4v++   vertexAttrib4Iv = vertexAttrib4IvRealFrac++--------------------------------------------------------------------------------++class VertexAttrib a where+   vertexAttrib  :: IntegerHandling -> AttribLocation ->     a -> IO ()+   vertexAttribv :: IntegerHandling -> AttribLocation -> Ptr a -> IO ()++instance VertexAttribComponent a => VertexAttrib (Vertex1 a) where+   vertexAttrib ToFloat location (Vertex1 i) = vertexAttrib1 location i+   vertexAttrib ToNormalizedFloat location (Vertex1 i) = vertexAttrib1N location i+   vertexAttrib KeepIntegral location (Vertex1 i) = vertexAttrib1I location i++   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Vertex1 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Vertex2 a) where+   vertexAttrib ToFloat location (Vertex2 x y) = vertexAttrib2 location x y+   vertexAttrib ToNormalizedFloat location (Vertex2 x y) = vertexAttrib2N location x y+   vertexAttrib KeepIntegral location (Vertex2 x y) = vertexAttrib2I location x y++   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (Vertex2 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Vertex3 a) where+   vertexAttrib ToFloat location (Vertex3 x y z) = vertexAttrib3 location x y z+   vertexAttrib ToNormalizedFloat location (Vertex3 x y z) = vertexAttrib3N location x y z+   vertexAttrib KeepIntegral location (Vertex3 x y z) = vertexAttrib3I location x y z++   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Vertex3 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Vertex4 a) where+   vertexAttrib ToFloat location (Vertex4 x y z w) = vertexAttrib4 location x y z w+   vertexAttrib ToNormalizedFloat location (Vertex4 x y z w) = vertexAttrib4N location x y z w+   vertexAttrib KeepIntegral location (Vertex4 x y z w) = vertexAttrib4I location x y z w++   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Vertex4 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Vector1 a) where+   vertexAttrib ToFloat location (Vector1 i) = vertexAttrib1 location i+   vertexAttrib ToNormalizedFloat location (Vector1 i) = vertexAttrib1N location i+   vertexAttrib KeepIntegral location (Vector1 i) = vertexAttrib1I location i++   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Vector1 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Vector1 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Vector1 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Vector2 a) where+   vertexAttrib ToFloat location (Vector2 x y) = vertexAttrib2 location x y+   vertexAttrib ToNormalizedFloat location (Vector2 x y) = vertexAttrib2N location x y+   vertexAttrib KeepIntegral location (Vector2 x y) = vertexAttrib2I location x y++   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (Vector2 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (Vector2 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (Vector2 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Vector3 a) where+   vertexAttrib ToFloat location (Vector3 x y z) = vertexAttrib3 location x y z+   vertexAttrib ToNormalizedFloat location (Vector3 x y z) = vertexAttrib3N location x y z+   vertexAttrib KeepIntegral location (Vector3 x y z) = vertexAttrib3I location x y z++   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Vector3 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Vector3 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Vector3 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Vector4 a) where+   vertexAttrib ToFloat location (Vector4 x y z w) = vertexAttrib4 location x y z w+   vertexAttrib ToNormalizedFloat location (Vector4 x y z w) = vertexAttrib4N location x y z w+   vertexAttrib KeepIntegral location (Vector4 x y z w) = vertexAttrib4I location x y z w++   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Vector4 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Vector4 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Vector4 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (TexCoord1 a) where+   vertexAttrib ToFloat location (TexCoord1 s) = vertexAttrib1 location s+   vertexAttrib ToNormalizedFloat location (TexCoord1 s) = vertexAttrib1N location s+   vertexAttrib KeepIntegral location (TexCoord1 s) = vertexAttrib1I location s++   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (TexCoord2 a) where+   vertexAttrib ToFloat location (TexCoord2 s t) = vertexAttrib2 location s t+   vertexAttrib ToNormalizedFloat location (TexCoord2 s t) = vertexAttrib2N location s t+   vertexAttrib KeepIntegral location (TexCoord2 s t) = vertexAttrib2I location s t++   vertexAttribv ToFloat location = vertexAttrib2v location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib2Nv location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib2Iv location . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (TexCoord3 a) where+   vertexAttrib ToFloat location (TexCoord3 s t u) = vertexAttrib3 location s t u+   vertexAttrib ToNormalizedFloat location (TexCoord3 s t u) = vertexAttrib3N location s t u+   vertexAttrib KeepIntegral location (TexCoord3 s t u) = vertexAttrib3I location s t u++   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (TexCoord4 a) where+   vertexAttrib ToFloat location (TexCoord4 s t u v) = vertexAttrib4 location s t u v+   vertexAttrib ToNormalizedFloat location (TexCoord4 s t u v) = vertexAttrib4N location s t u v+   vertexAttrib KeepIntegral location (TexCoord4 s t u v) = vertexAttrib4I location s t u v++   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Normal3 a) where+   vertexAttrib ToFloat location (Normal3 x y z) = vertexAttrib3 location x y z+   vertexAttrib ToNormalizedFloat location (Normal3 x y z) = vertexAttrib3N location x y z+   vertexAttrib KeepIntegral location (Normal3 x y z) = vertexAttrib3I location x y z++   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Normal3 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Normal3 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Normal3 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (FogCoord1 a) where+   vertexAttrib ToFloat location (FogCoord1 c) = vertexAttrib1 location c+   vertexAttrib ToNormalizedFloat location (FogCoord1 c) = vertexAttrib1N location c+   vertexAttrib KeepIntegral location (FogCoord1 c) = vertexAttrib1I location c++   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Color3 a) where+   vertexAttrib ToFloat location (Color3 r g b) = vertexAttrib3 location r g b+   vertexAttrib ToNormalizedFloat location (Color3 r g b) = vertexAttrib3N location r g b+   vertexAttrib KeepIntegral location (Color3 r g b) = vertexAttrib3I location r g b++   vertexAttribv ToFloat location = vertexAttrib3v location . (castPtr :: Ptr (Color3 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib3Nv location . (castPtr :: Ptr (Color3 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib3Iv location . (castPtr :: Ptr (Color3 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Color4 a) where+   vertexAttrib ToFloat location (Color4 r g b a) = vertexAttrib4 location r g b a+   vertexAttrib ToNormalizedFloat location (Color4 r g b a) = vertexAttrib4N location r g b a+   vertexAttrib KeepIntegral location (Color4 r g b a) = vertexAttrib4I location r g b a++   vertexAttribv ToFloat location = vertexAttrib4v location . (castPtr :: Ptr (Color4 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib4Nv location . (castPtr :: Ptr (Color4 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib4Iv location . (castPtr :: Ptr (Color4 b) -> Ptr b)++instance VertexAttribComponent a => VertexAttrib (Index1 a) where+   vertexAttrib ToFloat location (Index1 i) = vertexAttrib1 location i+   vertexAttrib ToNormalizedFloat location (Index1 i) = vertexAttrib1N location i+   vertexAttrib KeepIntegral location (Index1 i) = vertexAttrib1I location i++   vertexAttribv ToFloat location = vertexAttrib1v location . (castPtr :: Ptr (Index1 b) -> Ptr b)+   vertexAttribv ToNormalizedFloat location = vertexAttrib1Nv location . (castPtr :: Ptr (Index1 b) -> Ptr b)+   vertexAttribv KeepIntegral location = vertexAttrib1Iv location . (castPtr :: Ptr (Index1 b) -> Ptr b)++--------------------------------------------------------------------------------++-- | An implementation must support at least 2 texture units, but it may+-- support up to 32 ones. This state variable can be used to query the actual+-- implementation limit.++maxTextureUnit :: GettableStateVar TextureUnit+maxTextureUnit =+   makeGettableStateVar (getEnum1 (TextureUnit . fromIntegral) GetMaxTextureUnits)
+ src/Graphics/Rendering/OpenGL/GLU.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- A Haskell binding for GLU, OpenGL\'s accompanying utility library.+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU (+     module Graphics.Rendering.OpenGL.GLU.Initialization,+     module Graphics.Rendering.OpenGL.GLU.Mipmapping,+     module Graphics.Rendering.OpenGL.GLU.Matrix,+     module Graphics.Rendering.OpenGL.GLU.Tessellation,+     module Graphics.Rendering.OpenGL.GLU.Quadrics,+     module Graphics.Rendering.OpenGL.GLU.NURBS,+     module Graphics.Rendering.OpenGL.GLU.Errors+) where++import Graphics.Rendering.OpenGL.GLU.Initialization+import Graphics.Rendering.OpenGL.GLU.Mipmapping+import Graphics.Rendering.OpenGL.GLU.Matrix+import Graphics.Rendering.OpenGL.GLU.Tessellation+import Graphics.Rendering.OpenGL.GLU.Quadrics+import Graphics.Rendering.OpenGL.GLU.NURBS+import Graphics.Rendering.OpenGL.GLU.Errors
+ src/Graphics/Rendering/OpenGL/GLU/Errors.hs view
@@ -0,0 +1,34 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Errors+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.5 (GL Errors) of the OpenGL 2.1 specs+-- and chapter 8 (Errors) of the GLU specs, offering a generalized view of+-- errors in GL and GLU.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.Errors (+   Error(..), ErrorCategory(..), errors+) where++import Data.StateVar+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal++--------------------------------------------------------------------------------++-- | When an error occurs, it is recorded in this state variable and no further+-- errors are recorded. Reading 'errors' returns the currently recorded errors+-- (there may be more than one due to a possibly distributed implementation) and+-- resets the state variable to @[]@, re-enabling the recording of future+-- errors. The value @[]@ means that there has been no detectable error since+-- the last time 'errors' was read, or since the GL was initialized.++errors :: GettableStateVar [Error]+errors = makeGettableStateVar getErrors
+ src/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-cse #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.ErrorsInternal+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module corresponding to some parts of section 2.5+-- (GL Errors) of the OpenGL 2.1 specs and chapter 8 (Errors) of the GLU specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.ErrorsInternal (+   Error(..), ErrorCategory(..), getErrors,+   recordErrorCode, recordInvalidEnum, recordInvalidValue, recordOutOfMemory+) where++import Data.IORef ( IORef, newIORef, readIORef, writeIORef )+import Graphics.GLU+import Graphics.GL+import System.IO.Unsafe ( unsafePerformIO )++--------------------------------------------------------------------------------++-- | GL\/GLU errors consist of a general error category and a description of+-- what went wrong.++data Error = Error ErrorCategory String+   deriving ( Eq, Ord, Show )++-- | General GL\/GLU error categories++data ErrorCategory+   = ContextLost+   | InvalidEnum+   | InvalidValue+   | InvalidOperation+   | InvalidFramebufferOperation+   | OutOfMemory+   | StackOverflow+   | StackUnderflow+   | TableTooLarge+   | TesselatorError+   | NURBSError+   deriving ( Eq, Ord, Show )++makeError :: GLenum -> Error+makeError c+   -- GL errors+   | c == GL_CONTEXT_LOST =+       Error ContextLost "context lost"+   | c == GL_INVALID_ENUM =+       Error InvalidEnum "invalid enumerant"+   | c == GL_INVALID_VALUE =+       Error InvalidValue  "invalid value"+   | c == GL_INVALID_OPERATION =+       Error InvalidOperation "invalid operation"+   | c == GL_INVALID_FRAMEBUFFER_OPERATION =+       Error InvalidFramebufferOperation "invalid framebuffer operation"+   | c == GL_OUT_OF_MEMORY+       = Error OutOfMemory "out of memory"+   | c == GL_STACK_OVERFLOW =+       Error StackOverflow "stack overflow"+   | c == GL_STACK_UNDERFLOW =+       Error StackUnderflow "stack underflow"+   | c == GL_TABLE_TOO_LARGE =+       Error TableTooLarge "table too large"+   -- GLU errors+   | c == GLU_INVALID_ENUM =+       Error InvalidEnum "invalid enumerant"+   | c == GLU_INVALID_VALUE =+       Error InvalidValue  "invalid value"+   | c == GLU_INVALID_OPERATION =+       Error InvalidOperation "invalid operation"+   | c == GLU_OUT_OF_MEMORY+       = Error OutOfMemory "out of memory"+   -- GLU tesselator error+   | c == GLU_TESS_ERROR1 =+       Error TesselatorError "gluTessBeginPolygon() must precede a gluTessEndPolygon()"+   | c == GLU_TESS_ERROR2 =+       Error TesselatorError "gluTessBeginContour() must precede a gluTessEndContour()"+   | c == GLU_TESS_ERROR3 =+       Error TesselatorError "gluTessEndPolygon() must follow a gluTessBeginPolygon()"+   | c == GLU_TESS_ERROR4 =+       Error TesselatorError "gluTessEndContour() must follow a gluTessBeginContour()"+   | c == GLU_TESS_ERROR5 =+       Error TesselatorError "a coordinate is too large"+   | c == GLU_TESS_ERROR6 =+       Error TesselatorError "need combine callback"+   | c == GLU_TESS_ERROR7 =+       Error TesselatorError "tesselation error 7"+   | c == GLU_TESS_ERROR8 =+       Error TesselatorError "tesselation error 8"+   -- GLU NUBRS errors+   | c == GLU_NURBS_ERROR1 =+       Error NURBSError "spline order un-supported"+   | c == GLU_NURBS_ERROR2 =+       Error NURBSError "too few knots"+   | c == GLU_NURBS_ERROR3 =+       Error NURBSError "valid knot range is empty"+   | c == GLU_NURBS_ERROR4 =+       Error NURBSError "decreasing knot sequence knot"+   | c == GLU_NURBS_ERROR5 =+       Error NURBSError "knot multiplicity greater than order of spline"+   | c == GLU_NURBS_ERROR6 =+       Error NURBSError "gluEndCurve() must follow gluBeginCurve()"+   | c == GLU_NURBS_ERROR7 =+       Error NURBSError "gluBeginCurve() must precede gluEndCurve()"+   | c == GLU_NURBS_ERROR8 =+       Error NURBSError "missing or extra geometric data"+   | c == GLU_NURBS_ERROR9 =+       Error NURBSError "can't draw piecewise linear trimming curves"+   | c == GLU_NURBS_ERROR10 =+       Error NURBSError "missing or extra domain data"+   | c == GLU_NURBS_ERROR11 =+       Error NURBSError "missing or extra domain data"+   | c == GLU_NURBS_ERROR12 =+       Error NURBSError "gluEndTrim() must precede gluEndSurface()"+   | c == GLU_NURBS_ERROR13 =+       Error NURBSError "gluBeginSurface() must precede gluEndSurface()"+   | c == GLU_NURBS_ERROR14 =+       Error NURBSError "curve of improper type passed as trim curve"+   | c == GLU_NURBS_ERROR15 =+       Error NURBSError "gluBeginSurface() must precede gluBeginTrim()"+   | c == GLU_NURBS_ERROR16 =+       Error NURBSError "gluEndTrim() must follow gluBeginTrim()"+   | c == GLU_NURBS_ERROR17 =+       Error NURBSError "gluBeginTrim() must precede gluEndTrim()"+   | c == GLU_NURBS_ERROR18 =+       Error NURBSError "invalid or missing trim curve"+   | c == GLU_NURBS_ERROR19 =+       Error NURBSError "gluBeginTrim() must precede gluPwlCurve()"+   | c == GLU_NURBS_ERROR20 =+       Error NURBSError "piecewise linear trimming curve referenced twice"+   | c == GLU_NURBS_ERROR21 =+       Error NURBSError "piecewise linear trimming curve and nurbs curve mixed"+   | c == GLU_NURBS_ERROR22 =+       Error NURBSError "improper usage of trim data type"+   | c == GLU_NURBS_ERROR23 =+       Error NURBSError "nurbs curve referenced twice"+   | c == GLU_NURBS_ERROR24 =+       Error NURBSError "nurbs curve and piecewise linear trimming curve mixed"+   | c == GLU_NURBS_ERROR25 =+       Error NURBSError "nurbs surface referenced twice"+   | c == GLU_NURBS_ERROR26 =+       Error NURBSError "invalid property"+   | c == GLU_NURBS_ERROR27 =+       Error NURBSError "gluEndSurface() must follow gluBeginSurface()"+   | c == GLU_NURBS_ERROR28 =+       Error NURBSError "intersecting or misoriented trim curves"+   | c == GLU_NURBS_ERROR29 =+       Error NURBSError "intersecting trim curves"+   | c == GLU_NURBS_ERROR30 =+       Error NURBSError "UNUSED"+   | c == GLU_NURBS_ERROR31 =+       Error NURBSError "unconnected trim curves"+   | c == GLU_NURBS_ERROR32 =+       Error NURBSError "unknown knot error"+   | c == GLU_NURBS_ERROR33 =+       Error NURBSError "negative vertex count encountered"+   | c == GLU_NURBS_ERROR34 =+       Error NURBSError "negative byte-stride encounteed"+   | c == GLU_NURBS_ERROR35 =+       Error NURBSError "unknown type descriptor"+   | c == GLU_NURBS_ERROR36 =+       Error NURBSError "null control point reference"+   | c == GLU_NURBS_ERROR37 =+       Error NURBSError "duplicate point on piecewise linear trimming curve"+   -- Something went terribly wrong...+   | otherwise = error "makeError"++--------------------------------------------------------------------------------++-- This seems to be a common Haskell hack nowadays: A plain old global variable+-- with an associated getter and mutator. Perhaps some language/library support+-- is needed?++{-# NOINLINE theRecordedErrors #-}+theRecordedErrors :: IORef ([GLenum],Bool)+theRecordedErrors = unsafePerformIO (newIORef ([], True))++getRecordedErrors :: IO ([GLenum],Bool)+getRecordedErrors =  readIORef theRecordedErrors++setRecordedErrors :: ([GLenum],Bool) -> IO ()+setRecordedErrors = writeIORef theRecordedErrors++--------------------------------------------------------------------------------++getGLErrors :: IO [GLenum]+getGLErrors = getGLErrorsAux []+   where getGLErrorsAux acc = do+            errorCode <- glGetError+            if isError errorCode+               then getGLErrorsAux (errorCode : acc)+               else return $ reverse acc++isError :: GLenum -> Bool+isError = (/= GL_NO_ERROR)++--------------------------------------------------------------------------------++getErrors :: IO [Error]+getErrors = map makeError `fmap` getErrorCodesAux (const ([], True))++recordErrorCode :: GLenum -> IO ()+recordErrorCode e = do+   -- We don't need the return value because this calls setRecordedErrors+   _ <- getErrorCodesAux (\es -> (if null es then [e] else [], False))+   return ()++recordInvalidEnum :: IO ()+recordInvalidEnum = recordErrorCode GL_INVALID_ENUM++recordInvalidValue :: IO ()+recordInvalidValue = recordErrorCode GL_INVALID_VALUE++recordOutOfMemory :: IO ()+recordOutOfMemory = recordErrorCode GL_OUT_OF_MEMORY++-- ToDo: Make this thread-safe+getErrorCodesAux :: ([GLenum] -> ([GLenum],Bool)) -> IO [GLenum]+getErrorCodesAux f = do+   (recordedErrors, useGLErrors) <- getRecordedErrors+   glErrors <- getGLErrors+   let es = if useGLErrors then recordedErrors ++ glErrors else recordedErrors+   setRecordedErrors (f es)+   return es
+ src/Graphics/Rendering/OpenGL/GLU/Initialization.hs view
@@ -0,0 +1,33 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Initialization+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to chapter 2 (Initialization) of the GLU specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.Initialization (+   gluVersion, gluExtensions+) where++import Data.StateVar+import Graphics.GLU+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.GL++--------------------------------------------------------------------------------++gluVersion :: GettableStateVar String+gluVersion = makeGettableStateVar (getString GLU_VERSION)++gluExtensions :: GettableStateVar [String]+gluExtensions = makeGettableStateVar (fmap words $ getString GLU_EXTENSIONS)++getString :: GLenum -> IO String+getString = getStringWith . gluGetString
+ src/Graphics/Rendering/OpenGL/GLU/Matrix.hs view
@@ -0,0 +1,135 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Matrix+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to chapter 4 (Matrix Manipulation) of the GLU specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.Matrix (+   ortho2D, perspective, lookAt, pickMatrix,+   project, unProject, unProject4+) where++import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.GLU+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------+-- matrix setup++ortho2D :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()+ortho2D = gluOrtho2D+++perspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()+perspective = gluPerspective++lookAt :: Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble -> IO ()+lookAt (Vertex3 eyeX    eyeY    eyeZ)+       (Vertex3 centerX centerY centerZ)+       (Vector3 upX     upY     upZ) =+   gluLookAt eyeX eyeY eyeZ centerX centerY centerZ upX upY upZ++pickMatrix ::+   (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> (Position, Size) -> IO ()+pickMatrix (x, y) (w, h) viewPort =+   withViewport viewPort $ gluPickMatrix x y w h++--------------------------------------------------------------------------------+-- coordinate projection++project ::+      Matrix m+   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)+   -> IO (Vertex3 GLdouble)+project (Vertex3 objX objY objZ) model proj viewPort =+   withColumnMajor model $ \modelBuf ->+   withColumnMajor proj $ \projBuf ->+   withViewport viewPort $ \viewBuf ->+   getVertex3 $ gluProject objX objY objZ modelBuf projBuf viewBuf++unProject ::+      Matrix m+   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)+   -> IO (Vertex3 GLdouble)+unProject (Vertex3 objX objY objZ) model proj viewPort =+   withColumnMajor model $ \modelBuf ->+   withColumnMajor proj $ \projBuf ->+   withViewport viewPort $ \viewBuf ->+   getVertex3 $ gluUnProject objX objY objZ modelBuf projBuf viewBuf++unProject4 ::+      Matrix m+   => Vertex4 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)+   -> GLclampd -> GLclampd+   -> IO (Vertex4 GLdouble)+unProject4 (Vertex4 objX objY objZ clipW) model proj viewPort near far =+   withColumnMajor model $ \modelBuf ->+   withColumnMajor proj $ \projBuf ->+   withViewport viewPort $ \viewBuf ->+   getVertex4 $+      gluUnProject4 objX objY objZ clipW modelBuf projBuf viewBuf near far++--------------------------------------------------------------------------------++withViewport :: (Position, Size) -> (Ptr GLint -> IO a ) -> IO a+withViewport (Position x y, Size w h) =+   withArray [ x, y, fromIntegral w, fromIntegral h ]++withColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO b) -> IO b+withColumnMajor mat act = withMatrix mat juggle+   where juggle ColumnMajor p = act p+         juggle RowMajor    p = do+            transposedElems <- mapM (peekElemOff p) [ 0, 4,  8, 12,+                                                      1, 5,  9, 13,+                                                      2, 6, 10, 14,+                                                      3, 7, 11, 15 ]+            withArray transposedElems act++getVertex3 ::+      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)+   -> IO (Vertex3 GLdouble)+getVertex3 act =+   alloca $ \xBuf ->+   alloca $ \yBuf ->+   alloca $ \zBuf -> do+   ok <- act xBuf yBuf zBuf+   if unmarshalGLboolean ok+      then do x <- peek xBuf+              y <- peek yBuf+              z <- peek zBuf+              return $ Vertex3 x y z+      else do recordInvalidValue+              return $ Vertex3 0 0 0++getVertex4 ::+      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)+   -> IO (Vertex4 GLdouble)+getVertex4 act =+   alloca $ \xBuf ->+   alloca $ \yBuf ->+   alloca $ \zBuf ->+   alloca $ \wBuf -> do+   ok <- act xBuf yBuf zBuf wBuf+   if unmarshalGLboolean ok+      then do x <- peek xBuf+              y <- peek yBuf+              z <- peek zBuf+              w <- peek wBuf+              return $ Vertex4 x y z w+      else do recordInvalidValue+              return $ Vertex4 0 0 0 0
+ src/Graphics/Rendering/OpenGL/GLU/Mipmapping.hs view
@@ -0,0 +1,64 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Mipmapping+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to chapter 3 (Mipmapping) of the GLU specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.Mipmapping (+   scaleImage, build1DMipmaps, build2DMipmaps+) where++import Graphics.GLU+import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.PixelData ( PixelData, withPixelData )+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidValue )+import Graphics.GL++--------------------------------------------------------------------------------+-- Section 3.1 (Image Scaling)++scaleImage :: Size -> PixelData a -> Size -> PixelData b -> IO ()+scaleImage (Size widthIn  heightIn)  pdIn (Size widthOut heightOut) pdOut =+   withPixelData pdIn $ \fIn dIn pIn ->+      withPixelData pdOut $ \fOut dOut pOut ->+         if fIn == fOut+            then do _ <- gluScaleImage+                      fIn widthIn heightIn dIn pIn widthOut heightOut dOut pOut+                    return ()   -- TODO: Should we use the return value?+            else recordInvalidValue++--------------------------------------------------------------------------------+-- Section 3.2 (Automatic Mipmapping)+-- Missing for GLU 1.3: gluBuild3DMipmaps, gluBuild{1,2,3}DMipmapLevels++build1DMipmaps ::+   TextureTarget1D -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()+build1DMipmaps target internalFormat height pd = do+   _ <- withPixelData pd $+      gluBuild1DMipmaps+         (marshalGettableTextureTarget target)+         (marshalPixelInternalFormat internalFormat)+         height+   return ()   -- TODO: Should we use the return value?++--------------------------------------------------------------------------------++build2DMipmaps :: TextureTarget2D -> PixelInternalFormat -> GLsizei -> GLsizei+               -> PixelData a -> IO ()+build2DMipmaps target internalFormat width height pd = do+   _ <- withPixelData pd $+      gluBuild2DMipmaps+         (marshalGettableTextureTarget target)+         (marshalPixelInternalFormat internalFormat)+         width height+   return ()   -- TODO: Should we use the return value?
+ src/Graphics/Rendering/OpenGL/GLU/NURBS.hs view
@@ -0,0 +1,311 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.NURBS+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to chapter 7 (NURBS) of the GLU specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.NURBS (+   NURBSObj, withNURBSObj,+   NURBSBeginCallback, withNURBSBeginCallback,+   NURBSVertexCallback, withNURBSVertexCallback,+   NURBSNormalCallback, withNURBSNormalCallback,+   NURBSColorCallback, withNURBSColorCallback,+   NURBSEndCallback, withNURBSEndCallback,+   checkForNURBSError,+   nurbsBeginEndCurve, nurbsCurve,+   nurbsBeginEndSurface, nurbsSurface,+   TrimmingPoint, nurbsBeginEndTrim, pwlCurve, trimmingCurve,+   NURBSMode(..), setNURBSMode,+   setNURBSCulling,+   SamplingMethod(..), setSamplingMethod,+   loadSamplingMatrices,+   DisplayMode'(..), setDisplayMode'+) where++import Control.Monad+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.GLU hiding (+   NURBSBeginCallback, NURBSVertexCallback, NURBSNormalCallback,+   NURBSColorCallback, NURBSEndCallback )+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.ControlPoint+import Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PrimitiveMode+import Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------+-- chapter 7.1: The NURBS Object++-- an opaque pointer to a NURBS object+type NURBSObj = Ptr GLUnurbs++isNullNURBSObj :: NURBSObj -> Bool+isNullNURBSObj = (nullPtr ==)++withNURBSObj :: a -> (NURBSObj -> IO a) -> IO a+withNURBSObj failureValue action =+   bracket gluNewNurbsRenderer safeDeleteNurbsRenderer+           (\nurbsObj -> if isNullNURBSObj nurbsObj+                            then do recordOutOfMemory+                                    return failureValue+                            else action nurbsObj)++safeDeleteNurbsRenderer :: NURBSObj -> IO ()+safeDeleteNurbsRenderer nurbsObj =+   unless (isNullNURBSObj nurbsObj) $ gluDeleteNurbsRenderer nurbsObj++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (begin)++type NURBSBeginCallback = PrimitiveMode -> IO ()++withNURBSBeginCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a+withNURBSBeginCallback nurbsObj beginCallback action =+   bracket (makeNURBSBeginCallback (beginCallback . unmarshalPrimitiveMode))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj GLU_NURBS_BEGIN callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (vertex)++type NURBSVertexCallback = Vertex3 GLfloat -> IO ()++withNURBSVertexCallback :: NURBSObj -> NURBSVertexCallback -> IO a -> IO a+withNURBSVertexCallback nurbsObj vertexCallback action =+   bracket (makeNURBSVertexCallback (\p -> peek (castPtr p) >>= vertexCallback))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj GLU_NURBS_VERTEX callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (normal)++type NURBSNormalCallback = Normal3 GLfloat -> IO ()++withNURBSNormalCallback :: NURBSObj -> NURBSNormalCallback -> IO a -> IO a+withNURBSNormalCallback nurbsObj normalCallback action =+   bracket (makeNURBSNormalCallback (\p -> peek (castPtr p) >>= normalCallback))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj GLU_NURBS_NORMAL callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (color)++type NURBSColorCallback = Color4 GLfloat -> IO ()++withNURBSColorCallback :: NURBSObj -> NURBSColorCallback -> IO a -> IO a+withNURBSColorCallback nurbsObj colorCallback action =+   bracket (makeNURBSColorCallback (\p -> peek (castPtr p) >>= colorCallback))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj GLU_NURBS_COLOR callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (end)++type NURBSEndCallback = IO ()++withNURBSEndCallback :: NURBSObj -> NURBSEndCallback -> IO a -> IO a+withNURBSEndCallback nurbsObj endCallback action =+   bracket (makeNURBSEndCallback endCallback)+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj GLU_NURBS_END callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (error)++type ErrorCallback = GLenum -> IO ()++withErrorCallback :: NURBSObj -> ErrorCallback -> IO a -> IO a+withErrorCallback nurbsObj errorCallback action =+   bracket (makeNURBSErrorCallback errorCallback)+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj GLU_NURBS_ERROR callbackPtr+      action++checkForNURBSError :: NURBSObj -> IO a -> IO a+checkForNURBSError nurbsObj = withErrorCallback nurbsObj recordErrorCode++--------------------------------------------------------------------------------+-- chapter 7.3: NURBS Curves++nurbsBeginEndCurve :: NURBSObj -> IO a -> IO a+nurbsBeginEndCurve nurbsObj =+   bracket_ (gluBeginCurve nurbsObj) (gluEndCurve nurbsObj)+++nurbsCurve :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()+nurbsCurve nurbsObj knotCount knots stride control order =+   gluNurbsCurve nurbsObj knotCount knots stride (castPtr control) order (map1Target (pseudoPeek control))++pseudoPeek :: Ptr (c GLfloat) -> c GLfloat+pseudoPeek _ = undefined++--------------------------------------------------------------------------------+-- chapter 7.4: NURBS Surfaces++nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a+nurbsBeginEndSurface nurbsObj =+   bracket_ (gluBeginSurface nurbsObj) (gluEndSurface nurbsObj)+++nurbsSurface :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr GLfloat -> GLint -> GLint -> Ptr (c GLfloat) -> GLint -> GLint -> IO ()+nurbsSurface nurbsObj sKnotCount sKnots tKnotCount tKnots sStride tStride control sOrder tOrder =+   gluNurbsSurface nurbsObj sKnotCount sKnots tKnotCount tKnots sStride tStride (castPtr control) sOrder tOrder (map2Target (pseudoPeek control))++--------------------------------------------------------------------------------+-- chapter 7.5: Trimming++class TrimmingPoint p where+   trimmingTarget :: p GLfloat -> GLenum++instance TrimmingPoint Vertex2 where+   trimmingTarget = const GLU_MAP1_TRIM_2++instance TrimmingPoint Vertex3 where+   trimmingTarget = const GLU_MAP1_TRIM_3++nurbsBeginEndTrim :: NURBSObj -> IO a -> IO a+nurbsBeginEndTrim nurbsObj =+   bracket_ (gluBeginTrim nurbsObj) (gluEndTrim nurbsObj)++pwlCurve :: TrimmingPoint p => NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()+pwlCurve nurbsObj count points stride =+   gluPwlCurve nurbsObj count (castPtr points) stride (trimmingTarget (pseudoPeek points))++trimmingCurve :: TrimmingPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()+trimmingCurve nurbsObj knotCount knots stride control order =+   gluNurbsCurve nurbsObj knotCount knots stride (castPtr control) order (trimmingTarget (pseudoPeek control))++--------------------------------------------------------------------------------++data NURBSMode =+     NURBSTessellator+   | NURBSRenderer+   deriving ( Eq, Ord, Show )++marshalNURBSMode :: NURBSMode -> GLfloat+marshalNURBSMode x = fromIntegral $ case x of+   NURBSTessellator -> GLU_NURBS_TESSELLATOR+   NURBSRenderer -> GLU_NURBS_RENDERER++setNURBSMode :: NURBSObj -> NURBSMode -> IO ()+setNURBSMode nurbsObj = gluNurbsProperty nurbsObj GLU_NURBS_MODE . marshalNURBSMode++--------------------------------------------------------------------------------++setNURBSCulling :: NURBSObj -> Capability -> IO ()+setNURBSCulling nurbsObj = gluNurbsProperty nurbsObj GLU_CULLING . fromIntegral . marshalCapability++--------------------------------------------------------------------------------++data SamplingMethod' =+     PathLength'+   | ParametricError'+   | DomainDistance'+   | ObjectPathLength'+   | ObjectParametricError'++marshalSamplingMethod' :: SamplingMethod' -> GLfloat+marshalSamplingMethod' x = fromIntegral $ case x of+   PathLength' -> GLU_PATH_LENGTH+   ParametricError' -> GLU_PARAMETRIC_TOLERANCE+   DomainDistance' -> GLU_DOMAIN_DISTANCE+   ObjectPathLength' -> GLU_OBJECT_PATH_LENGTH+   ObjectParametricError' -> GLU_OBJECT_PARAMETRIC_ERROR++setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()+setSamplingMethod' nurbsObj = gluNurbsProperty nurbsObj GLU_SAMPLING_METHOD . marshalSamplingMethod'++--------------------------------------------------------------------------------++data SamplingMethod =+     PathLength GLfloat+   | ParametricError GLfloat+   | DomainDistance GLfloat GLfloat+   | ObjectPathLength GLfloat+   | ObjectParametricError GLfloat+   deriving ( Eq, Ord, Show )++setSamplingMethod :: NURBSObj -> SamplingMethod -> IO ()+setSamplingMethod nurbsObj x = case x of+   PathLength s -> do+      gluNurbsProperty nurbsObj GLU_SAMPLING_TOLERANCE s+      setSamplingMethod' nurbsObj PathLength'+   ParametricError p -> do+      gluNurbsProperty nurbsObj GLU_PARAMETRIC_TOLERANCE p+      setSamplingMethod' nurbsObj ParametricError'+   DomainDistance u v -> do+      gluNurbsProperty nurbsObj GLU_U_STEP u+      gluNurbsProperty nurbsObj GLU_V_STEP v+      setSamplingMethod' nurbsObj DomainDistance'+   ObjectPathLength s -> do+      gluNurbsProperty nurbsObj GLU_SAMPLING_TOLERANCE s+      setSamplingMethod' nurbsObj ObjectPathLength'+   ObjectParametricError p -> do+      gluNurbsProperty nurbsObj GLU_PARAMETRIC_TOLERANCE p+      setSamplingMethod' nurbsObj ObjectParametricError'++--------------------------------------------------------------------------------++setAutoLoadMatrix :: NURBSObj -> Bool -> IO ()+setAutoLoadMatrix nurbsObj = gluNurbsProperty nurbsObj GLU_AUTO_LOAD_MATRIX . marshalGLboolean++loadSamplingMatrices :: (Matrix m1, Matrix m2) => NURBSObj -> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ()+loadSamplingMatrices nurbsObj =+   maybe+      (setAutoLoadMatrix nurbsObj True)+      (\(mv, proj, (Position x y, Size w h)) -> do+          withMatrixColumnMajor mv $ \mvBuf ->+             withMatrixColumnMajor proj $ \projBuf ->+                withArray [x, y, fromIntegral w, fromIntegral h] $ \viewportBuf ->+                  gluLoadSamplingMatrices nurbsObj mvBuf projBuf viewportBuf+          setAutoLoadMatrix nurbsObj False)++withMatrixColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO a) -> IO a+withMatrixColumnMajor mat act =+   withMatrix mat $ \order p ->+      if order == ColumnMajor+         then act p+         else do+            elems <- mapM (peekElemOff p) [ 0, 4,  8, 12,+                                            1, 5,  9, 13,+                                            2, 6, 10, 14,+                                            3, 7, 11, 15 ]+            withArray elems act++--------------------------------------------------------------------------------++data DisplayMode' =+     Fill'+   | OutlinePolygon+   | OutlinePatch+   deriving ( Eq, Ord, Show )++marshalDisplayMode' :: DisplayMode' -> GLfloat+marshalDisplayMode' x = fromIntegral $ case x of+   Fill' -> GLU_FILL+   OutlinePolygon -> GLU_OUTLINE_POLYGON+   OutlinePatch -> GLU_OUTLINE_PATCH++setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()+setDisplayMode' nurbsObj = gluNurbsProperty nurbsObj GLU_DISPLAY_MODE . marshalDisplayMode'
+ src/Graphics/Rendering/OpenGL/GLU/Quadrics.hs view
@@ -0,0 +1,155 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Quadrics+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to chapter 6 (Quadrics) of the GLU specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.Quadrics (+   QuadricNormal, QuadricTexture(..), QuadricOrientation(..),+   QuadricDrawStyle(..), QuadricStyle(..),+   Radius, Height, Angle, Slices, Stacks, Loops, QuadricPrimitive(..),+   renderQuadric+) where++import Control.Monad ( unless )+import Foreign.Ptr ( Ptr, nullPtr, freeHaskellFunPtr )+import Graphics.GLU+import Graphics.Rendering.OpenGL.GL.Colors ( ShadingModel(Smooth,Flat) )+import Graphics.Rendering.OpenGL.GL.Exception ( bracket )+import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (+   recordErrorCode, recordOutOfMemory )+import Graphics.GL++--------------------------------------------------------------------------------++data QuadricDrawStyle =+     PointStyle+   | LineStyle+   | FillStyle+   | SilhouetteStyle+   deriving ( Eq, Ord, Show )++marshalQuadricDrawStyle :: QuadricDrawStyle -> GLenum+marshalQuadricDrawStyle x = case x of+   PointStyle -> GLU_POINT+   LineStyle -> GLU_LINE+   FillStyle -> GLU_FILL+   SilhouetteStyle -> GLU_SILHOUETTE++--------------------------------------------------------------------------------++type QuadricNormal = Maybe ShadingModel++marshalQuadricNormal :: QuadricNormal -> GLenum+marshalQuadricNormal (Just Smooth) = GLU_SMOOTH+marshalQuadricNormal (Just Flat  ) = GLU_FLAT+marshalQuadricNormal Nothing       = GLU_NONE++--------------------------------------------------------------------------------++data QuadricOrientation =+     Outside+   | Inside+   deriving ( Eq, Ord, Show )++marshalQuadricOrientation :: QuadricOrientation -> GLenum+marshalQuadricOrientation x = case x of+   Outside -> GLU_OUTSIDE+   Inside -> GLU_INSIDE++--------------------------------------------------------------------------------++data QuadricTexture+   = NoTextureCoordinates+   | GenerateTextureCoordinates+   deriving ( Eq,Ord )++marshalQuadricTexture :: QuadricTexture -> GLboolean+marshalQuadricTexture NoTextureCoordinates       = marshalGLboolean False+marshalQuadricTexture GenerateTextureCoordinates = marshalGLboolean True++--------------------------------------------------------------------------------++data QuadricStyle+   = QuadricStyle QuadricNormal+                  QuadricTexture+                  QuadricOrientation+                  QuadricDrawStyle+   deriving ( Eq,Ord )++--------------------------------------------------------------------------------++type Radius = GLdouble+type Height = GLdouble+type Angle  = GLdouble+type Slices = GLint+type Stacks = GLint+type Loops  = GLint++--------------------------------------------------------------------------------++data QuadricPrimitive+   = Sphere Radius Slices Stacks+   | Cylinder Radius Radius Height Slices Stacks+   | Disk Radius Radius Slices Loops+   | PartialDisk Radius Radius Slices Loops Angle Angle+   deriving ( Eq, Ord )++--------------------------------------------------------------------------------++renderQuadric :: QuadricStyle -> QuadricPrimitive -> IO ()+renderQuadric style prim = do+   withQuadricObj recordOutOfMemory $ \quadricObj ->+      withErrorCallback quadricObj recordErrorCode $ do+         setStyle quadricObj style+         renderPrimitive quadricObj prim++withQuadricObj :: IO a -> (QuadricObj -> IO a) -> IO a+withQuadricObj failure success =+   bracket gluNewQuadric safeDeleteQuadric+           (\quadricObj -> if isNullQuadricObj quadricObj+                              then failure+                              else success quadricObj)++safeDeleteQuadric :: QuadricObj -> IO ()+safeDeleteQuadric quadricObj =+   unless (isNullQuadricObj quadricObj) $ gluDeleteQuadric quadricObj++withErrorCallback :: QuadricObj -> QuadricCallback -> IO a -> IO a+withErrorCallback quadricObj callback action =+   bracket (makeQuadricCallback callback) freeHaskellFunPtr $ \callbackPtr -> do+      gluQuadricCallback quadricObj GLU_ERROR callbackPtr+      action++setStyle :: QuadricObj -> QuadricStyle -> IO ()+setStyle quadricObj (QuadricStyle n t o d) = do+   gluQuadricNormals     quadricObj (marshalQuadricNormal      n)+   gluQuadricTexture     quadricObj (marshalQuadricTexture     t)+   gluQuadricOrientation quadricObj (marshalQuadricOrientation o)+   gluQuadricDrawStyle   quadricObj (marshalQuadricDrawStyle   d)++renderPrimitive :: QuadricObj -> QuadricPrimitive -> IO ()+renderPrimitive quadricObj (Sphere r s n) =+   gluSphere quadricObj r s n+renderPrimitive quadricObj (Cylinder b t h s n) =+   gluCylinder quadricObj b t h s n+renderPrimitive quadricObj (Disk i o s l) =+   gluDisk quadricObj i o s l+renderPrimitive quadricObj (PartialDisk i o s l a w) =+   gluPartialDisk quadricObj i o s l a w++--------------------------------------------------------------------------------++type QuadricObj = Ptr GLUquadric++isNullQuadricObj :: QuadricObj -> Bool+isNullQuadricObj = (nullPtr ==)
+ src/Graphics/Rendering/OpenGL/GLU/Tessellation.hs view
@@ -0,0 +1,521 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Tessellation+-- Copyright   :  (c) Sven Panne 2002-2019+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to chapter 5 (Polygon Tessellation) of the GLU specs.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GLU.Tessellation (+   -- * Polygon description+   AnnotatedVertex(..), ComplexContour(..), ComplexPolygon(..),++   -- * Combining vertices+   WeightedProperties(..), Combiner,++   -- * Tessellation parameters+   TessWinding(..), Tolerance,++   -- * Tessellator type+   Tessellator,++   -- * Contour extraction+   SimpleContour(..), PolygonContours(..), extractContours,++   -- * Triangulation+   TriangleVertex, Triangle(..), Triangulation(..), triangulate,++   -- * Tessellation into primitives+   Primitive(..), SimplePolygon(..), tessellate+) where++import Control.Monad ( foldM_, unless )+import Data.IORef ( newIORef, readIORef, writeIORef, modifyIORef )+import Data.Maybe ( fromJust, fromMaybe )+import Foreign.Marshal.Alloc ( allocaBytes )+import Foreign.Marshal.Array ( peekArray, pokeArray )+import Foreign.Marshal.Pool ( Pool, withPool, pooledNew )+import Foreign.Ptr ( Ptr, nullPtr, plusPtr, castPtr, freeHaskellFunPtr )+import Foreign.Storable ( Storable(..) )+import Graphics.GLU+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.EdgeFlag ( unmarshalEdgeFlag )+import Graphics.Rendering.OpenGL.GL.Exception ( bracket )+import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )+import Graphics.Rendering.OpenGL.GL.PrimitiveMode ( PrimitiveMode )+import Graphics.Rendering.OpenGL.GL.PrimitiveModeInternal ( unmarshalPrimitiveMode )+import Graphics.Rendering.OpenGL.GL.BeginEnd ( EdgeFlag(BeginsInteriorEdge) )+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.GL++--------------------------------------------------------------------------------++data TessWinding =+     TessWindingOdd+   | TessWindingNonzero+   | TessWindingPositive+   | TessWindingNegative+   | TessWindingAbsGeqTwo+   deriving ( Eq, Ord, Show )++marshalTessWinding :: TessWinding -> GLenum+marshalTessWinding x = case x of+   TessWindingOdd -> GLU_TESS_WINDING_ODD+   TessWindingNonzero -> GLU_TESS_WINDING_NONZERO+   TessWindingPositive -> GLU_TESS_WINDING_POSITIVE+   TessWindingNegative -> GLU_TESS_WINDING_NEGATIVE+   TessWindingAbsGeqTwo -> GLU_TESS_WINDING_ABS_GEQ_TWO++--------------------------------------------------------------------------------++-- | The basic building block in tessellation is a 3D vertex with an associated+-- property, e.g. color, texture coordinates, etc.++data AnnotatedVertex v = AnnotatedVertex (Vertex3 GLdouble) v+   deriving ( Eq, Ord )++offsetOfProperty :: Storable v => v -> Int+offsetOfProperty v = alignOffset v (3 * sizeOf x)+   where AnnotatedVertex (Vertex3 x _ _) _ = undefined++alignOffset :: Storable a => a -> Int -> Int+alignOffset x offset = n - (n `mod` a)+   where a = alignment x+         n = a + offset - 1++instance Storable v => Storable (AnnotatedVertex v) where++   sizeOf ~(AnnotatedVertex (Vertex3 x _ _) v) =+      alignOffset x (sizeOf v + offsetOfProperty v)++   alignment ~(AnnotatedVertex (Vertex3 x _ _) _) =+      alignment x++   peek ptr = do+      x <- peekElemOff (castPtr ptr) 0+      y <- peekElemOff (castPtr ptr) 1+      z <- peekElemOff (castPtr ptr) 2+      let dummyElement :: Ptr (AnnotatedVertex v) -> v+          dummyElement = undefined+      v <- peekByteOff (castPtr ptr) (offsetOfProperty (dummyElement ptr))+      return $ AnnotatedVertex (Vertex3 x y z) v++   poke ptr (AnnotatedVertex (Vertex3 x y z) v) = do+      pokeElemOff (castPtr ptr) 0 x+      pokeElemOff (castPtr ptr) 1 y+      pokeElemOff (castPtr ptr) 2 z+      pokeByteOff (castPtr ptr) (offsetOfProperty v) v++--------------------------------------------------------------------------------++-- | A complex contour, which can be self-intersecting and\/or concave.++newtype ComplexContour v = ComplexContour [AnnotatedVertex v]+   deriving ( Eq, Ord )++sizeOfComplexContour :: Storable v => ComplexContour v -> Int+sizeOfComplexContour (ComplexContour vs) =+   length vs * sizeOf (head vs)++pokeComplexContour ::+   Storable v => Ptr (ComplexContour v) -> ComplexContour v -> IO ()+pokeComplexContour ptr (ComplexContour vs) =+   pokeArray (castPtr ptr) vs++--------------------------------------------------------------------------------++-- | A complex (possibly concave) polygon, represented by one or more complex+-- and possibly intersecting contours.++newtype ComplexPolygon v = ComplexPolygon [ComplexContour v]+   deriving ( Eq, Ord )++sizeOfComplexPolygon :: Storable v => ComplexPolygon v -> Int+sizeOfComplexPolygon (ComplexPolygon complexContours) =+   sum (map sizeOfComplexContour complexContours)++pokeComplexPolygon ::+   Storable v => Ptr (ComplexPolygon v) -> ComplexPolygon v -> IO ()+pokeComplexPolygon ptr (ComplexPolygon complexContours) =+   foldM_ pokeAndAdvance (castPtr ptr) complexContours >> return ()+   where pokeAndAdvance p complexContour = do+            pokeComplexContour p complexContour+            return $ p `plusPtr` sizeOfComplexContour complexContour++withComplexPolygon ::+   Storable v => ComplexPolygon v -> (Ptr (ComplexPolygon v) -> IO a) -> IO a+withComplexPolygon complexPolygon f =+   allocaBytes (sizeOfComplexPolygon complexPolygon) $ \ptr -> do+      pokeComplexPolygon ptr complexPolygon+      f ptr++--------------------------------------------------------------------------------++-- | Four vertex properties (cf. 'AnnotatedVertex') with associated weigths+-- summing up to 1.0.++data WeightedProperties v+   = WeightedProperties (GLfloat, v)+                        (GLfloat, v)+                        (GLfloat, v)+                        (GLfloat, v)+   deriving ( Eq, Ord )++-- | A function combining given vertex properties into a property for a newly+-- generated vertex++type Combiner v+    = Vertex3 GLdouble+   -> WeightedProperties v+   -> v++--------------------------------------------------------------------------------++-- | The relative tolerance under which two vertices can be combined (see+-- 'Combiner'). Multiplication with the largest coordinate magnitude of all+-- polygon vertices yields the maximum distance between two mergeable vertices.+--+-- Note that merging is optional and the tolerance is only a hint.++type Tolerance = GLdouble++--------------------------------------------------------------------------------++-- | A general tessellator type.+--+-- Before tessellation of a complex polygon, all its vertices are projected into+-- a plane perpendicular to the given normal. If the given normal is+-- @Normal3 0 0 0@, a fitting plane of all vertices is used.++type Tessellator p v+   = TessWinding+  -> Tolerance+  -> Normal3 GLdouble+  -> Combiner v+  -> ComplexPolygon v+  -> IO (p v)++--------------------------------------------------------------------------------++-- | A simple, non-self-intersecting contour++newtype SimpleContour v = SimpleContour [AnnotatedVertex v]+   deriving ( Eq, Ord )++-- | The contours of a complex polygon, represented by one or more+-- non-intersecting simple contours++newtype PolygonContours v = PolygonContours [SimpleContour v]+   deriving ( Eq, Ord )++extractContours :: Storable v => Tessellator PolygonContours v+extractContours windingRule tolerance theNormal combiner complexPoly = do++   vertices <- newIORef []+   let addVertex v = modifyIORef vertices (v:)++   contours <- newIORef []+   let finishContour = do+          vs <- readIORef vertices+          writeIORef vertices []+          modifyIORef contours (SimpleContour (reverse vs) :)++       getContours = fmap (PolygonContours . reverse) (readIORef contours)++   withTessellatorObj (PolygonContours [])$ \tessObj -> do+      setTessellatorProperties tessObj windingRule tolerance theNormal True+      withVertexCallback tessObj addVertex $+         withEndCallback tessObj finishContour $+            checkForError tessObj $+               withCombineCallback tessObj combiner $ do+                  defineComplexPolygon tessObj complexPoly+                  getContours++--------------------------------------------------------------------------------++-- | A triangle vertex with additional information about the edge it begins++type TriangleVertex v = AnnotatedVertex (v,EdgeFlag)++-- | A triangle, represented by three triangle vertices++data Triangle v+   = Triangle (TriangleVertex v) (TriangleVertex v) (TriangleVertex v)+   deriving ( Eq, Ord )++-- | A triangulation of a complex polygon++newtype Triangulation v = Triangulation [Triangle v]+   deriving ( Eq, Ord )++triangulate :: Storable v => Tessellator Triangulation v+triangulate windingRule tolerance theNormal combiner complexPoly = do++   edgeFlagState <- newIORef BeginsInteriorEdge+   let registerEdgeFlag = writeIORef edgeFlagState++   vertices <- newIORef []+   let addVertex (AnnotatedVertex xyz v) = do+          ef <- readIORef edgeFlagState+          modifyIORef vertices (AnnotatedVertex xyz (v,ef) :)++       getTriangulation = do+          vs <- readIORef vertices+          return $ Triangulation (collectTriangles (reverse vs))++   withTessellatorObj (Triangulation []) $ \tessObj -> do+      setTessellatorProperties tessObj windingRule tolerance theNormal False+      withEdgeFlagCallback tessObj registerEdgeFlag $+         withVertexCallback tessObj addVertex $+            checkForError tessObj $+               withCombineCallback tessObj combiner $ do+                  defineComplexPolygon tessObj complexPoly+                  getTriangulation++collectTriangles :: [TriangleVertex v] -> [Triangle v]+collectTriangles []           = []+collectTriangles (a:b:c:rest) = Triangle a b c : collectTriangles rest+collectTriangles _            = error "triangles left"++--------------------------------------------------------------------------------++data Primitive v = Primitive PrimitiveMode [AnnotatedVertex v]+   deriving ( Eq, Ord )++newtype SimplePolygon v = SimplePolygon [Primitive v]+   deriving ( Eq, Ord )++tessellate :: Storable v => Tessellator SimplePolygon v+tessellate windingRule tolerance theNormal combiner complexPoly = do++   beginModeState <- newIORef undefined+   let setPrimitiveMode = writeIORef beginModeState++   vertices <- newIORef []+   let addVertex v = modifyIORef vertices (v:)++   primitives <- newIORef []+   let finishPrimitive = do+          beginMode <- readIORef beginModeState+          vs <- readIORef vertices+          writeIORef vertices []+          modifyIORef primitives (Primitive beginMode (reverse vs) :)++       getSimplePolygon = fmap (SimplePolygon . reverse) (readIORef primitives)++   withTessellatorObj (SimplePolygon []) $ \tessObj -> do+      setTessellatorProperties tessObj windingRule tolerance theNormal False+      withBeginCallback tessObj setPrimitiveMode $+         withVertexCallback tessObj addVertex $+            withEndCallback tessObj finishPrimitive $+               checkForError tessObj $+                  withCombineCallback tessObj combiner $ do+                     defineComplexPolygon tessObj complexPoly+                     getSimplePolygon++--------------------------------------------------------------------------------+-- chapter 5.1: The Tessellation Object++-- an opaque pointer to a tessellator object+type TessellatorObj = Ptr GLUtesselator++isNullTesselatorObj :: TessellatorObj -> Bool+isNullTesselatorObj = (nullPtr ==)++withTessellatorObj :: a -> (TessellatorObj -> IO a) -> IO a+withTessellatorObj failureValue action =+   bracket gluNewTess safeDeleteTess+           (\tessObj -> if isNullTesselatorObj tessObj+                           then do recordOutOfMemory+                                   return failureValue+                           else action tessObj)++safeDeleteTess :: TessellatorObj -> IO ()+safeDeleteTess tessObj =+   unless (isNullTesselatorObj tessObj) $ gluDeleteTess tessObj++--------------------------------------------------------------------------------+-- chapter 5.2: Polygon Definition (polygons)++defineComplexPolygon ::+   Storable v => TessellatorObj -> ComplexPolygon v -> IO ()+defineComplexPolygon tessObj cp@(ComplexPolygon complexContours) =+   withComplexPolygon cp $ \ptr ->+      tessBeginEndPolygon tessObj nullPtr $+         let loop _ []     = return ()+             loop p (c:cs) = do defineComplexContour tessObj (castPtr p) c+                                loop (p `plusPtr` sizeOfComplexContour c) cs+         in loop ptr complexContours++tessBeginEndPolygon :: TessellatorObj -> Ptr p -> IO a -> IO a+tessBeginEndPolygon tessObj ptr f = do+   gluTessBeginPolygon tessObj ptr+   res <- f+   gluTessEndPolygon tessObj+   return res++--------------------------------------------------------------------------------+-- chapter 5.2: Polygon Definition (contours)++defineComplexContour ::+   Storable v =>+   TessellatorObj -> Ptr (ComplexContour v) -> ComplexContour v -> IO ()+defineComplexContour tessObj ptr (ComplexContour annotatedVertices) =+   tessBeginEndContour tessObj $+         let loop _ []     = return ()+             loop p (v:vs) = do defineVertex tessObj (castPtr p)+                                loop (p `plusPtr` sizeOf v) vs+         in loop ptr annotatedVertices++tessBeginEndContour :: TessellatorObj -> IO a -> IO a+tessBeginEndContour tessObj f = do+   gluTessBeginContour tessObj+   res <- f+   gluTessEndContour tessObj+   return res++--------------------------------------------------------------------------------+-- chapter 5.2: Polygon Definition (vertices)++defineVertex :: TessellatorObj -> Ptr (AnnotatedVertex v) -> IO ()+defineVertex tessObj ptr = gluTessVertex tessObj (castPtr ptr) ptr++--------------------------------------------------------------------------------+-- chapter 5.3: Callbacks (begin)++type BeginCallback  = PrimitiveMode -> IO ()++withBeginCallback :: TessellatorObj -> BeginCallback -> IO a -> IO a+withBeginCallback tessObj beginCallback action =+   bracket (makeTessBeginCallback (beginCallback . unmarshalPrimitiveMode))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluTessCallback tessObj GLU_TESS_BEGIN callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 5.3: Callbacks (edgeFlag)++type EdgeFlagCallback  = EdgeFlag -> IO ()++withEdgeFlagCallback :: TessellatorObj -> EdgeFlagCallback -> IO a -> IO a+withEdgeFlagCallback tessObj edgeFlagCallback action =+   bracket (makeTessEdgeFlagCallback (edgeFlagCallback . unmarshalEdgeFlag))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluTessCallback tessObj GLU_TESS_EDGE_FLAG callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 5.3: Callbacks (vertex)++type VertexCallback v = AnnotatedVertex v -> IO ()++withVertexCallback ::+   Storable v => TessellatorObj -> VertexCallback v -> IO a -> IO a+withVertexCallback tessObj vertexCallback action =+   bracket (makeTessVertexCallback (\p -> peek p >>= vertexCallback))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluTessCallback tessObj GLU_TESS_VERTEX callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 5.3: Callbacks (end)++type EndCallback  = IO ()++withEndCallback :: TessellatorObj -> EndCallback -> IO a -> IO a+withEndCallback tessObj endCallback action =+   bracket (makeTessEndCallback endCallback) freeHaskellFunPtr $ \callbackPtr -> do+      gluTessCallback tessObj GLU_TESS_END callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 5.3: Callbacks (error)++type ErrorCallback = GLenum -> IO ()++withErrorCallback :: TessellatorObj -> ErrorCallback -> IO a -> IO a+withErrorCallback tessObj errorCallback action =+   bracket (makeTessErrorCallback errorCallback)+           freeHaskellFunPtr $ \callbackPtr -> do+      gluTessCallback tessObj GLU_TESS_ERROR callbackPtr+      action++checkForError :: TessellatorObj -> IO a -> IO a+checkForError tessObj = withErrorCallback tessObj recordErrorCode++--------------------------------------------------------------------------------+-- chapter 5.3: Callbacks (combine)++type CombineCallback v =+      Ptr GLdouble+   -> Ptr (Ptr (AnnotatedVertex v))+   -> Ptr GLfloat+   -> Ptr (Ptr (AnnotatedVertex v))+   -> IO ()++withCombineCallback ::+   Storable v => TessellatorObj -> Combiner v -> IO a -> IO a+withCombineCallback tessObj combiner action =+   withPool $ \vertexPool ->+      bracket (makeTessCombineCallback (combineProperties vertexPool combiner))+              freeHaskellFunPtr $ \callbackPtr -> do+         gluTessCallback tessObj GLU_TESS_COMBINE callbackPtr+         action++-- NOTE: SGI's tesselator has a bug, sometimes passing NULL for the last two+-- vertices instead of valid vertex data, so we have to work around this. We+-- just pass the first vertex in these cases, which is OK, because the+-- corresponding weight is 0.+combineProperties :: Storable v => Pool -> Combiner v -> CombineCallback v+combineProperties pool combiner newVertexPtr propertyPtrs weights result = do+   newVertex <- peek (castPtr newVertexPtr :: Ptr (Vertex3 GLdouble))+   [v0, v1, v2, v3] <- mapM (getProperty propertyPtrs) [0..3]+   [w0, w1, w2, w3] <- peekArray 4 weights+   let defaultProperty = fromJust v0+       f = fromMaybe defaultProperty+       wp = WeightedProperties (w0, f v0) (w1, f v1) (w2, f v2) (w3, f v3)+       av = AnnotatedVertex newVertex (combiner newVertex wp)+   poke result =<< pooledNew pool av++getProperty :: Storable v => Ptr (Ptr (AnnotatedVertex v)) -> Int -> IO (Maybe v)+getProperty propertyPtrs n = peekElemOff propertyPtrs n >>=+                             maybeNullPtr (return Nothing) peekProperty++peekProperty :: Storable v => Ptr (AnnotatedVertex v) -> IO (Maybe v)+peekProperty ptr = do+   AnnotatedVertex _ v <- peek ptr+   return (Just v)++--------------------------------------------------------------------------------+-- chapter 5.4: Control over Tessellation++setTessellatorProperties ::+    TessellatorObj -> TessWinding -> Tolerance -> Normal3 GLdouble -> Bool+ -> IO ()+setTessellatorProperties tessObj windingRule tolerance theNormal boundaryOnly = do+   setWindingRule tessObj windingRule+   setTolerance tessObj tolerance+   setNormal tessObj theNormal+   setBoundaryOnly tessObj boundaryOnly++setWindingRule :: TessellatorObj -> TessWinding -> IO ()+setWindingRule tessObj =+   gluTessProperty tessObj GLU_TESS_WINDING_RULE . fromIntegral . marshalTessWinding++setBoundaryOnly :: TessellatorObj -> Bool -> IO ()+setBoundaryOnly tessObj =+   gluTessProperty tessObj GLU_TESS_BOUNDARY_ONLY . marshalGLboolean++setTolerance :: TessellatorObj -> Tolerance -> IO ()+setTolerance tessObj = gluTessProperty tessObj GLU_TESS_TOLERANCE++setNormal :: TessellatorObj -> Normal3 GLdouble -> IO ()+setNormal tessObj (Normal3 x y z) = gluTessNormal tessObj x y z