packages feed

OpenGL 2.2.3.1 → 3.0.3.0

raw patch · 222 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,95 +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.GL.BasicTypes,-   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 Graphics.Rendering.OpenGL.GL.StateVar,-   module Graphics.Rendering.OpenGL.GL.StringQueries,-   module Graphics.Rendering.OpenGL.GL.SavingState-) where--import Graphics.Rendering.OpenGL.GL.BasicTypes-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 Graphics.Rendering.OpenGL.GL.StateVar-import Graphics.Rendering.OpenGL.GL.StringQueries-import Graphics.Rendering.OpenGL.GL.SavingState
− Graphics/Rendering/OpenGL/GL/Antialiasing.hs 
@@ -1,43 +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 Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapMultisample), makeCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLsizei, Capability )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetSampleBuffers,GetSamples,GetSubpixelBits), getSizei1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar )------------------------------------------------------------------------------------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/BasicTypes.hs 
@@ -1,110 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.BasicTypes--- 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.3 (GL Command Sytax) of the OpenGL 2.1--- specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLbyte, GLubyte, GLchar, GLshort, GLushort, GLint, GLuint,-   GLsizei, GLenum, GLintptr, GLsizeiptr, GLbitfield, GLfloat, GLclampf,-   GLdouble, GLclampd, Capability(..)-) where------------------------------------------------------------------------------------#include "HsOpenGLConfig.h"------------------------------------------------------------------------------------import Data.Int-import Data.Word---- If we don't find modern OpenGL headers at configuration time, make some--- educated guesses here.--#if !defined(HTYPE_GLCHAR) || !defined(HTYPE_GLINTPTR) || !defined(HTYPE_GLSIZEIPTR)-import Foreign.C.Types-#endif--#if !defined(HTYPE_GLCHAR)-#define HTYPE_GLCHAR CChar-#endif--#if !defined(HTYPE_GLINTPTR)-#define HTYPE_GLINTPTR CPtrdiff-#endif--#if !defined(HTYPE_GLSIZEIPTR)-#define HTYPE_GLSIZEIPTR CPtrdiff-#endif-------------------------------------------------------------------------------------- | Boolean (min. 1 bit)-type GLboolean = HTYPE_GLBOOLEAN---- | Signed 2\'s complement binary integer (min. 8 bits)-type GLbyte = HTYPE_GLBYTE---- | Unsigned binary integer (min. 8 bits)-type GLubyte = HTYPE_GLUBYTE---- | Characters making up strings-type GLchar = HTYPE_GLCHAR---- | Signed 2\'s complement binary integer (min. 16 bits)-type GLshort = HTYPE_GLSHORT---- | Unsigned binary integer (min. 16 bits)-type GLushort = HTYPE_GLUSHORT---- | Signed 2\'s complement binary integer (min. 32 bits)-type GLint = HTYPE_GLINT---- | Unsigned binary integer (min. 32 bits)-type GLuint = HTYPE_GLUINT---- | Non-negatitve binary integer size (min. 32 bits)-type GLsizei = HTYPE_GLSIZEI---- | Enumerated binary integer value (min. 32 bits)-type GLenum = HTYPE_GLENUM---- | Signed 2\'s complement binary integer (sufficiently large enough to hold--- any address)-type GLintptr = HTYPE_GLINTPTR---- | Non-negatitve binary integer size (sufficiently large enough to hold any--- address)-type GLsizeiptr = HTYPE_GLSIZEIPTR---- | Bit field (min. 32 bits)-type GLbitfield = HTYPE_GLBITFIELD---- | Floating-point value (min. 32 bits)-type GLfloat = HTYPE_GLFLOAT---- | Floating-point value clamped to [0,1] (min. 32 bits)-type GLclampf = HTYPE_GLCLAMPF---- | Floating-point value (min. 64 bits)-type GLdouble = HTYPE_GLDOUBLE---- | Floating-point value clamped to [0,1] (min. 64 bits)-type GLclampd = HTYPE_GLCLAMPD------------------------------------------------------------------------------------data Capability =-     Disabled-   | Enabled-   deriving ( Eq, Ord, Show )
− Graphics/Rendering/OpenGL/GL/BeginEnd.hs 
@@ -1,146 +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 Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLboolean )-import Graphics.Rendering.OpenGL.GL.EdgeFlag (-   EdgeFlag(..), marshalEdgeFlag, unmarshalEdgeFlag )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket_, unsafeBracket_ )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PrimitiveMode (-   PrimitiveMode(..), marshalPrimitiveMode )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   getBoolean1, GetPName(GetEdgeFlag) )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-------------------------------------------------------------------------------------- | 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--foreign import CALLCONV unsafe "glBegin" glBegin :: GLenum -> IO ()--foreign import CALLCONV unsafe "glEnd" glEnd :: IO ()------------------------------------------------------------------------------------primitiveRestart :: IO ()-primitiveRestart = glPrimitiveRestartNV--EXTENSION_ENTRY("GL_NV_primitive_restart",glPrimitiveRestartNV,IO ())-------------------------------------------------------------------------------------- | 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)--foreign import CALLCONV unsafe "glEdgeFlag" glEdgeFlag :: GLboolean -> IO ()
− Graphics/Rendering/OpenGL/GL/Bitmaps.hs 
@@ -1,32 +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 Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLsizei, GLfloat )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..), Vector2(..) )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Vertex2(..) )------------------------------------------------------------------------------------bitmap :: Size -> (Vertex2 GLfloat) -> (Vector2 GLfloat) -> Ptr a -> IO ()-bitmap (Size w h) (Vertex2 xbo ybo) (Vector2 xbi ybi) =-   glBitmap w h xbo ybo xbi ybi--foreign import CALLCONV unsafe "glBitmap"-   glBitmap :: GLsizei -> GLsizei -> GLfloat -> GLfloat -> GLfloat -> GLfloat-            -> Ptr a -> IO ()
− 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.GL.BasicTypes ( GLenum )------------------------------------------------------------------------------------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 -> 0x0-   One -> 0x1-   SrcColor -> 0x300-   OneMinusSrcColor -> 0x301-   DstColor -> 0x306-   OneMinusDstColor -> 0x307-   SrcAlpha -> 0x302-   OneMinusSrcAlpha -> 0x303-   DstAlpha -> 0x304-   OneMinusDstAlpha -> 0x305-   ConstantColor -> 0x8001-   OneMinusConstantColor -> 0x8002-   ConstantAlpha -> 0x8003-   OneMinusConstantAlpha -> 0x8004-   SrcAlphaSaturate -> 0x308--unmarshalBlendingFactor :: GLenum -> BlendingFactor-unmarshalBlendingFactor x-   | x == 0x0 = Zero-   | x == 0x1 = One-   | x == 0x300 = SrcColor-   | x == 0x301 = OneMinusSrcColor-   | x == 0x306 = DstColor-   | x == 0x307 = OneMinusDstColor-   | x == 0x302 = SrcAlpha-   | x == 0x303 = OneMinusSrcAlpha-   | x == 0x304 = DstAlpha-   | x == 0x305 = OneMinusDstAlpha-   | x == 0x8001 = ConstantColor-   | x == 0x8002 = OneMinusConstantColor-   | x == 0x8003 = ConstantAlpha-   | x == 0x8004 = OneMinusConstantAlpha-   | x == 0x308 = SrcAlphaSaturate-   | otherwise = error ("unmarshalBlendingFactor: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/BufferMode.hs 
@@ -1,93 +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.GL.BasicTypes ( GLenum, GLsizei )-------------------------------------------------------------------------------------- | 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 0x0-   FrontLeftBuffer -> Just 0x400-   FrontRightBuffer -> Just 0x401-   BackLeftBuffer -> Just 0x402-   BackRightBuffer -> Just 0x403-   FrontBuffers -> Just 0x404-   BackBuffers -> Just 0x405-   LeftBuffers -> Just 0x406-   RightBuffers -> Just 0x407-   FrontAndBackBuffers -> Just 0x408-   AuxBuffer i-      | i <= 246  -> Just (0x409 + fromIntegral i)-      | otherwise -> Nothing--unmarshalBufferMode :: GLenum -> BufferMode-unmarshalBufferMode x-   | x == 0x0 = NoBuffers-   | x == 0x400 = FrontLeftBuffer-   | x == 0x401 = FrontRightBuffer-   | x == 0x402 = BackLeftBuffer-   | x == 0x403 = BackRightBuffer-   | x == 0x404 = FrontBuffers-   | x == 0x405 = BackBuffers-   | x == 0x406 = LeftBuffers-   | x == 0x407 = RightBuffers-   | x == 0x408 = FrontAndBackBuffers-   | 0x409 <= x && x <= 0x4ff = AuxBuffer (fromIntegral x - 0x409)-   | otherwise = error ("unmarshalBufferMode: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/BufferObjects.hs 
@@ -1,344 +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-   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 Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( withArrayLen, peekArray, allocaArray )-import Foreign.Ptr ( Ptr )-import Foreign.Storable ( Storable(peek) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLenum, GLint, GLintptr, GLuint, GLsizei, GLsizeiptr )-import Graphics.Rendering.OpenGL.GL.Exception ( finallyRet )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetArrayBufferBinding,GetElementArrayBufferBinding,-            GetVertexArrayBufferBinding,GetNormalArrayBufferBinding,-            GetColorArrayBufferBinding,GetIndexArrayBufferBinding,-            GetTextureCoordArrayBufferBinding,GetEdgeFlagArrayBufferBinding,-            GetFogCoordArrayBufferBinding,GetSecondaryColorArrayBufferBinding,-            GetPixelPackBufferBinding,GetPixelUnpackBufferBinding,-            GetCopyReadBuffer,GetCopyWriteBuffer),-   getInteger1, maybeNullPtr,-   GetVertexAttribPName(GetVertexAttribArrayBufferBinding), getVertexAttribInteger1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexArrays ( ClientArrayType(..) )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( AttribLocation )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidEnum )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-------------------------------------------------------------------------------------- | An 'ObjectName' corresponds to the general OpenGL notion of an explicitly--- handled object name, e.g. a display list name, a texture object name, a--- buffer object name, etc.--class ObjectName a where-   genObjectNames :: Int -> IO [a]-   deleteObjectNames:: [a] -> IO ()-   isObjectName :: a -> IO Bool------------------------------------------------------------------------------------newtype BufferObject = BufferObject { bufferID :: GLuint }-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------instance ObjectName BufferObject where-   genObjectNames n =-      allocaArray n $ \buf -> do-        glGenBuffersARB (fromIntegral n) buf-        fmap (map BufferObject) $ peekArray n buf--   deleteObjectNames bufferObjects =-      withArrayLen (map bufferID bufferObjects) $-         glDeleteBuffersARB . fromIntegral--   isObjectName = fmap unmarshalGLboolean . glIsBufferARB . bufferID--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glGenBuffersARB,GLsizei -> Ptr GLuint -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glDeleteBuffersARB,GLsizei -> Ptr GLuint -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glIsBufferARB,GLuint -> IO GLboolean)------------------------------------------------------------------------------------data BufferTarget =-     ArrayBuffer-   | CopyReadBuffer-   | CopyWriteBuffer-   | ElementArrayBuffer-   | PixelPackBuffer-   | PixelUnpackBuffer-   deriving ( Eq, Ord, Show )--marshalBufferTarget :: BufferTarget -> GLenum-marshalBufferTarget x = case x of-   ArrayBuffer -> 0x8892-   CopyReadBuffer -> 0x8F36-   CopyWriteBuffer -> 0x8F37-   ElementArrayBuffer -> 0x8893-   PixelPackBuffer -> 0x88eb-   PixelUnpackBuffer -> 0x88ec--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 -> 0x88e0-   StreamRead -> 0x88e1-   StreamCopy -> 0x88e2-   StaticDraw -> 0x88e4-   StaticRead -> 0x88e5-   StaticCopy -> 0x88e6-   DynamicDraw -> 0x88e8-   DynamicRead -> 0x88e9-   DynamicCopy -> 0x88ea--unmarshalBufferUsage :: GLenum -> BufferUsage-unmarshalBufferUsage x-   | x == 0x88e0 = StreamDraw-   | x == 0x88e1 = StreamRead-   | x == 0x88e2 = StreamCopy-   | x == 0x88e4 = StaticDraw-   | x == 0x88e5 = StaticRead-   | x == 0x88e6 = StaticCopy-   | x == 0x88e8 = DynamicDraw-   | x == 0x88e9 = DynamicRead-   | x == 0x88ea = 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 -> 0x88b8-   WriteOnly -> 0x88b9-   ReadWrite -> 0x88ba--unmarshalBufferAccess :: GLenum -> BufferAccess-unmarshalBufferAccess x-   | x == 0x88b8 = ReadOnly-   | x == 0x88b9 = WriteOnly-   | x == 0x88ba = 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 =-   glBindBufferARB (marshalBufferTarget t) . bufferID . maybe noBufferObject id--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glBindBufferARB,GLenum -> GLuint -> IO ())--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) =-   glBufferDataARB (marshalBufferTarget t) s p (marshalBufferUsage u)--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glBufferDataARB,GLenum -> GLsizeiptr -> Ptr a -> GLenum -> IO ())------------------------------------------------------------------------------------data TransferDirection =-     ReadFromBuffer-   | WriteToBuffer-   deriving ( Eq, Ord, Show )--bufferSubData ::-   BufferTarget -> TransferDirection -> GLintptr -> GLsizeiptr -> Ptr a -> IO ()-bufferSubData t WriteToBuffer = glBufferSubDataARB (marshalBufferTarget t)-bufferSubData t ReadFromBuffer = glGetBufferSubDataARB (marshalBufferTarget t)--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glBufferSubDataARB,GLenum -> GLintptr -> GLsizeiptr -> Ptr a -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glGetBufferSubDataARB,GLenum -> GLintptr -> GLsizeiptr -> Ptr a -> IO ())------------------------------------------------------------------------------------data GetBufferPName =-     GetBufferSize-   | GetBufferUsage-   | GetBufferAccess-   | GetBufferMapped--marshalGetBufferPName :: GetBufferPName -> GLenum-marshalGetBufferPName x = case x of-   GetBufferSize -> 0x8764-   GetBufferUsage -> 0x8765-   GetBufferAccess -> 0x88bb-   GetBufferMapped -> 0x88bc--getBufferParameter :: BufferTarget -> (GLenum -> a) -> GetBufferPName -> IO a-getBufferParameter t f p = alloca $ \buf -> do-   glGetBufferParameterivARB (marshalBufferTarget t)-                             (marshalGetBufferPName p) buf-   peek1 (f . fromIntegral) buf--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glGetBufferParameterivARB,GLenum -> GLenum -> Ptr GLint -> IO ())------------------------------------------------------------------------------------getBufferPointer :: BufferTarget -> IO (Ptr a)-getBufferPointer t = alloca $ \buf -> do-   -- only one pname: GL_BUFFER_MAP_POINTER-   glGetBufferPointervARB (marshalBufferTarget t) 0x88bd buf-   peek buf--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glGetBufferPointervARB,GLenum -> GLenum -> Ptr (Ptr a) -> IO ())------------------------------------------------------------------------------------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 = glMapBufferARB (marshalBufferTarget t) . marshalBufferAccess--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glMapBufferARB,GLenum -> GLenum -> IO (Ptr a))--unmapBuffer :: BufferTarget -> IO Bool-unmapBuffer = fmap unmarshalGLboolean . glUnmapBufferARB . marshalBufferTarget--EXTENSION_ENTRY("GL_ARB_vertex_buffer_object or OpenGL 1.5",glUnmapBufferARB,GLenum -> IO GLboolean)--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,269 +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 (-   marshalCapability, unmarshalCapability,-   EnableCap(..), makeCapability, makeStateVarMaybe-) where--import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLenum, GLsizei, Capability(..) )-import Graphics.Rendering.OpenGL.GL.GLboolean (-   marshalGLboolean, unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   clipPlaneIndexToEnum, lightIndexToEnum )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), HasSetter(($=)), StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidEnum )------------------------------------------------------------------------------------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 -- NOTE: client state!-   | CapPointSprite-   | CapStencilTestTwoSide-   | CapRasterPositionUnclipped-   | CapTextureColorTable-   | CapVertexProgramPointSize-   | CapVertexProgramTwoSide--marshalEnableCap :: EnableCap -> Maybe GLenum-marshalEnableCap x = case x of-   CapFog -> Just 0xb60-   CapLighting -> Just 0xb50-   CapTexture1D -> Just 0xde0-   CapTexture2D -> Just 0xde1-   CapTextureRectangle -> Just 0x84F5-   CapLineStipple -> Just 0xb24-   CapPolygonStipple -> Just 0xb42-   CapCullFace -> Just 0xb44-   CapAlphaTest -> Just 0xbc0-   CapBlend -> Just 0xbe2-   CapIndexLogicOp -> Just 0xbf1-   CapColorLogicOp -> Just 0xbf2-   CapDither -> Just 0xbd0-   CapStencilTest -> Just 0xb90-   CapDepthTest -> Just 0xb71-   CapClipPlane i -> clipPlaneIndexToEnum i-   CapLight i -> lightIndexToEnum i-   CapTextureGenS -> Just 0xc60-   CapTextureGenT -> Just 0xc61-   CapTextureGenR -> Just 0xc62-   CapTextureGenQ -> Just 0xc63-   CapMap1Vertex3 -> Just 0xd97-   CapMap1Vertex4 -> Just 0xd98-   CapMap1Color4 -> Just 0xd90-   CapMap1Index -> Just 0xd91-   CapMap1Normal -> Just 0xd92-   CapMap1TextureCoord1 -> Just 0xd93-   CapMap1TextureCoord2 -> Just 0xd94-   CapMap1TextureCoord3 -> Just 0xd95-   CapMap1TextureCoord4 -> Just 0xd96-   CapMap2Vertex3 -> Just 0xdb7-   CapMap2Vertex4 -> Just 0xdb8-   CapMap2Color4 -> Just 0xdb0-   CapMap2Index -> Just 0xdb1-   CapMap2Normal -> Just 0xdb2-   CapMap2TextureCoord1 -> Just 0xdb3-   CapMap2TextureCoord2 -> Just 0xdb4-   CapMap2TextureCoord3 -> Just 0xdb5-   CapMap2TextureCoord4 -> Just 0xdb6-   CapPointSmooth -> Just 0xb10-   CapLineSmooth -> Just 0xb20-   CapPolygonSmooth -> Just 0xb41-   CapScissorTest -> Just 0xc11-   CapColorMaterial -> Just 0xb57-   CapNormalize -> Just 0xba1-   CapAutoNormal -> Just 0xd80-   CapPolygonOffsetPoint -> Just 0x2a01-   CapPolygonOffsetLine -> Just 0x2a02-   CapPolygonOffsetFill -> Just 0x8037-   CapVertexArray -> Just 0x8074-   CapNormalArray -> Just 0x8075-   CapColorArray -> Just 0x8076-   CapIndexArray -> Just 0x8077-   CapTextureCoordArray -> Just 0x8078-   CapEdgeFlagArray -> Just 0x8079-   CapFogCoordArray -> Just 0x8457-   CapSecondaryColorArray -> Just 0x845e-   CapMatrixIndexArray -> Just 0x8844-   CapConvolution1D -> Just 0x8010-   CapConvolution2D -> Just 0x8011-   CapSeparable2D -> Just 0x8012-   CapHistogram -> Just 0x8024-   CapMinmax -> Just 0x802e-   CapRescaleNormal -> Just 0x803a-   CapSharedTexturePalette -> Just 0x81fb-   CapTexture3D -> Just 0x806f-   CapMultisample -> Just 0x809d-   CapSampleAlphaToCoverage -> Just 0x809e-   CapSampleAlphaToOne -> Just 0x809f-   CapSampleCoverage -> Just 0x80a0-   CapColorTable -> Just 0x80d0-   CapPostConvolutionColorTable -> Just 0x80d1-   CapPostColorMatrixColorTable -> Just 0x80d2-   CapColorSum -> Just 0x8458-   CapTextureCubeMap -> Just 0x8513-   CapWeightSumUnity -> Just 0x86a6-   CapVertexBlend -> Just 0x86a7-   CapWeightArray -> Just 0x86ad-   CapMatrixPalette -> Just 0x8840-   CapDepthClamp -> Just 0x864f-   CapDepthBoundsTest -> Just 0x8890-   CapPrimitiveRestart -> Just 0x8558-   CapPointSprite -> Just 0x8861-   CapStencilTestTwoSide -> Just 0x8910-   CapRasterPositionUnclipped -> Just 0x19262-   CapTextureColorTable -> Just 0x80bc-   CapVertexProgramPointSize -> Just 0x8642-   CapVertexProgramTwoSide -> Just 0x8643------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glIsEnabled" glIsEnabled ::-   GLenum -> IO GLboolean------------------------------------------------------------------------------------enable :: EnableCap -> Capability -> IO ()-enable cap state = maybe recordInvalidEnum (f state) (marshalEnableCap cap)-   where f Disabled = glDisable-         f Enabled  = glEnable--foreign import CALLCONV unsafe "glDisable" glDisable :: GLenum -> IO ()--foreign import CALLCONV unsafe "glEnable" glEnable :: GLenum -> IO ()------------------------------------------------------------------------------------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,57 +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 Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Utils ( with )-import Foreign.Ptr ( Ptr, castPtr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLsizei, GLdouble )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapClipPlane), makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Plane(..) )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetClipPlane,GetMaxClipPlanes),-   clipPlaneIndexToEnum, getDoublev, getSizei1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidEnum )------------------------------------------------------------------------------------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))--foreign import CALLCONV unsafe "glClipPlane" glClipPlane ::-   GLenum -> Ptr (Plane GLdouble) -> IO ()------------------------------------------------------------------------------------maxClipPlanes :: GettableStateVar GLsizei-maxClipPlanes = makeGettableStateVar (getSizei1 id GetMaxClipPlanes)
− Graphics/Rendering/OpenGL/GL/ColorSum.hs 
@@ -1,27 +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 Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapColorSum), makeCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( Capability )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar )------------------------------------------------------------------------------------colorSum :: StateVar Capability-colorSum = makeCapability CapColorSum
− Graphics/Rendering/OpenGL/GL/Colors.hs 
@@ -1,497 +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 ( liftM2, liftM3 )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( allocaArray, withArray )-import Foreign.Marshal.Utils ( with )-import Foreign.Ptr ( Ptr )-import Foreign.Storable ( Storable(peek) )-import Graphics.Rendering.OpenGL.GL.Capability (-   marshalCapability, unmarshalCapability,-   EnableCap(CapVertexProgramTwoSide,CapLighting,CapColorMaterial,CapLight),-   makeCapability,-   makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLsizei, GLfloat,Capability )-import Graphics.Rendering.OpenGL.GL.Face (-   Face(..), marshalFace, unmarshalFace )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek3 )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetMaxLights, GetFrontFace,GetShadeModel,-            GetLightModelAmbient, GetLightModelLocalViewer,-            GetLightModelTwoSide, GetLightModelColorControl,-            GetColorMaterialFace,GetColorMaterialParameter,-            GetMaxShininess,GetMaxSpotExponent),-   getBoolean1, getEnum1, getSizei1, getFloat1, getFloat4, lightIndexToEnum )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), HasSetter(($=)),-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   Color4(..), Normal3(..), Vertex4(..), Index1(..) )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidEnum )------------------------------------------------------------------------------------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 -> 0x900-   CCW -> 0x901--unmarshalFrontFaceDirection :: GLenum -> FrontFaceDirection-unmarshalFrontFaceDirection x-   | x == 0x900 = CW-   | x == 0x901 = CCW-   | otherwise = error ("unmarshalFrontFaceDirection: illegal value " ++ show x)------------------------------------------------------------------------------------frontFace :: StateVar FrontFaceDirection-frontFace =-   makeStateVar-      (getEnum1 unmarshalFrontFaceDirection GetFrontFace)-      (glFrontFace . marshalFrontFaceDirection)--foreign import CALLCONV unsafe "glFrontFace" glFrontFace :: GLenum -> IO ()------------------------------------------------------------------------------------data MaterialParameter =-     MaterialEmission-   | MaterialShininess-   | MaterialAmbientAndDiffuse-   | MaterialColorIndexes-   | MaterialAmbient-   | MaterialDiffuse-   | MaterialSpecular--marshalMaterialParameter :: MaterialParameter -> GLenum-marshalMaterialParameter x = case x of-   MaterialEmission -> 0x1600-   MaterialShininess -> 0x1601-   MaterialAmbientAndDiffuse -> 0x1602-   MaterialColorIndexes -> 0x1603-   MaterialAmbient -> 0x1200-   MaterialDiffuse -> 0x1201-   MaterialSpecular -> 0x1202------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetMaterialfv" glGetMaterialfvc ::-   GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()--foreign import CALLCONV unsafe "glMaterialfv" glMaterialfvc ::-   GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------materialShininess :: Face -> StateVar GLfloat-materialShininess =-   makeMaterialVar glGetMaterialfvf glMaterialff MaterialShininess--foreign import CALLCONV unsafe "glGetMaterialfv" glGetMaterialfvf ::-   GLenum -> GLenum -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glMaterialfv" glMaterialff ::-   GLenum -> GLenum -> Ptr GLfloat -> IO ()--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--foreign import CALLCONV unsafe "glGetMaterialiv" glGetMaterialiv ::-   GLenum -> GLenum -> Ptr GLint -> IO ()--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)--foreign import CALLCONV unsafe "glMaterialiv" glMaterialiv ::-   GLenum -> GLenum -> Ptr GLint -> IO ()------------------------------------------------------------------------------------data LightParameter =-     Ambient'-   | Diffuse'-   | Specular'-   | Position-   | SpotDirection-   | SpotExponent-   | SpotCutoff-   | ConstantAttenuation-   | LinearAttenuation-   | QuadraticAttenuation--marshalLightParameter :: LightParameter -> GLenum-marshalLightParameter x = case x of-   Ambient' -> 0x1200-   Diffuse' -> 0x1201-   Specular' -> 0x1202-   Position -> 0x1203-   SpotDirection -> 0x1204-   SpotExponent -> 0x1205-   SpotCutoff -> 0x1206-   ConstantAttenuation -> 0x1207-   LinearAttenuation -> 0x1208-   QuadraticAttenuation -> 0x1209------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetLightfv" glGetLightfvc ::-   GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()--foreign import CALLCONV unsafe "glLightfv" glLightfvc ::-   GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------position :: Light -> StateVar (Vertex4 GLfloat)-position = makeLightVar glGetLightfvv glLightfvv Position (Vertex4 0 0 0 0)--foreign import CALLCONV unsafe "glLightfv" glLightfvv ::-   GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()--foreign import CALLCONV unsafe "glGetLightfv" glGetLightfvv ::-   GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()------------------------------------------------------------------------------------spotDirection :: Light -> StateVar (Normal3 GLfloat)-spotDirection =-   makeLightVar glGetLightfvn glLightfvn SpotDirection (Normal3 0 0 0)--foreign import CALLCONV unsafe "glLightfv" glLightfvn ::-   GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()--foreign import CALLCONV unsafe "glGetLightfv" glGetLightfvn ::-   GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()------------------------------------------------------------------------------------spotExponent :: Light -> StateVar GLfloat-spotExponent = makeLightVar glGetLightfv glLightfv SpotExponent 0--foreign import CALLCONV unsafe "glLightfv" glLightfv ::-   GLenum -> GLenum -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glGetLightfv" glGetLightfv ::-   GLenum -> GLenum -> Ptr GLfloat -> IO ()--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 -> 0xb53-   LightModelLocalViewer -> 0xb51-   LightModelTwoSide -> 0xb52-   LightModelColorControl -> 0x81f8------------------------------------------------------------------------------------lightModelAmbient :: StateVar (Color4 GLfloat)-lightModelAmbient =-   makeStateVar-      (getFloat4 Color4 GetLightModelAmbient)-      (\c -> with c $-                glLightModelfv (marshalLightModelParameter LightModelAmbient))--foreign import CALLCONV unsafe "glLightModelfv" glLightModelfv ::-   GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------lightModelLocalViewer :: StateVar Capability-lightModelLocalViewer =-   makeLightModelCapVar GetLightModelLocalViewer LightModelLocalViewer--makeLightModelCapVar :: GetPName -> LightModelParameter -> StateVar Capability-makeLightModelCapVar pname lightModelParameter =-   makeStateVar-      (getBoolean1 unmarshalCapability pname)-      (glLightModeli (marshalLightModelParameter lightModelParameter) .-                     fromIntegral . marshalCapability)--foreign import CALLCONV unsafe "glLightModeli" glLightModeli ::-   GLenum -> GLint -> IO ()------------------------------------------------------------------------------------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 -> 0x81f9-   SeparateSpecularColor -> 0x81fa--unmarshalLightModelColorControl :: GLenum -> LightModelColorControl-unmarshalLightModelColorControl x-   | x == 0x81f9 = SingleColor-   | x == 0x81fa = 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 -> 0x1200-   Diffuse -> 0x1201-   Specular -> 0x1202-   Emission -> 0x1600-   AmbientAndDiffuse -> 0x1602--unmarshalColorMaterialParameter :: GLenum -> ColorMaterialParameter-unmarshalColorMaterialParameter x-   | x == 0x1200 = Ambient-   | x == 0x1201 = Diffuse-   | x == 0x1202 = Specular-   | x == 0x1600 = Emission-   | x == 0x1602 = 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))--foreign import CALLCONV unsafe "glColorMaterial" glColorMaterial ::-   GLenum -> GLenum -> IO ()------------------------------------------------------------------------------------data ShadingModel =-     Flat-   | Smooth-   deriving ( Eq, Ord, Show )--marshalShadingModel :: ShadingModel -> GLenum-marshalShadingModel x = case x of-   Flat -> 0x1d00-   Smooth -> 0x1d01--unmarshalShadingModel :: GLenum -> ShadingModel-unmarshalShadingModel x-   | x == 0x1d00 = Flat-   | x == 0x1d01 = Smooth-   | otherwise = error ("unmarshalShadingModel: illegal value " ++ show x)------------------------------------------------------------------------------------shadeModel :: StateVar ShadingModel-shadeModel =-   makeStateVar-      (getEnum1 unmarshalShadingModel GetShadeModel)-      (glShadeModel . marshalShadingModel)--foreign import CALLCONV unsafe "glShadeModel" glShadeModel :: GLenum -> IO ()
− 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.GL.BasicTypes ( GLenum )------------------------------------------------------------------------------------data ComparisonFunction =-     Never-   | Less-   | Equal-   | Lequal-   | Greater-   | Notequal-   | Gequal-   | Always-   deriving ( Eq, Ord, Show )--marshalComparisonFunction :: ComparisonFunction -> GLenum-marshalComparisonFunction x = case x of-   Never -> 0x200-   Less -> 0x201-   Equal -> 0x202-   Lequal -> 0x203-   Greater -> 0x204-   Notequal -> 0x205-   Gequal -> 0x206-   Always -> 0x207--unmarshalComparisonFunction :: GLenum -> ComparisonFunction-unmarshalComparisonFunction x-   | x == 0x200 = Never-   | x == 0x201 = Less-   | x == 0x202 = Equal-   | x == 0x203 = Lequal-   | x == 0x204 = Greater-   | x == 0x205 = Notequal-   | x == 0x206 = Gequal-   | x == 0x207 = Always-   | otherwise = error ("unmarshalComparisonFunction: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/ControlPoint.hs 
@@ -1,163 +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 Foreign.Ptr ( Ptr )-import Foreign.Storable ( Storable(peek,poke) )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )-import Graphics.Rendering.OpenGL.GL.Capability ( EnableCap(..) )-import Graphics.Rendering.OpenGL.GL.Domain ( Domain )-import Graphics.Rendering.OpenGL.GL.VertexArrays ( Stride )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   Vertex3, Vertex4, Index1, Color4, Normal3, TexCoord1, TexCoord2, TexCoord3,-   TexCoord4 )------------------------------------------------------------------------------------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 -> 0xd90-   Map1Index -> 0xd91-   Map1Normal -> 0xd92-   Map1TextureCoord1 -> 0xd93-   Map1TextureCoord2 -> 0xd94-   Map1TextureCoord3 -> 0xd95-   Map1TextureCoord4 -> 0xd96-   Map1Vertex3 -> 0xd97-   Map1Vertex4 -> 0xd98-   Map2Color4 -> 0xdb0-   Map2Index -> 0xdb1-   Map2Normal -> 0xdb2-   Map2TextureCoord1 -> 0xdb3-   Map2TextureCoord2 -> 0xdb4-   Map2TextureCoord3 -> 0xdb5-   Map2TextureCoord4 -> 0xdb6-   Map2Vertex3 -> 0xdb7-   Map2Vertex4 -> 0xdb8
− Graphics/Rendering/OpenGL/GL/CoordTrans.hs 
@@ -1,603 +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,-   Vector1(..), Vector2(..), Vector3(..), Vector4(..),-   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 Foreign.ForeignPtr ( ForeignPtr, mallocForeignPtrArray, withForeignPtr )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( allocaArray, peekArray, pokeArray, withArray )-import Foreign.Marshal.Utils ( with )-import Foreign.Ptr ( Ptr, castPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapRescaleNormal, CapNormalize,CapDepthClamp,-             CapTextureGenS, CapTextureGenT,-             CapTextureGenR, CapTextureGenQ),-   makeCapability, makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLsizei, GLfloat, GLdouble, GLclampd, Capability(..) )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket, unsafeBracket_ )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1, peek4, poke4 )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetDepthRange,GetViewport,GetMaxViewportDims,GetMatrixMode,-            GetModelviewMatrix,GetProjectionMatrix,-            GetTextureMatrix, GetColorMatrix,GetMatrixPalette,GetActiveTexture,-            GetCurrentMatrixStackDepth,GetModelviewStackDepth,-            GetMaxModelviewStackDepth,GetProjectionStackDepth,-            GetMaxProjectionStackDepth,GetTextureStackDepth,-            GetMaxTextureStackDepth,GetColorMatrixStackDepth,-            GetMaxColorMatrixStackDepth,GetMaxMatrixPaletteStackDepth),-   getInteger2, getInteger4, getEnum1, getSizei1, getFloatv,-   getDouble2, getDoublev, modelviewIndexToEnum, modelviewEnumToIndex )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, HasGetter(get), HasSetter(($=)),-   StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.Tensor (-   Vector1(..), Vector2(..), Vector3(..), Vector4(..) )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit (-   marshalTextureUnit, unmarshalTextureUnit )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( TextureUnit )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   recordInvalidEnum, recordInvalidValue )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-#include "HsOpenGLTypes.h"-------------------------------------------------------------------------------------- | 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 (getDouble2 (,) GetDepthRange) (uncurry glDepthRange)--foreign import CALLCONV unsafe "glDepthRange" glDepthRange ::-   GLclampd -> GLclampd -> IO ()-------------------------------------------------------------------------------------- | 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))--foreign import CALLCONV unsafe "glViewport" glViewport ::-   GLint -> GLint -> GLsizei -> GLsizei -> IO ()---- | The implementation-dependent maximum viewport width and height.--maxViewportDims :: GettableStateVar Size-maxViewportDims = makeGettableStateVar (getInteger2 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 0x1701-   Texture -> Just 0x1702-   Color -> Just 0x1800-   MatrixPalette -> Just 0x8840--unmarshalMatrixMode :: GLenum -> MatrixMode-unmarshalMatrixMode x-   | x == 0x1701 = Projection-   | x == 0x1702 = Texture-   | x == 0x1800 = Color-   | x == 0x8840 = 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)--foreign import CALLCONV unsafe "glMatrixMode" glMatrixMode :: GLenum -> IO ()------------------------------------------------------------------------------------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 = glLoadTransposeMatrixfARB-   multMatrix_ = glMultMatrixf-   multTransposeMatrix = glMultTransposeMatrixfARB-   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 = glLoadTransposeMatrixdARB-   multMatrix_ = glMultMatrixd-   multTransposeMatrix = glMultTransposeMatrixdARB-   rotate a (Vector3 x y z) = glRotated a x y z-   translate (Vector3 x y z) = glTranslated x y z-   scale = glScaled------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glLoadMatrixf" glLoadMatrixf :: Ptr GLfloat -> IO ()-foreign import CALLCONV unsafe "glLoadMatrixd" glLoadMatrixd :: Ptr GLdouble -> IO ()--EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glLoadTransposeMatrixfARB,Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glLoadTransposeMatrixdARB,Ptr GLdouble -> IO ())--foreign import CALLCONV unsafe "glMultMatrixf" glMultMatrixf :: Ptr GLfloat -> IO ()-foreign import CALLCONV unsafe "glMultMatrixd" glMultMatrixd :: Ptr GLdouble -> IO ()--EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glMultTransposeMatrixfARB,Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_transpose_matrix or OpenGL 1.3",glMultTransposeMatrixdARB,Ptr GLdouble -> IO ())--foreign import CALLCONV unsafe "glRotatef" glRotatef :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()-foreign import CALLCONV unsafe "glRotated" glRotated :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glTranslatef" glTranslatef :: GLfloat -> GLfloat -> GLfloat -> IO ()-foreign import CALLCONV unsafe "glTranslated" glTranslated :: GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glScalef" glScalef :: GLfloat -> GLfloat -> GLfloat -> IO ()-foreign import CALLCONV unsafe "glScaled" glScaled :: GLdouble -> GLdouble -> GLdouble -> IO ()------------------------------------------------------------------------------------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)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq (GLmatrix a)-instance Ord (GLmatrix a)-instance Show (GLmatrix a)-#else-   deriving ( Eq, Ord, Show )-#endif--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)------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glLoadIdentity" loadIdentity :: IO ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glOrtho" ortho ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glFrustum" frustum ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()------------------------------------------------------------------------------------depthClamp :: StateVar Capability-depthClamp = makeCapability CapDepthClamp------------------------------------------------------------------------------------activeTexture :: StateVar TextureUnit-activeTexture = makeStateVar (getEnum1 unmarshalTextureUnit GetActiveTexture)-                             (glActiveTextureARB . marshalTextureUnit)--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glActiveTextureARB,GLenum -> IO ())   -------------------------------------------------------------------------------------- | 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--foreign import CALLCONV unsafe "glPushMatrix" glPushMatrix :: IO ()--foreign import CALLCONV unsafe "glPopMatrix" glPopMatrix :: IO ()------------------------------------------------------------------------------------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 -> 0x2000-   T -> 0x2001-   R -> 0x2002-   Q -> 0x2003------------------------------------------------------------------------------------data TextureGenParameter =-     TextureGenMode-   | ObjectPlane-   | EyePlane--marshalTextureGenParameter :: TextureGenParameter -> GLenum-marshalTextureGenParameter x = case x of-   TextureGenMode -> 0x2500-   ObjectPlane -> 0x2501-   EyePlane -> 0x2502------------------------------------------------------------------------------------data TextureGenMode' =-     EyeLinear'-   | ObjectLinear'-   | SphereMap'-   | NormalMap'-   | ReflectionMap'--marshalTextureGenMode' :: TextureGenMode' -> GLint-marshalTextureGenMode' x = case x of-   EyeLinear' -> 0x2400-   ObjectLinear' -> 0x2401-   SphereMap' -> 0x2402-   NormalMap' -> 0x8511-   ReflectionMap' -> 0x8512--unmarshalTextureGenMode' :: GLint -> TextureGenMode'-unmarshalTextureGenMode' x-   | x == 0x2400 = EyeLinear'-   | x == 0x2401 = ObjectLinear'-   | x == 0x2402 = SphereMap'-   | x == 0x8511 = NormalMap'-   | x == 0x8512 = ReflectionMap'-   | otherwise = error ("unmarshalTextureGenMode': illegal value " ++ show 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--foreign import CALLCONV unsafe "glGetTexGeniv" glGetTexGeniv ::-   GLenum -> GLenum -> Ptr GLint -> IO ()--setMode :: TextureCoordName -> TextureGenMode -> IO ()-setMode coord mode =-   glTexGeni (marshalTextureCoordName coord)-             (marshalTextureGenParameter TextureGenMode)-             (marshalTextureGenMode mode)--foreign import CALLCONV unsafe "glTexGeni" glTexGeni ::-    GLenum -> GLenum -> GLint -> IO ()------------------------------------------------------------------------------------getPlane :: TextureCoordName -> TextureGenParameter -> IO (Plane GLdouble)-getPlane coord param = alloca $ \planeBuffer -> do-   glGetTexGendv (marshalTextureCoordName coord)-                 (marshalTextureGenParameter param)-                 planeBuffer-   peek planeBuffer--foreign import CALLCONV unsafe "glGetTexGendv" glGetTexGendv ::-   GLenum -> GLenum -> Ptr (Plane GLdouble) -> IO ()--setPlane :: TextureCoordName -> TextureGenParameter -> Plane GLdouble -> IO ()-setPlane coord param plane =-   with plane $ \planeBuffer ->-      glTexGendv (marshalTextureCoordName coord)-                 (marshalTextureGenParameter param)-                 planeBuffer--foreign import CALLCONV unsafe "glTexGendv" glTexGendv ::-   GLenum -> GLenum -> Ptr (Plane GLdouble) -> IO ()
− Graphics/Rendering/OpenGL/GL/DataType.hs 
@@ -1,126 +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.GL.BasicTypes ( GLenum )-------------------------------------------------------------------------------------- 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 -> 0x1401-   Byte -> 0x1400-   UnsignedShort -> 0x1403-   Short -> 0x1402-   UnsignedInt -> 0x1405-   Int -> 0x1404-   HalfFloat -> 0x140B-   Float -> 0x1406-   UnsignedByte332 -> 0x8032-   UnsignedByte233Rev -> 0x8362-   UnsignedShort565 -> 0x8363-   UnsignedShort565Rev -> 0x8364-   UnsignedShort4444 -> 0x8033-   UnsignedShort4444Rev -> 0x8365-   UnsignedShort5551 -> 0x8034-   UnsignedShort1555Rev -> 0x8366-   UnsignedInt8888 -> 0x8035-   UnsignedInt8888Rev -> 0x8367-   UnsignedInt1010102 -> 0x8036-   UnsignedInt2101010Rev -> 0x8368-   UnsignedInt248 -> 0x84fa-   UnsignedInt10f11f11fRev -> 0x8C3B-   UnsignedInt5999Rev -> 0x8C3E-   Float32UnsignedInt248Rev -> 0x8DAD-   Bitmap -> 0x1a00-   UnsignedShort88 -> 0x85ba-   UnsignedShort88Rev -> 0x85bb-   Double -> 0x140a-   TwoBytes -> 0x1407-   ThreeBytes -> 0x1408-   FourBytes -> 0x1409--unmarshalDataType :: GLenum -> DataType-unmarshalDataType x-   | x == 0x1401 = UnsignedByte-   | x == 0x1400 = Byte-   | x == 0x1403 = UnsignedShort-   | x == 0x1402 = Short-   | x == 0x1405 = UnsignedInt-   | x == 0x1404 = Int-   | x == 0x140B = HalfFloat-   | x == 0x1406 = Float-   | x == 0x8032 = UnsignedByte332-   | x == 0x8362 = UnsignedByte233Rev-   | x == 0x8363 = UnsignedShort565-   | x == 0x8364 = UnsignedShort565Rev-   | x == 0x8033 = UnsignedShort4444-   | x == 0x8365 = UnsignedShort4444Rev-   | x == 0x8034 = UnsignedShort5551-   | x == 0x8366 = UnsignedShort1555Rev-   | x == 0x8035 = UnsignedInt8888-   | x == 0x8367 = UnsignedInt8888Rev-   | x == 0x8036 = UnsignedInt1010102-   | x == 0x8368 = UnsignedInt2101010Rev-   | x == 0x84fa = UnsignedInt248-   | x == 0x8C3B = UnsignedInt10f11f11fRev-   | x == 0x8C3E = UnsignedInt5999Rev-   | x == 0x8DAD = Float32UnsignedInt248Rev-   | x == 0x1a00 = Bitmap-   | x == 0x85ba = UnsignedShort88-   | x == 0x85bb = UnsignedShort88Rev-   | x == 0x140a = Double-   | x == 0x1407 = TwoBytes-   | x == 0x1408 = ThreeBytes-   | x == 0x1409 = FourBytes-   | otherwise = error ("unmarshalDataType: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/DisplayLists.hs 
@@ -1,174 +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 Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLuint, GLsizei, GLenum )-import Graphics.Rendering.OpenGL.GL.BufferObjects ( ObjectName(..) )-import Graphics.Rendering.OpenGL.GL.DataType ( marshalDataType )-import Graphics.Rendering.OpenGL.GL.VertexArrays ( DataType )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetListIndex,GetListMode,GetMaxListNesting,GetListBase),-   getEnum1, getSizei1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordOutOfMemory )------------------------------------------------------------------------------------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 ] ]--foreign import CALLCONV unsafe "glGenLists" glGenLists :: GLsizei -> IO GLuint------------------------------------------------------------------------------------{-# DEPRECATED deleteLists "use `deleteObjectNames' instead" #-}-deleteLists :: [DisplayList] -> IO ()-deleteLists = deleteLists_--deleteLists_ :: [DisplayList] -> IO ()-deleteLists_ = mapM_ (uncurry glDeleteLists) . combineConsecutive--foreign import CALLCONV unsafe "glDeleteLists" glDeleteLists ::-   DisplayList -> GLsizei -> IO ()--combineConsecutive :: [DisplayList] -> [(DisplayList, GLsizei)]-combineConsecutive []     = []-combineConsecutive (z:zs) = (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------------------------------------------------------------------------------------{-# DEPRECATED isList "use `isObjectName' instead" #-}-isList :: DisplayList -> IO Bool-isList = isList_--isList_ :: DisplayList -> IO Bool-isList_ = fmap unmarshalGLboolean . glIsList--foreign import CALLCONV unsafe "glIsList" glIsList ::-   DisplayList -> IO GLboolean------------------------------------------------------------------------------------data ListMode =-     Compile-   | CompileAndExecute-   deriving ( Eq, Ord, Show )--marshalListMode :: ListMode -> GLenum-marshalListMode x = case x of-   Compile -> 0x1300-   CompileAndExecute -> 0x1301--unmarshalListMode :: GLenum -> ListMode-unmarshalListMode x-   | x == 0x1300 = Compile-   | x == 0x1301 = CompileAndExecute-   | otherwise = error ("unmarshalListMode: illegal value " ++ show x)------------------------------------------------------------------------------------defineList :: DisplayList -> ListMode -> IO a -> IO a-defineList lst mode = bracket_ (glNewList lst (marshalListMode mode)) glEndList--foreign import CALLCONV unsafe "glNewList" glNewList ::-   DisplayList -> GLenum -> IO ()--foreign import CALLCONV unsafe "glEndList" glEndList :: IO ()--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 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)------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glCallList" callList :: DisplayList -> IO ()--callLists :: GLsizei -> DataType -> Ptr a -> IO ()-callLists n = glCallLists n . marshalDataType--foreign import CALLCONV unsafe "glCallLists" glCallLists ::-   GLsizei -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------listBase :: StateVar DisplayList-listBase = makeStateVar (getEnum1 DisplayList GetListBase) glListBase--foreign import CALLCONV unsafe "glListBase" glListBase :: DisplayList -> IO ()
− Graphics/Rendering/OpenGL/GL/Domain.hs 
@@ -1,138 +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 ( Ptr )-import Foreign.Storable ( Storable )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLfloat, GLdouble )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName, getFloat2, getFloat4, getDouble2, getDouble4 )------------------------------------------------------------------------------------#include "HsOpenGLTypes.h"------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glMap1f" glMap1f ::-      GLenum-   -> GLfloat -> GLfloat -> GLint -> GLint-   -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glMap2f" glMap2f ::-      GLenum-   -> GLfloat -> GLfloat -> GLint -> GLint-   -> GLfloat -> GLfloat -> GLint -> GLint-   -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glGetMapfv" glGetMapfv ::-   GLenum -> GLenum -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glEvalCoord1f" glEvalCoord1f ::-   GLfloat -> IO ()--foreign import CALLCONV unsafe "glEvalCoord1fv" glEvalCoord1fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glEvalCoord2f" glEvalCoord2f ::-   GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glEvalCoord2fv" glEvalCoord2fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glMapGrid1f" glMapGrid1f ::-   GLint -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glMapGrid2f" glMapGrid2f ::-   GLint -> GLfloat -> GLfloat -> GLint -> GLfloat -> GLfloat -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glMap1d" glMap1d ::-      GLenum-   -> GLdouble -> GLdouble -> GLint -> GLint-   -> Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glMap2d" glMap2d ::-      GLenum-   -> GLdouble -> GLdouble -> GLint -> GLint-   -> GLdouble -> GLdouble -> GLint -> GLint-   -> Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glGetMapdv" glGetMapdv ::-   GLenum -> GLenum -> Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glEvalCoord1d" glEvalCoord1d ::-   GLdouble -> IO ()--foreign import CALLCONV unsafe "glEvalCoord1dv" glEvalCoord1dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glEvalCoord2d" glEvalCoord2d ::-   GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glEvalCoord2dv" glEvalCoord2dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glMapGrid1d" glMapGrid1d ::-   GLint -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glMapGrid2d" glMapGrid2d ::-   GLint -> GLdouble -> GLdouble -> GLint -> GLdouble -> GLdouble -> IO ()
− Graphics/Rendering/OpenGL/GL/EdgeFlag.hs 
@@ -1,37 +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.GL.BasicTypes ( GLboolean )-import Graphics.Rendering.OpenGL.GL.GLboolean (-   marshalGLboolean, unmarshalGLboolean )-------------------------------------------------------------------------------------- | 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,405 +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 ( zipWithM_ )-import Data.List ( genericLength )-import Foreign.ForeignPtr ( ForeignPtr, mallocForeignPtrArray, withForeignPtr )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( allocaArray )-import Foreign.Ptr ( Ptr, plusPtr )-import Foreign.Storable ( Storable(peek,sizeOf) )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapAutoNormal), makeCapability, makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.ControlPoint-import Graphics.Rendering.OpenGL.GL.Domain-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLint, Capability )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek2, peek4 )-import Graphics.Rendering.OpenGL.GL.PolygonMode ( marshalPolygonMode )-import Graphics.Rendering.OpenGL.GL.Polygons ( PolygonMode )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetMaxEvalOrder,-            GetMap1GridSegments,GetMap1GridDomain,-            GetMap2GridSegments,GetMap2GridDomain),-   getSizei1, getInteger1, getInteger2 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexArrays ( NumComponents, Stride )------------------------------------------------------------------------------------#include "HsOpenGLTypes.h"------------------------------------------------------------------------------------type Order = GLint--maxOrder :: GettableStateVar Order-maxOrder = makeGettableStateVar (getSizei1 id GetMaxEvalOrder)------------------------------------------------------------------------------------data Domain d => 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)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq d => Eq (GLmap1 c d)-instance Ord d => Ord (GLmap1 c d)-instance Show d => Show (GLmap1 c d)-#else-   deriving ( Eq, Ord, Show )-#endif--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)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq d => Eq (GLmap2 c d)-instance Ord d => Ord (GLmap2 c d)-instance Show d => Show (GLmap2 c d)-#else-   deriving ( Eq, Ord, Show )-#endif--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 -> 0xa00-   Order -> 0xa01-   Domain -> 0xa02------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glGetMapiv" glGetMapiv ::-   GLenum -> GLenum -> Ptr GLint -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glEvalMesh1" glEvalMesh1 ::-   GLenum -> GLint -> GLint -> IO ()--evalMesh2 :: PolygonMode -> (GLint, GLint) -> (GLint, GLint) -> IO ()-evalMesh2 m (p1, p2) (q1, q2) = glEvalMesh2 (marshalPolygonMode m) p1 p2 q1 q2--foreign import CALLCONV unsafe "glEvalMesh2" glEvalMesh2 ::-   GLenum -> GLint -> GLint -> GLint -> GLint -> IO ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glEvalPoint1" evalPoint1 ::-   GLint -> IO ()--evalPoint2 :: (GLint, GLint) -> IO ()-evalPoint2 = uncurry glEvalPoint2--foreign import CALLCONV unsafe "glEvalPoint2" glEvalPoint2 ::-   GLint -> GLint -> IO ()------------------------------------------------------------------------------------autoNormal :: StateVar Capability-autoNormal = makeCapability CapAutoNormal
− Graphics/Rendering/OpenGL/GL/Exception.hs 
@@ -1,54 +0,0 @@--- #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/Extensions.hs 
@@ -1,47 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Extensions--- 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 the OpenGL extension--- mechanism.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO,-   Invoker, getProcAddress   -- used only internally-) where--import Foreign.C.String ( CString, withCString )-import Foreign.Ptr ( FunPtr, nullFunPtr )-import System.IO.Unsafe ( unsafePerformIO )--#ifdef __HUGS__-{-# CFILES cbits/HsOpenGL.c #-}-#endif------------------------------------------------------------------------------------type Invoker a = FunPtr a -> a--getProcAddress :: String -> String -> IO (FunPtr a)-getProcAddress ext call =-   throwIfNull ("unknown OpenGL call " ++ call ++ ", check for " ++ ext) $-      withCString call hs_OpenGL_getProcAddress--throwIfNull :: String -> IO (FunPtr a) -> IO (FunPtr a)-throwIfNull msg act = do-   res <- act-   if res == nullFunPtr-      then ioError (userError msg)-      else return res--foreign import ccall unsafe "hs_OpenGL_getProcAddress" hs_OpenGL_getProcAddress-   :: CString -> IO (FunPtr a)
− 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.GL.BasicTypes ( GLenum )------------------------------------------------------------------------------------data Face =-     Front-   | Back-   | FrontAndBack-   deriving ( Eq, Ord, Show )--marshalFace :: Face -> GLenum-marshalFace x = case x of-   Front -> 0x404-   Back -> 0x405-   FrontAndBack -> 0x408--unmarshalFace :: GLenum -> Face-unmarshalFace x-   | x == 0x404 = Front-   | x == 0x405 = Back-   | x == 0x408 = FrontAndBack-   | otherwise = error ("unmarshalFace: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/Feedback.hs 
@@ -1,203 +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 ( liftM2, liftM3, liftM4 )-import Foreign.Marshal.Array ( allocaArray )-import Foreign.Ptr ( Ptr, plusPtr )-import Foreign.Storable ( Storable(sizeOf) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLsizei, GLfloat )-import Graphics.Rendering.OpenGL.GL.IOState (-   IOState, getIOState, peekIOState, evalIOState, nTimes )-import Graphics.Rendering.OpenGL.GL.RenderMode ( withRenderMode )-import Graphics.Rendering.OpenGL.GL.Selection ( RenderMode(Feedback) )-import Graphics.Rendering.OpenGL.GL.StateVar ( HasGetter(get) )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   Vertex2(..), Vertex3(..), Vertex4(..), Index1(..), Color4(..),-   TexCoord4(..), rgbaMode )------------------------------------------------------------------------------------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 == 0x701 = PointTag-   | x == 0x702 = LineTag-   | x == 0x707 = LineResetTag-   | x == 0x703 = PolygonTag-   | x == 0x704 = BitmapTag-   | x == 0x705 = DrawPixelTag-   | x == 0x706 = CopyPixelTag-   | x == 0x700 = 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 -> 0x600-   ThreeD -> 0x601-   ThreeDColor -> 0x602-   ThreeDColorTexture -> 0x603-   FourDColorTexture -> 0x604------------------------------------------------------------------------------------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)--foreign import CALLCONV unsafe "glFeedbackBuffer" glFeedbackBuffer ::-   GLsizei -> GLenum -> Ptr GLfloat -> IO ()------------------------------------------------------------------------------------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 )--foreign import CALLCONV unsafe "glPassThrough" passThrough ::-   PassThroughValue -> IO ()
− Graphics/Rendering/OpenGL/GL/FlushFinish.hs 
@@ -1,46 +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-------------------------------------------------------------------------------------- | 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.--foreign import CALLCONV unsafe "glFlush" flush :: IO ()---- | '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.--foreign import CALLCONV unsafe "glFinish" finish :: IO ()
− Graphics/Rendering/OpenGL/GL/Fog.hs 
@@ -1,206 +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 Foreign.Marshal.Utils ( with )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapFog), makeCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetFogIndex,GetFogDensity,GetFogStart,GetFogEnd,GetFogMode,-   GetFogColor,GetFogCoordSrc,GetFogDistanceMode),-   getInteger1, getFloat1, getFloat4 )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   Color4(Color4), Index1(Index1) )------------------------------------------------------------------------------------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 -> 0xb61-   FogDensity -> 0xb62-   FogStart -> 0xb63-   FogEnd -> 0xb64-   FogMode -> 0xb65-   FogColor -> 0xb66-   FogCoordSrc -> 0x8450-   FogDistanceMode -> 0x855a------------------------------------------------------------------------------------data FogMode' =-     Linear'-   | Exp'-   | Exp2'--marshalFogMode' :: FogMode' -> GLint-marshalFogMode' x = case x of-   Linear' -> 0x2601-   Exp' -> 0x800-   Exp2' -> 0x801--unmarshalFogMode' :: GLint -> FogMode'-unmarshalFogMode' x-   | x == 0x2601 = Linear'-   | x == 0x800 = Exp'-   | x == 0x801 = Exp2'-   | otherwise = error ("unmarshalFogMode': illegal value " ++ show 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--foreign import CALLCONV unsafe "glFogi" glFogi :: GLenum -> GLint -> IO ()--fogf :: FogParameter -> GLfloat -> IO ()-fogf = glFogf . marshalFogParameter--foreign import CALLCONV unsafe "glFogf" glFogf :: GLenum -> GLfloat -> IO ()--fogfv :: FogParameter -> Ptr (Color4 GLfloat) -> IO ()-fogfv = glFogfv . marshalFogParameter--foreign import CALLCONV unsafe "glFogfv" glFogfv ::-   GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------fogColor :: StateVar (Color4 GLfloat)-fogColor =-   makeStateVar (getFloat4 Color4 GetFogColor) (\c -> with c $ fogfv FogColor)------------------------------------------------------------------------------------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 = case x of-   FogCoord -> 0x8451-   FragmentDepth -> 0x8452--unmarshalFogCoordSrc :: GLint -> FogCoordSrc-unmarshalFogCoordSrc x-   | x == 0x8451 = FogCoord-   | x == 0x8452 = FragmentDepth-   | otherwise = error ("unmarshalFogCoordSrc: illegal value " ++ show 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 = case x of-   EyeRadial -> 0x855b-   EyePlaneSigned -> 0x2502-   EyePlaneAbsolute -> 0x855c--unmarshalFogDistanceMode :: GLint -> FogDistanceMode-unmarshalFogDistanceMode x-   | x== 0x855b = EyeRadial-   | x == 0x2502 = EyePlaneSigned-   | x == 0x855c = EyePlaneAbsolute-   | otherwise = error ("unmarshalFogDistanceMode: illegal value " ++ show x)------------------------------------------------------------------------------------fogDistanceMode :: StateVar FogDistanceMode-fogDistanceMode =-   makeStateVar-      (getInteger1 unmarshalFogDistanceMode GetFogDistanceMode)-      (fogi FogDistanceMode . marshalFogDistanceMode)
− Graphics/Rendering/OpenGL/GL/Framebuffer.hs 
@@ -1,470 +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 ( liftM4 )-import Data.List ( genericLength )-import Data.Maybe ( isJust, fromJust )-import Foreign.Marshal.Array ( withArray )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BufferMode (-   BufferMode(..), marshalBufferMode, unmarshalBufferMode )-import Graphics.Rendering.OpenGL.GL.Capability (-   marshalCapability, unmarshalCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLenum, GLsizei, GLint, GLuint, GLbitfield, GLfloat, GLclampf,-   GLclampd,-#ifdef __HADDOCK__-   Capability(..)-#else-   Capability-#endif-   )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.Face ( Face, marshalFace )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetAuxBuffers,GetDoublebuffer,GetStereo,GetRedBits,GetGreenBits,-            GetBlueBits,GetAlphaBits,GetStencilBits,GetDepthBits,-            GetAccumRedBits,GetAccumGreenBits,GetAccumBlueBits,-            GetAccumAlphaBits,GetRGBASignedComponents,GetDrawBuffer,-            GetIndexWritemask,GetColorWritemask,GetDepthWritemask,-            GetStencilWritemask,GetColorClearValue,GetIndexClearValue,-            GetDepthClearValue,GetStencilClearValue,GetAccumClearValue,-            GetMaxDrawBuffers,GetDrawBufferN),-   getInteger1, getInteger4, getBoolean1, getBoolean4, getEnum1, getSizei1,-   getFloat1, getFloat4, getDouble1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), GettableStateVar, makeGettableStateVar,-   SettableStateVar, makeSettableStateVar,-   StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   Color4(Color4), Index1(Index1) )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidValue )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-------------------------------------------------------------------------------------- | 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)--foreign import CALLCONV unsafe "glDrawBuffer" glDrawBuffer ::-   GLenum -> IO ()-------------------------------------------------------------------------------------- | '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--EXTENSION_ENTRY("GL_ARB_draw_buffers or OpenGL 2.0",glDrawBuffers,GLsizei -> Ptr GLenum -> IO ())-------------------------------------------------------------------------------------- | 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--foreign import CALLCONV unsafe "glIndexMask" glIndexMask :: GLuint -> IO ()-------------------------------------------------------------------------------------- | 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))--foreign import CALLCONV unsafe "glColorMask" glColorMask ::-   GLboolean -> GLboolean -> GLboolean -> GLboolean -> IO ()-------------------------------------------------------------------------------------- | Controls whether the depth buffer is enabled for writing. The initial state--- is 'Enabled'.--depthMask :: StateVar Capability-depthMask = makeStateVar (getBoolean1 unmarshalCapability GetDepthWritemask)-                         (glDepthMask . marshalCapability)--foreign import CALLCONV unsafe "glDepthMask" glDepthMask :: GLboolean -> IO ()-------------------------------------------------------------------------------------- | 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--foreign import CALLCONV unsafe "glStencilMask" glStencilMask :: GLuint -> IO ()--stencilMaskSeparate :: Face -> SettableStateVar GLuint-stencilMaskSeparate face =-   makeSettableStateVar $-      glStencilMaskSeparate (marshalFace face)--EXTENSION_ENTRY("OpenGL 2.0",glStencilMaskSeparate,GLenum -> GLuint -> IO ())-------------------------------------------------------------------------------------- | 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 -> 0x4000-   AccumBuffer -> 0x200-   StencilBuffer -> 0x400-   DepthBuffer -> 0x100-------------------------------------------------------------------------------------- | 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--foreign import CALLCONV unsafe "glClear" glClear :: GLbitfield -> IO ()-------------------------------------------------------------------------------------- | 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 (getFloat4 Color4 GetColorClearValue)-                          (\(Color4 r g b a) -> glClearColor r g b a)--foreign import CALLCONV unsafe "glClearColor" glClearColor ::-    GLclampf -> GLclampf -> GLclampf -> GLclampf -> IO ()-------------------------------------------------------------------------------------- | 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)--foreign import CALLCONV unsafe "glClearIndex" glClearIndex :: GLfloat -> IO ()-------------------------------------------------------------------------------------- | 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 (getDouble1 id GetDepthClearValue) glClearDepth--foreign import CALLCONV unsafe "glClearDepth" glClearDepth :: GLclampd -> IO ()-------------------------------------------------------------------------------------- | 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--foreign import CALLCONV unsafe "glClearStencil" glClearStencil :: GLint -> IO ()-------------------------------------------------------------------------------------- | 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)--foreign import CALLCONV unsafe "glClearAccum" glClearAccum ::-   GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()-------------------------------------------------------------------------------------- | 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 -> 0x100-   Load -> 0x101-   Return -> 0x102-   Mult -> 0x103-   Add -> 0x104-------------------------------------------------------------------------------------- | 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--foreign import CALLCONV unsafe "glAccum" glAccum :: GLenum -> GLfloat -> IO ()
− Graphics/Rendering/OpenGL/GL/GLboolean.hs 
@@ -1,27 +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------------------------------------------------------------------------------------marshalGLboolean :: Num a => Bool -> a-marshalGLboolean False = 0-marshalGLboolean True  = 1--unmarshalGLboolean :: (Eq a, Num a) => a -> Bool-unmarshalGLboolean = (/= 0)
− Graphics/Rendering/OpenGL/GL/Hints.hs 
@@ -1,94 +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 Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetPerspectiveCorrectionHint,GetPointSmoothHint,GetLineSmoothHint,-            GetPolygonSmoothHint,GetFogHint,GetGenerateMipmapHint,-            GetTextureCompressionHint,GetPackCMYKHint,GetUnpackCMYKHint),-   getEnum1 )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )------------------------------------------------------------------------------------data HintTarget =-     PerspectiveCorrection-   | PointSmooth-   | LineSmooth-   | PolygonSmooth-   | Fog-   | GenerateMipmap-   | TextureCompression-   | PackCMYK-   | UnpackCMYK-   deriving ( Eq, Ord, Show )--marshalHintTarget :: HintTarget -> GLenum-marshalHintTarget x = case x of-   PerspectiveCorrection -> 0xc50-   PointSmooth -> 0xc51-   LineSmooth -> 0xc52-   PolygonSmooth -> 0xc53-   Fog -> 0xc54-   GenerateMipmap -> 0x8192-   TextureCompression -> 0x84ef-   PackCMYK -> 0x800e-   UnpackCMYK -> 0x800f--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 -> 0x1100-   Fastest -> 0x1101-   Nicest -> 0x1102--unmarshalHintMode :: GLenum -> HintMode-unmarshalHintMode x-   | x == 0x1100 = DontCare-   | x == 0x1101 = Fastest-   | x == 0x1102 = Nicest-   | otherwise = error ("unmarshalHintMode: illegal value " ++ show x)------------------------------------------------------------------------------------hint ::  HintTarget -> StateVar HintMode-hint t =-   makeStateVar-      (getEnum1 unmarshalHintMode (hintTargetToGetPName t))-      (glHint (marshalHintTarget t) . marshalHintMode)--foreign import CALLCONV unsafe "glHint" glHint :: GLenum -> GLenum -> IO ()
− 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,162 +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 ( liftM2 )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapLineSmooth,CapLineStipple), makeCapability, makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLint, GLushort, GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetLineWidth,GetAliasedLineWidthRange,GetSmoothLineWidthRange,-            GetSmoothLineWidthGranularity,GetLineStippleRepeat,-            GetLineStipplePattern),-   getInteger1, getFloat1, getFloat2 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-------------------------------------------------------------------------------------- | '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--foreign import CALLCONV unsafe "glLineWidth" glLineWidth :: GLfloat -> IO ()-------------------------------------------------------------------------------------- | 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)--foreign import CALLCONV unsafe "glLineStipple" glLineStipple ::-   GLint -> GLushort -> IO ()-------------------------------------------------------------------------------------- | Controls whether line antialiasing is enabled. The initial state is--- 'Graphics.Rendering.OpenGL.GL.BasicTypes.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 ( Ptr )-import Foreign.Storable ( Storable(peekElemOff,pokeElemOff) )------------------------------------------------------------------------------------- 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,546 +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 ( liftM2, liftM3 )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( withArrayLen, peekArray, allocaArray )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BufferObjects ( ObjectName(..) )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapScissorTest,CapSampleAlphaToCoverage,CapSampleAlphaToOne,-             CapSampleCoverage,CapDepthBoundsTest,CapAlphaTest,CapStencilTest,-             CapStencilTestTwoSide,CapDepthTest,CapBlend,CapDither,-             CapIndexLogicOp,CapColorLogicOp),-   makeCapability, makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLint, GLuint, GLsizei, GLenum, GLclampf, GLclampd, Capability )-import Graphics.Rendering.OpenGL.GL.BlendingFactor (-   BlendingFactor(..), marshalBlendingFactor, unmarshalBlendingFactor )-import Graphics.Rendering.OpenGL.GL.ComparisonFunction ( ComparisonFunction(..),-   marshalComparisonFunction, unmarshalComparisonFunction )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.Face ( marshalFace, unmarshalFace )-import Graphics.Rendering.OpenGL.GL.Colors ( Face )-import Graphics.Rendering.OpenGL.GL.GLboolean (-   marshalGLboolean, unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetScissorBox,GetSampleCoverageValue,GetSampleCoverageInvert,-            GetDepthBounds,GetAlphaTestFunc,GetAlphaTestRef,GetStencilFunc,-            GetStencilRef,GetStencilValueMask,GetStencilFail,-            GetStencilPassDepthFail,GetStencilPassDepthPass,-            GetActiveStencilFace,GetDepthFunc,GetBlendEquation,-            GetBlendEquationAlpha,GetBlendDstRGB,GetBlendSrcRGB,-            GetBlendDstAlpha,GetBlendSrcAlpha,GetBlendSrc,GetBlendDst,-            GetBlendColor,GetLogicOpMode),-   getInteger1, getInteger4, getEnum1, getFloat1, getFloat4, getDouble2,-   getBoolean1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), GettableStateVar, makeGettableStateVar,-   SettableStateVar, makeSettableStateVar,-   StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..), rgbaMode )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------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))-       -foreign import CALLCONV unsafe "glScissor" glScissor ::-   GLint -> GLint -> GLsizei -> GLsizei -> IO ()------------------------------------------------------------------------------------sampleAlphaToCoverage :: StateVar Capability-sampleAlphaToCoverage = makeCapability CapSampleAlphaToCoverage--sampleAlphaToOne :: StateVar Capability-sampleAlphaToOne = makeCapability CapSampleAlphaToOne--sampleCoverage :: StateVar (Maybe (GLclampf, Bool))-sampleCoverage =-   makeStateVarMaybe-      (return CapSampleCoverage)-      (liftM2 (,) (getFloat1 id GetSampleCoverageValue)-                  (getBoolean1 unmarshalGLboolean GetSampleCoverageInvert))-      (\(value, invert) -> glSampleCoverageARB value (marshalGLboolean invert))--EXTENSION_ENTRY("GL_ARB_multisample or OpenGL 1.3",glSampleCoverageARB,GLclampf -> GLboolean -> IO ())------------------------------------------------------------------------------------depthBounds :: StateVar (Maybe (GLclampd, GLclampd))-depthBounds =-   makeStateVarMaybe-      (return CapDepthBoundsTest)-      (getDouble2 (,) GetDepthBounds)-      (uncurry glDepthBoundsEXT)-       -EXTENSION_ENTRY("GL_EXT_depth_bounds_test",glDepthBoundsEXT,GLclampd -> GLclampd -> IO ())------------------------------------------------------------------------------------alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))-alphaFunc =-   makeStateVarMaybe-      (return CapAlphaTest)-      (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc)-                  (getFloat1 id GetAlphaTestRef))-      (uncurry (glAlphaFunc . marshalComparisonFunction))--foreign import CALLCONV unsafe "glAlphaFunc" glAlphaFunc ::-   GLenum -> GLclampf -> IO ()------------------------------------------------------------------------------------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)--foreign import CALLCONV unsafe "glStencilFunc" glStencilFunc ::-   GLenum -> GLint -> GLuint -> IO ()--stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint)-stencilFuncSeparate face =-   makeSettableStateVar $ \(func, ref, mask) ->-      glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask--EXTENSION_ENTRY("OpenGL 2.0",glStencilFuncSeparate,GLenum -> GLenum -> GLint -> GLuint -> IO ())------------------------------------------------------------------------------------data StencilOp =-     OpZero-   | OpKeep-   | OpReplace-   | OpIncr-   | OpIncrWrap-   | OpDecr-   | OpDecrWrap-   | OpInvert-   deriving ( Eq, Ord, Show )--marshalStencilOp :: StencilOp -> GLenum-marshalStencilOp x = case x of-   OpZero -> 0x0-   OpKeep -> 0x1e00-   OpReplace -> 0x1e01-   OpIncr -> 0x1e02-   OpIncrWrap -> 0x8507-   OpDecr -> 0x1e03-   OpDecrWrap -> 0x8508-   OpInvert -> 0x150a--unmarshalStencilOp :: GLenum -> StencilOp-unmarshalStencilOp x-   | x == 0x0 = OpZero-   | x == 0x1e00 = OpKeep-   | x == 0x1e01 = OpReplace-   | x == 0x1e02 = OpIncr-   | x == 0x8507 = OpIncrWrap-   | x == 0x1e03 = OpDecr-   | x == 0x8508 = OpDecrWrap-   | x == 0x150a = 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))--foreign import CALLCONV unsafe "glStencilOp" glStencilOp ::-   GLenum -> GLenum -> GLenum -> IO ()--stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp)-stencilOpSeparate face =-   makeSettableStateVar $ \(sf, spdf, spdp) ->-      glStencilOpSeparate (marshalFace face)-                          (marshalStencilOp sf)-                          (marshalStencilOp spdf)-                          (marshalStencilOp spdp)--EXTENSION_ENTRY("OpenGL 2.0",glStencilOpSeparate,GLenum -> GLenum -> GLenum -> GLenum -> IO ())------------------------------------------------------------------------------------activeStencilFace :: StateVar (Maybe Face)-activeStencilFace =-   makeStateVarMaybe-      (return CapStencilTestTwoSide)-      (getEnum1 unmarshalFace GetActiveStencilFace)-      (glActiveStencilFaceEXT . marshalFace)--EXTENSION_ENTRY("GL_EXT_stencil_two_side",glActiveStencilFaceEXT,GLenum -> IO ())------------------------------------------------------------------------------------depthFunc :: StateVar (Maybe ComparisonFunction)-depthFunc =-   makeStateVarMaybe-      (return CapDepthTest)-      (getEnum1 unmarshalComparisonFunction GetDepthFunc)-      (glDepthFunc . marshalComparisonFunction)--foreign import CALLCONV unsafe "glDepthFunc" glDepthFunc :: GLenum -> IO ()------------------------------------------------------------------------------------newtype QueryObject = QueryObject { queryID :: GLuint }-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------instance ObjectName QueryObject where-   genObjectNames n =-      allocaArray n $ \buf -> do-        glGenQueriesARB (fromIntegral n) buf-        fmap (map QueryObject) $ peekArray n buf--   deleteObjectNames queryObjects =-      withArrayLen (map queryID queryObjects) $-         glDeleteQueriesARB . fromIntegral--   isObjectName = fmap unmarshalGLboolean . glIsQueryARB . queryID---EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glGenQueriesARB,GLsizei -> Ptr GLuint -> IO ())--EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glDeleteQueriesARB,GLsizei -> Ptr GLuint -> IO ())--EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glIsQueryARB,GLuint -> IO GLboolean)------------------------------------------------------------------------------------data QueryTarget =-     SamplesPassed-   deriving ( Eq, Ord, Show )--marshalQueryTarget :: QueryTarget -> GLenum-marshalQueryTarget x = case x of-   SamplesPassed -> 0x8914------------------------------------------------------------------------------------beginQuery :: QueryTarget -> QueryObject -> IO ()-beginQuery t = glBeginQueryARB (marshalQueryTarget t) . queryID--EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glBeginQueryARB,GLenum -> GLuint -> IO ())--endQuery :: QueryTarget -> IO ()-endQuery = glEndQueryARB . marshalQueryTarget--EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glEndQueryARB,GLenum -> IO ())---- | 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 -> 0x8864-   CurrentQuery -> 0x8865------------------------------------------------------------------------------------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-         glGetQueryivARB (marshalQueryTarget t) (marshalGetQueryPName p) buf-         peek1 f buf--EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glGetQueryivARB,GLenum -> GLenum -> Ptr GLint -> IO ())------------------------------------------------------------------------------------data GetQueryObjectPName =-     QueryResult-   | QueryResultAvailable--marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum-marshalGetQueryObjectPName x = case x of-   QueryResult -> 0x8866-   QueryResultAvailable -> 0x8867------------------------------------------------------------------------------------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-         glGetQueryObjectuivARB (queryID q) (marshalGetQueryObjectPName p) buf-         peek1 f buf--EXTENSION_ENTRY("GL_ARB_occlusion_query or OpenGL 1.5",glGetQueryObjectuivARB,GLuint -> GLenum -> Ptr GLuint -> IO ())------------------------------------------------------------------------------------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 -> 0x8006-   FuncSubtract -> 0x800a-   FuncReverseSubtract -> 0x800b-   Min -> 0x8007-   Max -> 0x8008-   LogicOp -> 0xbf1--unmarshalBlendEquation :: GLenum -> BlendEquation-unmarshalBlendEquation x-   | x == 0x8006 = FuncAdd-   | x == 0x800a = FuncSubtract-   | x == 0x800b = FuncReverseSubtract-   | x == 0x8007 = Min-   | x == 0x8008 = Max-   | x == 0xbf1 = LogicOp-   | otherwise = error ("unmarshalBlendEquation: illegal value " ++ show x)------------------------------------------------------------------------------------blendEquation :: StateVar BlendEquation-blendEquation =-   makeStateVar-      (getEnum1 unmarshalBlendEquation GetBlendEquation)-      (glBlendEquationEXT . marshalBlendEquation)--EXTENSION_ENTRY("GL_EXT_blend_minmax or GL_EXT_blend_subtract or OpenGL 1.4",glBlendEquationEXT,GLenum -> IO ())--blendEquationSeparate :: StateVar (BlendEquation,BlendEquation)-blendEquationSeparate =-   makeStateVar-      (liftM2 (,) (getEnum1 unmarshalBlendEquation GetBlendEquation)-                  (getEnum1 unmarshalBlendEquation GetBlendEquationAlpha))-      (\(funcRGB, funcAlpha) ->-          glBlendEquationSeparate (marshalBlendEquation funcRGB)-                                  (marshalBlendEquation funcAlpha))--EXTENSION_ENTRY("GL_EXT_blend_equation_separate or OpenGL 2.0",glBlendEquationSeparate,GLenum -> GLenum -> IO ())------------------------------------------------------------------------------------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)) ->-         glBlendFuncSeparateEXT (marshalBlendingFactor srcRGB)-                                (marshalBlendingFactor srcAlpha)-                                (marshalBlendingFactor dstRGB)-                                (marshalBlendingFactor dstAlpha))--EXTENSION_ENTRY("GL_EXT_blend_func_separate or OpenGL 1.4",glBlendFuncSeparateEXT,GLenum -> GLenum -> GLenum -> GLenum -> IO ())--blendFunc :: StateVar (BlendingFactor, BlendingFactor)-blendFunc =-   makeStateVar-      (liftM2 (,) (getEnum1 unmarshalBlendingFactor GetBlendSrc)-                  (getEnum1 unmarshalBlendingFactor GetBlendDst))-      (\(s, d) ->-         glBlendFunc (marshalBlendingFactor s) (marshalBlendingFactor d))--foreign import CALLCONV unsafe "glBlendFunc" glBlendFunc ::-   GLenum -> GLenum -> IO ()--blendColor :: StateVar (Color4 GLclampf)-blendColor =-   makeStateVar-      (getFloat4 Color4 GetBlendColor)-      (\(Color4 r g b a) -> glBlendColorEXT r g b a)--EXTENSION_ENTRY("GL_EXT_blend_color or OpenGL 1.4",glBlendColorEXT,GLclampf -> GLclampf -> GLclampf -> GLclampf -> IO ())------------------------------------------------------------------------------------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 -> 0x1500-   And -> 0x1501-   AndReverse -> 0x1502-   Copy -> 0x1503-   AndInverted -> 0x1504-   Noop -> 0x1505-   Xor -> 0x1506-   Or -> 0x1507-   Nor -> 0x1508-   Equiv -> 0x1509-   Invert -> 0x150a-   OrReverse -> 0x150b-   CopyInverted -> 0x150c-   OrInverted -> 0x150d-   Nand -> 0x150e-   Set -> 0x150f--unmarshalLogicOp :: GLenum -> LogicOp-unmarshalLogicOp x-   | x == 0x1500 = Clear-   | x == 0x1501 = And-   | x == 0x1502 = AndReverse-   | x == 0x1503 = Copy-   | x == 0x1504 = AndInverted-   | x == 0x1505 = Noop-   | x == 0x1506 = Xor-   | x == 0x1507 = Or-   | x == 0x1508 = Nor-   | x == 0x1509 = Equiv-   | x == 0x150a = Invert-   | x == 0x150b = OrReverse-   | x == 0x150c = CopyInverted-   | x == 0x150d = OrInverted-   | x == 0x150e = Nand-   | x == 0x150f = 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)--foreign import CALLCONV unsafe "glLogicOp" glLogicOp :: GLenum -> IO ()
− Graphics/Rendering/OpenGL/GL/PixelData.hs 
@@ -1,40 +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 ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )-import Graphics.Rendering.OpenGL.GL.DataType ( DataType, marshalDataType )-import Graphics.Rendering.OpenGL.GL.PixelFormat (-   PixelFormat, marshalPixelFormat )------------------------------------------------------------------------------------data PixelData a = PixelData PixelFormat DataType (Ptr a)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq (PixelData a)-instance Ord (PixelData a)-instance Show (PixelData a)-#else-   deriving ( Eq, Ord, Show )-#endif--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,98 +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.GL.BasicTypes ( GLenum )------------------------------------------------------------------------------------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 -> 0x1900-   StencilIndex -> 0x1901-   DepthComponent -> 0x1902-   Red -> 0x1903-   Green -> 0x1904-   Blue -> 0x1905-   Alpha -> 0x1906-   RGB -> 0x1907-   RGBA -> 0x1908-   Luminance -> 0x1909-   LuminanceAlpha -> 0x190a-   ABGR -> 0x8000-   BGR -> 0x80E0-   BGRA -> 0x80E1-   CMYK -> 0x800C-   CMYKA -> 0x800D-   FourTwoTwo -> 0x80CC-   FourTwoTwoRev -> 0x80CD-   FourTwoTwoAverage -> 0x80CE-   FourTwoTwoRevAverage -> 0x80CF-   YCBCR422 -> 0x85B9-   DepthStencil -> 0x84f9--unmarshalPixelFormat :: GLenum -> PixelFormat-unmarshalPixelFormat x-   | x == 0x1900 = ColorIndex-   | x == 0x1901 = StencilIndex-   | x == 0x1902 = DepthComponent-   | x == 0x1903 = Red-   | x == 0x1904 = Green-   | x == 0x1905 = Blue-   | x == 0x1906 = Alpha-   | x == 0x1907 = RGB-   | x == 0x1908 = RGBA-   | x == 0x1909 = Luminance-   | x == 0x190a = LuminanceAlpha-   | x == 0x8000 = ABGR-   | x == 0x80E0 = BGR-   | x == 0x80E1 = BGRA-   | x == 0x800C = CMYK-   | x == 0x800D = CMYKA-   | x == 0x80CC = FourTwoTwo-   | x == 0x80CD = FourTwoTwoRev-   | x == 0x80CE = FourTwoTwoAverage-   | x == 0x80CF = FourTwoTwoRevAverage-   | x == 0x85B9 = YCBCR422-   | x == 0x84f9 = 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,279 +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 Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Utils ( with )-import Foreign.Ptr ( Ptr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapColorTable,CapPostConvolutionColorTable,-             CapPostColorMatrixColorTable,CapTextureColorTable),-   makeCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLsizei, GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..) )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization (-    PixelData(..) )-import Graphics.Rendering.OpenGL.GL.PixelData ( withPixelData )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   PixelInternalFormat(..), marshalPixelInternalFormat',-   unmarshalPixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   recordInvalidEnum )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------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 -> 0x80d0-   PostConvolutionColorTable -> 0x80d1-   PostColorMatrixColorTable -> 0x80d2-   Texture1DColorTable -> 0xde0-   Texture2DColorTable -> 0xde1-   Texture3DColorTable -> 0x806f-   TextureCubeMapColorTable -> 0x8513-   TextureColorTable -> 0x80bc-   SharedTexturePalette -> 0x81fb------------------------------------------------------------------------------------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 0x80d3-   PostConvolutionColorTable -> Just 0x80d4-   PostColorMatrixColorTable -> Just 0x80d5-   Texture1DColorTable -> Just 0x8063-   Texture2DColorTable -> Just 0x8064-   Texture3DColorTable -> Just 0x8070-   TextureCubeMapColorTable -> Just 0x851b-   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)--EXTENSION_ENTRY("GL_ARB_imaging",glColorTable,GLenum -> GLenum -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------getColorTable :: ColorTable -> PixelData a -> IO ()-getColorTable ct pd =-   withPixelData pd $ glGetColorTable (marshalColorTable ct)--EXTENSION_ENTRY("GL_ARB_imaging",glGetColorTable,GLenum -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------copyColorTable :: ColorTable -> PixelInternalFormat -> Position -> GLsizei -> IO ()-copyColorTable ct int (Position x y) =-   glCopyColorTable (marshalColorTable ct) (marshalPixelInternalFormat' int) x y--EXTENSION_ENTRY("GL_ARB_imaging",glCopyColorTable,GLenum -> GLenum -> GLint -> GLint -> GLsizei -> IO ())------------------------------------------------------------------------------------colorSubTable :: ColorTable -> GLsizei -> GLsizei -> PixelData a -> IO ()-colorSubTable ct start count pd =-   withPixelData pd $ glColorSubTable (marshalColorTable ct) start count--EXTENSION_ENTRY("GL_ARB_imaging",glColorSubTable,GLenum -> GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------copyColorSubTable :: ColorTable -> GLsizei -> Position -> GLsizei -> IO ()-copyColorSubTable ct start (Position x y) =-   glCopyColorSubTable (marshalColorTable ct) start x y--EXTENSION_ENTRY("GL_ARB_imaging",glCopyColorSubTable,GLenum -> GLsizei -> GLint -> GLint -> GLsizei -> IO ())------------------------------------------------------------------------------------data ColorTablePName =-     ColorTableScale-   | ColorTableBias-   | ColorTableFormat-   | ColorTableWidth-   | ColorTableRedSize-   | ColorTableGreenSize-   | ColorTableBlueSize-   | ColorTableAlphaSize-   | ColorTableLuminanceSize-   | ColorTableIntensitySize--marshalColorTablePName :: ColorTablePName -> GLenum-marshalColorTablePName x = case x of-   ColorTableScale -> 0x80d6-   ColorTableBias -> 0x80d7-   ColorTableFormat -> 0x80d8-   ColorTableWidth -> 0x80d9-   ColorTableRedSize -> 0x80da-   ColorTableGreenSize -> 0x80db-   ColorTableBlueSize -> 0x80dc-   ColorTableAlphaSize -> 0x80dd-   ColorTableLuminanceSize -> 0x80de-   ColorTableIntensitySize -> 0x80df------------------------------------------------------------------------------------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)-         buf-      peek buf--EXTENSION_ENTRY("GL_ARB_imaging",glGetColorTableParameterfv,GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ())--colorTableParameterC4f ::-   ColorTable -> ColorTablePName -> Color4 GLfloat -> IO ()-colorTableParameterC4f ct p c =-   with c $-      glColorTableParameterfv (marshalColorTable ct) (marshalColorTablePName p)--EXTENSION_ENTRY("GL_ARB_imaging",glColorTableParameterfv,GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ())------------------------------------------------------------------------------------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--EXTENSION_ENTRY("GL_ARB_imaging",glGetColorTableParameteriv,GLenum -> GLenum -> Ptr GLint -> IO ())------------------------------------------------------------------------------------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,318 +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 Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Utils ( with )-import Foreign.Ptr ( Ptr, nullPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapConvolution1D, CapConvolution2D,CapSeparable2D),-   makeCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLsizei, GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (-   PixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization (-    PixelData(..) )-import Graphics.Rendering.OpenGL.GL.PixelData ( withPixelData )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   marshalPixelInternalFormat' )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   recordInvalidValue )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------data ConvolutionTarget =-     Convolution1D-   | Convolution2D-   | Separable2D-   deriving ( Eq, Ord, Show )--marshalConvolutionTarget :: ConvolutionTarget -> GLenum-marshalConvolutionTarget x = case x of-   Convolution1D -> 0x8010-   Convolution2D -> 0x8011-   Separable2D -> 0x8012--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--EXTENSION_ENTRY("GL_ARB_imaging",glConvolutionFilter1D,GLenum -> GLenum -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------getConvolutionFilter1D :: PixelData a -> IO ()-getConvolutionFilter1D = getConvolutionFilter Convolution1D--getConvolutionFilter :: ConvolutionTarget -> PixelData a -> IO ()-getConvolutionFilter t pd =-   withPixelData pd $ glGetConvolutionFilter (marshalConvolutionTarget t)--EXTENSION_ENTRY("GL_ARB_imaging",glGetConvolutionFilter,GLenum -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------convolutionFilter2D :: PixelInternalFormat -> Size -> PixelData a -> IO ()-convolutionFilter2D int (Size w h) pd =-   withPixelData pd $-      glConvolutionFilter2D-         (marshalConvolutionTarget Convolution2D)-         (marshalPixelInternalFormat' int) w h--EXTENSION_ENTRY("GL_ARB_imaging",glConvolutionFilter2D,GLenum -> GLenum -> GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------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--EXTENSION_ENTRY("GL_ARB_imaging",glSeparableFilter2D,GLenum -> GLenum -> GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> Ptr a -> IO ())------------------------------------------------------------------------------------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--EXTENSION_ENTRY("GL_ARB_imaging",glGetSeparableFilter,GLenum -> GLenum -> GLenum -> Ptr a -> Ptr a -> Ptr a -> IO ())------------------------------------------------------------------------------------copyConvolutionFilter1D :: PixelInternalFormat -> Position -> GLsizei -> IO ()-copyConvolutionFilter1D int (Position x y) =-   glCopyConvolutionFilter1D-      (marshalConvolutionTarget Convolution1D) (marshalPixelInternalFormat' int)-      x y--EXTENSION_ENTRY("GL_ARB_imaging",glCopyConvolutionFilter1D,GLenum -> GLenum -> GLint -> GLint -> GLsizei -> IO ())------------------------------------------------------------------------------------copyConvolutionFilter2D :: PixelInternalFormat -> Position -> Size -> IO ()-copyConvolutionFilter2D int (Position x y) (Size w h) =-   glCopyConvolutionFilter2D-      (marshalConvolutionTarget Convolution2D) (marshalPixelInternalFormat' int)-      x y w h--EXTENSION_ENTRY("GL_ARB_imaging",glCopyConvolutionFilter2D,GLenum -> GLenum -> GLint -> GLint -> GLsizei -> GLsizei -> IO ())------------------------------------------------------------------------------------data ConvolutionParameter =-     ConvolutionBorderColor-   | ConvolutionBorderMode-   | ConvolutionFilterScale-   | ConvolutionFilterBias-   | ConvolutionFormat-   | ConvolutionWidth-   | ConvolutionHeight-   | MaxConvolutionWidth-   | MaxConvolutionHeight-   deriving ( Eq, Ord, Show )--marshalConvolutionParameter :: ConvolutionParameter -> GLenum-marshalConvolutionParameter x = case x of-   ConvolutionBorderColor -> 0x8154-   ConvolutionBorderMode -> 0x8013-   ConvolutionFilterScale -> 0x8014-   ConvolutionFilterBias -> 0x8015-   ConvolutionFormat -> 0x8017-   ConvolutionWidth -> 0x8018-   ConvolutionHeight -> 0x8019-   MaxConvolutionWidth -> 0x801a-   MaxConvolutionHeight -> 0x801b------------------------------------------------------------------------------------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--EXTENSION_ENTRY("GL_ARB_imaging",glGetConvolutionParameteriv,GLenum -> GLenum -> Ptr GLint -> IO ())------------------------------------------------------------------------------------data ConvolutionBorderMode' =-     Reduce'-   | ConstantBorder'-   | ReplicateBorder'--marshalConvolutionBorderMode' :: ConvolutionBorderMode' -> GLint-marshalConvolutionBorderMode' x = case x of-   Reduce' -> 0x8016-   ConstantBorder' -> 0x8151-   ReplicateBorder' -> 0x8153--unmarshalConvolutionBorderMode' :: GLint -> ConvolutionBorderMode'-unmarshalConvolutionBorderMode' x-   | x == 0x8016 = Reduce'-   | x == 0x8151 = ConstantBorder'-   | x == 0x8153 = ReplicateBorder'-   | otherwise = error ("unmarshalConvolutionBorderMode': illegal value " ++ show 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)--EXTENSION_ENTRY("GL_ARB_imaging",glConvolutionParameteri,GLenum -> GLenum -> GLint -> IO ())------------------------------------------------------------------------------------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) buf-      peek buf--EXTENSION_ENTRY("GL_ARB_imaging",glGetConvolutionParameterfv,GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ())--convolutionParameterC4f ::-   ConvolutionTarget -> ConvolutionParameter -> Color4 GLfloat -> IO ()-convolutionParameterC4f t p c =-   with c $-      glConvolutionParameterfv-         (marshalConvolutionTarget t) (marshalConvolutionParameter p)--EXTENSION_ENTRY("GL_ARB_imaging",glConvolutionParameterfv,GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ())
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs 
@@ -1,157 +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 Foreign.Marshal.Alloc ( alloca )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapHistogram), makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLenum, GLint, GLsizei )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization (-    PixelData(..) )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (-   PixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.PixelData ( withPixelData )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   marshalPixelInternalFormat', unmarshalPixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable ( Proxy(..) )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink (-   Sink(..), marshalSink, unmarshalSink )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset (-   Reset(..), marshalReset )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------data HistogramTarget =-     Histogram-   | ProxyHistogram--marshalHistogramTarget :: HistogramTarget -> GLenum-marshalHistogramTarget x = case x of-   Histogram -> 0x8024-   ProxyHistogram -> 0x8025--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--EXTENSION_ENTRY("GL_ARB_imaging",glGetHistogramParameteriv,GLenum -> GLenum -> Ptr GLint -> IO ())--setHistogram :: Proxy -> (GLsizei, PixelInternalFormat, Sink) -> IO ()-setHistogram proxy (w, int, sink) =-   glHistogram-      (marshalHistogramTarget (proxyToHistogramTarget proxy))-      w-      (marshalPixelInternalFormat' int)-      (marshalSink sink)-         -EXTENSION_ENTRY("GL_ARB_imaging",glHistogram,GLenum -> GLsizei -> GLenum -> GLboolean -> IO ())------------------------------------------------------------------------------------getHistogram :: Reset -> PixelData a -> IO ()-getHistogram reset pd =-   withPixelData pd $-      glGetHistogram-         (marshalHistogramTarget Histogram)-         (marshalReset reset)--EXTENSION_ENTRY("GL_ARB_imaging",glGetHistogram,GLenum -> GLboolean -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------resetHistogram :: IO ()-resetHistogram = glResetHistogram (marshalHistogramTarget Histogram)--EXTENSION_ENTRY("GL_ARB_imaging",glResetHistogram,GLenum -> IO ())------------------------------------------------------------------------------------data GetHistogramParameterPName =-     HistogramWidth-   | HistogramFormat-   | HistogramRedSize-   | HistogramGreenSize-   | HistogramBlueSize-   | HistogramAlphaSize-   | HistogramLuminanceSize-   | HistogramSink--marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum-marshalGetHistogramParameterPName x = case x of-   HistogramWidth -> 0x8026-   HistogramFormat -> 0x8027-   HistogramRedSize -> 0x8028-   HistogramGreenSize -> 0x8029-   HistogramBlueSize -> 0x802a-   HistogramAlphaSize -> 0x802b-   HistogramLuminanceSize -> 0x802c-   HistogramSink -> 0x802d------------------------------------------------------------------------------------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 id proxy HistogramLuminanceSize
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs 
@@ -1,114 +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 Foreign.Marshal.Alloc ( alloca )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapMinmax), makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLboolean, GLenum, GLint )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (-   PixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization (-    PixelData(..) )-import Graphics.Rendering.OpenGL.GL.PixelData ( withPixelData )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   marshalPixelInternalFormat', unmarshalPixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram (-   Reset(..), Sink )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset (-   marshalReset )-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink (-   marshalSink, unmarshalSink )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------data MinmaxTarget =-     Minmax--marshalMinmaxTarget :: MinmaxTarget -> GLenum-marshalMinmaxTarget x = case x of-   Minmax -> 0x802e------------------------------------------------------------------------------------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)--EXTENSION_ENTRY("GL_ARB_imaging",glMinmax,GLenum -> GLenum -> GLboolean -> IO ())------------------------------------------------------------------------------------getMinmax :: Reset -> PixelData a -> IO ()-getMinmax reset pd =-   withPixelData pd $-      glGetMinmax (marshalMinmaxTarget Minmax) (marshalReset reset)--EXTENSION_ENTRY("GL_ARB_imaging",glGetMinmax,GLenum -> GLboolean -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------resetMinmax :: IO ()-resetMinmax = glResetMinmax (marshalMinmaxTarget Minmax)--EXTENSION_ENTRY("GL_ARB_imaging",glResetMinmax,GLenum -> IO ())------------------------------------------------------------------------------------data GetMinmaxParameterPName =-     MinmaxFormat-   | MinmaxSink--marshalGetMinmaxParameterPName :: GetMinmaxParameterPName -> GLenum-marshalGetMinmaxParameterPName x = case x of-   MinmaxFormat -> 0x802f-   MinmaxSink -> 0x8030------------------------------------------------------------------------------------getMinmaxParameteri :: (GLint -> a) -> GetMinmaxParameterPName -> IO a-getMinmaxParameteri f p =-   alloca $ \buf -> do-      glGetMinmaxParameteriv-         (marshalMinmaxTarget Minmax)-         (marshalGetMinmaxParameterPName p)-         buf-      peek1 f buf--EXTENSION_ENTRY("GL_ARB_imaging",glGetMinmaxParameteriv,GLenum -> GLenum -> Ptr GLint -> IO ())
− Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs 
@@ -1,244 +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 ( zipWith4 )-import Data.Word-import Foreign.ForeignPtr ( ForeignPtr, mallocForeignPtrArray, withForeignPtr )-import Foreign.Marshal.Array ( allocaArray, peekArray, pokeArray, withArrayLen )-import Foreign.Ptr ( Ptr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLushort, GLuint, GLsizei, GLfloat )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetMaxPixelMapTable,GetPixelMapIToISize,GetPixelMapSToSSize,-            GetPixelMapIToRSize,GetPixelMapIToGSize,GetPixelMapIToBSize,-            GetPixelMapIToASize,GetPixelMapRToRSize,GetPixelMapGToGSize,-            GetPixelMapBToBSize,GetPixelMapAToASize),-   getInteger1, getSizei1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasSetter(($=)), HasGetter(get), GettableStateVar, makeGettableStateVar,-   StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) )------------------------------------------------------------------------------------#include "HsOpenGLTypes.h"------------------------------------------------------------------------------------data PixelMapTarget =-     IToI-   | SToS-   | IToR-   | IToG-   | IToB-   | IToA-   | RToR-   | GToG-   | BToB-   | AToA--marshalPixelMapTarget :: PixelMapTarget -> GLenum-marshalPixelMapTarget x = case x of-   IToI -> 0xc70-   SToS -> 0xc71-   IToR -> 0xc72-   IToG -> 0xc73-   IToB -> 0xc74-   IToA -> 0xc75-   RToR -> 0xc76-   GToG -> 0xc77-   BToB -> 0xc78-   AToA -> 0xc79--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--foreign import CALLCONV unsafe "glGetPixelMapusv" glGetPixelMapusv ::-   GLenum -> Ptr GLushort -> IO ()--foreign import CALLCONV unsafe "glPixelMapusv" glPixelMapusv ::-   GLenum -> GLsizei -> Ptr GLushort -> IO ()--instance PixelMapComponent GLuint_ where-   getPixelMapv = glGetPixelMapuiv-   pixelMapv = glPixelMapuiv--foreign import CALLCONV unsafe "glGetPixelMapuiv" glGetPixelMapuiv ::-   GLenum -> Ptr GLuint -> IO ()--foreign import CALLCONV unsafe "glPixelMapuiv" glPixelMapuiv ::-   GLenum -> GLsizei -> Ptr GLuint -> IO ()--instance PixelMapComponent GLfloat_ where-   getPixelMapv = glGetPixelMapfv-   pixelMapv = glPixelMapfv--foreign import CALLCONV unsafe "glGetPixelMapfv" glGetPixelMapfv ::-   GLenum -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glPixelMapfv" glPixelMapfv ::-   GLenum -> GLsizei -> Ptr GLfloat -> IO ()------------------------------------------------------------------------------------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)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq (GLpixelmap a)-instance Ord (GLpixelmap a)-instance Show (GLpixelmap a)-#else-   deriving ( Eq, Ord, Show )-#endif--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,128 +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 Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLint )-import Graphics.Rendering.OpenGL.GL.GLboolean (-   marshalGLboolean, unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetUnpackSwapBytes,GetUnpackLSBFirst,GetUnpackRowLength,-            GetUnpackSkipRows,GetUnpackSkipPixels,GetUnpackAlignment,-            GetUnpackImageHeight,GetUnpackSkipImages,GetPackSwapBytes,-            GetPackLSBFirst,GetPackRowLength,GetPackSkipRows,GetPackSkipPixels,-            GetPackAlignment,GetPackImageHeight,GetPackSkipImages),-   getBoolean1, getInteger1 )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )------------------------------------------------------------------------------------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 -> 0xcf0-   UnpackLSBFirst -> 0xcf1-   UnpackRowLength -> 0xcf2-   UnpackSkipRows -> 0xcf3-   UnpackSkipPixels -> 0xcf4-   UnpackAlignment -> 0xcf5-   PackSwapBytes -> 0xd00-   PackLSBFirst -> 0xd01-   PackRowLength -> 0xd02-   PackSkipRows -> 0xd03-   PackSkipPixels -> 0xd04-   PackAlignment -> 0xd05-   PackSkipImages -> 0x806b-   PackImageHeight -> 0x806c-   UnpackSkipImages -> 0x806d-   UnpackImageHeight -> 0x806e------------------------------------------------------------------------------------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))--foreign import CALLCONV unsafe "glPixelStorei" glPixelStorei ::-   GLenum -> GLint -> IO ()
− Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs 
@@ -1,253 +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 Graphics.Rendering.OpenGL.GL.Capability (-   marshalCapability, unmarshalCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetMapColor,GetMapStencil,GetIndexShift,GetIndexOffset,-            GetRedScale,GetGreenScale,GetBlueScale,GetAlphaScale,GetDepthScale,-            GetRedBias,GetGreenBias,GetBlueBias,GetAlphaBias,GetDepthBias,-            GetPostConvolutionRedScale,GetPostConvolutionGreenScale,-            GetPostConvolutionBlueScale,GetPostConvolutionAlphaScale,-            GetPostConvolutionRedBias,GetPostConvolutionGreenBias,-            GetPostConvolutionBlueBias,GetPostConvolutionAlphaBias,-            GetPostColorMatrixRedScale,GetPostColorMatrixGreenScale,-            GetPostColorMatrixBlueScale,GetPostColorMatrixAlphaScale,-            GetPostColorMatrixRedBias,GetPostColorMatrixGreenBias,-            GetPostColorMatrixBlueBias,GetPostColorMatrixAlphaBias),-   getBoolean1, getInteger1, getFloat1 )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) )------------------------------------------------------------------------------------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 -> 0xd10-   MapStencil -> 0xd11-   IndexShift -> 0xd12-   IndexOffset -> 0xd13-   RedScale -> 0xd14-   RedBias -> 0xd15-   GreenScale -> 0xd18-   GreenBias -> 0xd19-   BlueScale -> 0xd1a-   BlueBias -> 0xd1b-   AlphaScale -> 0xd1c-   AlphaBias -> 0xd1d-   DepthScale -> 0xd1e-   DepthBias -> 0xd1f-   PostConvolutionRedScale -> 0x801c-   PostConvolutionGreenScale -> 0x801d-   PostConvolutionBlueScale -> 0x801e-   PostConvolutionAlphaScale -> 0x801f-   PostConvolutionRedBias -> 0x8020-   PostConvolutionGreenBias -> 0x8021-   PostConvolutionBlueBias -> 0x8022-   PostConvolutionAlphaBias -> 0x8023-   PostColorMatrixRedScale -> 0x80b4-   PostColorMatrixGreenScale -> 0x80b5-   PostColorMatrixBlueScale -> 0x80b6-   PostColorMatrixAlphaScale -> 0x80b7-   PostColorMatrixRedBias -> 0x80b8-   PostColorMatrixGreenBias -> 0x80b9-   PostColorMatrixBlueBias -> 0x80ba-   PostColorMatrixAlphaBias -> 0x80bb------------------------------------------------------------------------------------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))--foreign import CALLCONV unsafe "glPixelTransferi" glPixelTransferi ::-   GLenum -> GLint -> IO ()--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--foreign import CALLCONV unsafe "glPixelTransferf" glPixelTransferf ::-   GLenum -> GLfloat -> IO ()
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs 
@@ -1,47 +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 ( liftM2 )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLsizei, GLfloat )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )-import Graphics.Rendering.OpenGL.GL.PixelData ( PixelData(..), withPixelData )-import Graphics.Rendering.OpenGL.GL.PixelFormat ( PixelFormat(..) )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetZoomX,GetZoomY), getFloat1 )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )------------------------------------------------------------------------------------drawPixels :: Size -> PixelData a -> IO ()-drawPixels (Size w h) pd = withPixelData pd $ glDrawPixels w h--foreign import CALLCONV unsafe "glDrawPixels" glDrawPixels ::-   GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------pixelZoom :: StateVar (GLfloat, GLfloat)-pixelZoom =-   makeStateVar-      (liftM2 (,) (getFloat1 id GetZoomX) (getFloat1 id GetZoomY))-      (uncurry glPixelZoom)--foreign import CALLCONV unsafe "glPixelZoom" glPixelZoom ::-   GLfloat -> GLfloat -> IO ()
− 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.BasicTypes ( GLboolean )-import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )------------------------------------------------------------------------------------data Reset =-     NoReset-   | Reset-   deriving ( Eq, Ord, Show )--marshalReset :: Reset -> GLboolean-marshalReset x = marshalGLboolean (x == Reset)
− Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs 
@@ -1,35 +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.BasicTypes ( GLboolean, GLint )-import Graphics.Rendering.OpenGL.GL.GLboolean (-   marshalGLboolean, unmarshalGLboolean )------------------------------------------------------------------------------------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,54 +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 ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLfloat )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------data PointParameter =-     PointSizeMin-   | PointSizeMax-   | PointFadeThresholdSize-   | PointDistanceAttenuation--marshalPointParameter :: PointParameter -> GLenum-marshalPointParameter x = case x of-   PointSizeMin -> 0x8126-   PointSizeMax -> 0x8127-   PointFadeThresholdSize -> 0x8128-   PointDistanceAttenuation -> 0x8129------------------------------------------------------------------------------------pointParameterf :: PointParameter -> GLfloat -> IO ()-pointParameterf = glPointParameterfARB . marshalPointParameter--EXTENSION_ENTRY("GL_ARB_point_parameters or OpenGL 1.4",glPointParameterfARB,GLenum -> GLfloat -> IO ())--pointParameterfv :: PointParameter -> Ptr GLfloat -> IO ()-pointParameterfv = glPointParameterfvARB . marshalPointParameter--EXTENSION_ENTRY("GL_ARB_point_parameters or OpenGL 1.4",glPointParameterfvARB,GLenum -> Ptr GLfloat -> IO ())
− Graphics/Rendering/OpenGL/GL/Points.hs 
@@ -1,227 +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 ( liftM2 )-import Foreign.Marshal.Array ( withArray )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapVertexProgramPointSize,CapPointSmooth,CapPointSprite),-   makeCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetPointSize,GetAliasedPointSizeRange,GetSmoothPointSizeRange,-            GetSmoothPointSizeGranularity,GetPointSizeMin,GetPointSizeMax,-            GetPointDistanceAttenuation,GetPointFadeThresholdSize),-   getFloat1, getFloat2, getFloat3 )-import Graphics.Rendering.OpenGL.GL.PointParameter (-   PointParameter(..), pointParameterf, pointParameterfv )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-------------------------------------------------------------------------------------- | '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--foreign import CALLCONV unsafe "glPointSize" glPointSize :: GLfloat -> IO ()------------------------------------------------------------------------------------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.BasicTypes.Disabled'.--pointSmooth :: StateVar Capability-pointSmooth = makeCapability CapPointSmooth-------------------------------------------------------------------------------------- | Controls whether point sprites are enabled. The initial state is--- 'Graphics.Rendering.OpenGL.GL.BasicTypes.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.GL.BasicTypes ( GLenum )------------------------------------------------------------------------------------data PolygonMode =-     Point-   | Line-   | Fill-   deriving ( Eq, Ord, Show )--marshalPolygonMode :: PolygonMode -> GLenum-marshalPolygonMode x = case x of-   Point -> 0x1b00-   Line -> 0x1b01-   Fill -> 0x1b02--unmarshalPolygonMode :: GLenum -> PolygonMode-unmarshalPolygonMode x-   | x == 0x1b00 = Point-   | x == 0x1b01 = Line-   | x == 0x1b02 = Fill-   | otherwise = error ("unmarshalPolygonMode: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/Polygons.hs 
@@ -1,163 +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 ( liftM2 )-import Foreign.ForeignPtr ( ForeignPtr, mallocForeignPtrArray, withForeignPtr )-import Foreign.Marshal.Array ( allocaArray, withArray, peekArray, pokeArray )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapPolygonSmooth,CapCullFace,CapPolygonStipple,-             CapPolygonOffsetPoint,CapPolygonOffsetLine,CapPolygonOffsetFill),-   makeCapability, makeStateVarMaybe )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLubyte, GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.Face ( marshalFace, unmarshalFace )-import Graphics.Rendering.OpenGL.GL.Colors ( Face(..) )-import Graphics.Rendering.OpenGL.GL.PixelRectangles (-   PixelStoreDirection(..), rowLength, skipRows, skipPixels )-import Graphics.Rendering.OpenGL.GL.PolygonMode (-   PolygonMode(..), marshalPolygonMode, unmarshalPolygonMode )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetCullFaceMode,GetPolygonMode,GetPolygonOffsetFactor,-            GetPolygonOffsetUnits),-   getInteger2, getEnum1, getFloat1 )-import Graphics.Rendering.OpenGL.GL.SavingState (-   ClientAttributeGroup(PixelStoreAttributes), preservingClientAttrib )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasSetter(($=)), StateVar, makeStateVar )------------------------------------------------------------------------------------polygonSmooth :: StateVar Capability-polygonSmooth = makeCapability CapPolygonSmooth------------------------------------------------------------------------------------cullFace :: StateVar (Maybe Face)-cullFace = makeStateVarMaybe (return CapCullFace)-                             (getEnum1 unmarshalFace GetCullFaceMode)-                             (glCullFace . marshalFace)--foreign import CALLCONV unsafe "glCullFace" glCullFace :: GLenum -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetPolygonStipple" glGetPolygonStipple ::-   Ptr GLubyte -> IO ()--foreign import CALLCONV unsafe "glPolygonStipple" glPolygonStipple ::-   Ptr GLubyte -> IO ()------------------------------------------------------------------------------------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 )--foreign import CALLCONV unsafe "glPolygonMode" glPolygonMode ::-   GLenum -> GLenum -> IO ()------------------------------------------------------------------------------------polygonOffset :: StateVar (GLfloat, GLfloat)-polygonOffset =-   makeStateVar (liftM2 (,) (getFloat1 id GetPolygonOffsetFactor)-                            (getFloat1 id GetPolygonOffsetUnits))-                (uncurry glPolygonOffset)--foreign import CALLCONV unsafe "glPolygonOffset" glPolygonOffset ::-   GLfloat -> GLfloat -> IO ()------------------------------------------------------------------------------------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,96 +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.GL.BasicTypes ( GLenum )-------------------------------------------------------------------------------------- | 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 -> 0x0-   Lines -> 0x1-   LineLoop -> 0x2-   LineStrip -> 0x3-   Triangles -> 0x4-   TriangleStrip -> 0x5-   TriangleFan -> 0x6-   Quads -> 0x7-   QuadStrip -> 0x8-   Polygon -> 0x9--unmarshalPrimitiveMode :: GLenum -> PrimitiveMode-unmarshalPrimitiveMode x-   | x == 0x0 = Points-   | x == 0x1 = Lines-   | x == 0x2 = LineLoop-   | x == 0x3 = LineStrip-   | x == 0x4 = Triangles-   | x == 0x5 = TriangleStrip-   | x == 0x6 = TriangleFan-   | x == 0x7 = Quads-   | x == 0x8 = QuadStrip-   | x == 0x9 = Polygon-   | otherwise = error ("unmarshalPrimitiveMode: illegal value " ++ show x)
− Graphics/Rendering/OpenGL/GL/QueryUtils.hs 
@@ -1,1056 +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,-   getFloat1, getFloat2, getFloat3, getFloat4, getFloatv,-   getDouble1, getDouble2, getDouble4, getDoublev,-   maybeNullPtr,-   AttribLocation(..), GetVertexAttribPName(..),-   getVertexAttribInteger1, getVertexAttribEnum1, getVertexAttribBoolean1,-   getVertexAttribFloat4, getVertexAttribIInteger4, getVertexAttribIuInteger4, -   GetVertexAttribPointerPName(..), getVertexAttribPointer-) where--import Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( allocaArray )-import Foreign.Ptr ( Ptr, nullPtr )-import Foreign.Storable ( Storable(peek) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLenum, GLint, GLsizei, GLuint, GLfloat, GLdouble )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1, peek2, peek3, peek4 )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidEnum )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------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-   | 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--marshalGetPName :: GetPName -> Maybe GLenum-marshalGetPName x = case x of-   GetCurrentColor -> Just 0xb00-   GetCurrentIndex -> Just 0xb01-   GetCurrentNormal -> Just 0xb02-   GetCurrentTextureCoords -> Just 0xb03-   GetCurrentRasterColor -> Just 0xb04-   GetCurrentRasterSecondaryColor -> Just 0x845f-   GetCurrentRasterIndex -> Just 0xb05-   GetCurrentRasterTextureCoords -> Just 0xb06-   GetCurrentRasterPosition -> Just 0xb07-   GetCurrentRasterPositionValid -> Just 0xb08-   GetCurrentRasterDistance -> Just 0xb09-   GetCurrentMatrixIndex -> Just 0x8845-   GetPointSmooth -> Just 0xb10-   GetPointSize -> Just 0xb11-   GetPointSizeRange -> Just 0xb12-   GetPointSizeGranularity -> Just 0xb13-   GetLineSmooth -> Just 0xb20-   GetLineWidth -> Just 0xb21-   GetLineWidthRange -> Just 0xb22-   GetLineWidthGranularity -> Just 0xb23-   GetLineStipple -> Just 0xb24-   GetLineStipplePattern -> Just 0xb25-   GetLineStippleRepeat -> Just 0xb26-   GetSmoothPointSizeRange -> Just 0xb12-   GetSmoothPointSizeGranularity -> Just 0xb13-   GetSmoothLineWidthRange -> Just 0xb22-   GetSmoothLineWidthGranularity -> Just 0xb23-   GetAliasedPointSizeRange -> Just 0x846d-   GetAliasedLineWidthRange -> Just 0x846e-   GetListMode -> Just 0xb30-   GetMaxListNesting -> Just 0xb31-   GetListBase -> Just 0xb32-   GetListIndex -> Just 0xb33-   GetPolygonMode -> Just 0xb40-   GetPolygonSmooth -> Just 0xb41-   GetPolygonStipple -> Just 0xb42-   GetEdgeFlag -> Just 0xb43-   GetCullFace -> Just 0xb44-   GetCullFaceMode -> Just 0xb45-   GetFrontFace -> Just 0xb46-   GetLighting -> Just 0xb50-   GetLightModelLocalViewer -> Just 0xb51-   GetLightModelTwoSide -> Just 0xb52-   GetLightModelAmbient -> Just 0xb53-   GetShadeModel -> Just 0xb54-   GetColorMaterialFace -> Just 0xb55-   GetColorMaterialParameter -> Just 0xb56-   GetColorMaterial -> Just 0xb57-   GetFog -> Just 0xb60-   GetFogIndex -> Just 0xb61-   GetFogDensity -> Just 0xb62-   GetFogStart -> Just 0xb63-   GetFogEnd -> Just 0xb64-   GetFogMode -> Just 0xb65-   GetFogColor -> Just 0xb66-   GetFogCoordSrc -> Just 0x8450-   GetCurrentFogCoord -> Just 0x8453-   GetDepthRange -> Just 0xb70-   GetDepthTest -> Just 0xb71-   GetDepthWritemask -> Just 0xb72-   GetDepthClearValue -> Just 0xb73-   GetDepthFunc -> Just 0xb74-   GetAccumClearValue -> Just 0xb80-   GetStencilTest -> Just 0xb90-   GetStencilClearValue -> Just 0xb91-   GetStencilFunc -> Just 0xb92-   GetStencilValueMask -> Just 0xb93-   GetStencilFail -> Just 0xb94-   GetStencilPassDepthFail -> Just 0xb95-   GetStencilPassDepthPass -> Just 0xb96-   GetStencilRef -> Just 0xb97-   GetStencilWritemask -> Just 0xb98-   GetMatrixMode -> Just 0xba0-   GetNormalize -> Just 0xba1-   GetViewport -> Just 0xba2-   GetModelviewStackDepth -> Just 0xba3-   GetProjectionStackDepth -> Just 0xba4-   GetTextureStackDepth -> Just 0xba5-   GetModelviewMatrix -> Just 0xba6-   GetProjectionMatrix -> Just 0xba7-   GetTextureMatrix -> Just 0xba8-   GetAttribStackDepth -> Just 0xbb0-   GetClientAttribStackDepth -> Just 0xbb1-   GetAlphaTest -> Just 0xbc0-   GetAlphaTestFunc -> Just 0xbc1-   GetAlphaTestRef -> Just 0xbc2-   GetDither -> Just 0xbd0-   GetBlendDst -> Just 0xbe0-   GetBlendSrc -> Just 0xbe1-   GetBlend -> Just 0xbe2-   GetLogicOpMode -> Just 0xbf0-   GetIndexLogicOp -> Just 0xbf1-   GetLogicOp -> Just 0xbf1-   GetColorLogicOp -> Just 0xbf2-   GetAuxBuffers -> Just 0xc00-   GetDrawBuffer -> Just 0xc01-   GetReadBuffer -> Just 0xc02-   GetScissorBox -> Just 0xc10-   GetScissorTest -> Just 0xc11-   GetIndexClearValue -> Just 0xc20-   GetIndexWritemask -> Just 0xc21-   GetColorClearValue -> Just 0xc22-   GetColorWritemask -> Just 0xc23-   GetIndexMode -> Just 0xc30-   GetRGBAMode -> Just 0xc31-   GetDoublebuffer -> Just 0xc32-   GetStereo -> Just 0xc33-   GetRenderMode -> Just 0xc40-   GetPerspectiveCorrectionHint -> Just 0xc50-   GetPointSmoothHint -> Just 0xc51-   GetLineSmoothHint -> Just 0xc52-   GetPolygonSmoothHint -> Just 0xc53-   GetFogHint -> Just 0xc54-   GetGenerateMipmapHint -> Just 0x8192-   GetTextureCompressionHint -> Just 0x84ef-   GetTextureGenS -> Just 0xc60-   GetTextureGenT -> Just 0xc61-   GetTextureGenR -> Just 0xc62-   GetTextureGenQ -> Just 0xc63-   GetPixelMapIToISize -> Just 0xcb0-   GetPixelMapSToSSize -> Just 0xcb1-   GetPixelMapIToRSize -> Just 0xcb2-   GetPixelMapIToGSize -> Just 0xcb3-   GetPixelMapIToBSize -> Just 0xcb4-   GetPixelMapIToASize -> Just 0xcb5-   GetPixelMapRToRSize -> Just 0xcb6-   GetPixelMapGToGSize -> Just 0xcb7-   GetPixelMapBToBSize -> Just 0xcb8-   GetPixelMapAToASize -> Just 0xcb9-   GetUnpackSwapBytes -> Just 0xcf0-   GetUnpackLSBFirst -> Just 0xcf1-   GetUnpackRowLength -> Just 0xcf2-   GetUnpackSkipRows -> Just 0xcf3-   GetUnpackSkipPixels -> Just 0xcf4-   GetUnpackAlignment -> Just 0xcf5-   GetPackSwapBytes -> Just 0xd00-   GetPackLSBFirst -> Just 0xd01-   GetPackRowLength -> Just 0xd02-   GetPackSkipRows -> Just 0xd03-   GetPackSkipPixels -> Just 0xd04-   GetPackAlignment -> Just 0xd05-   GetMapColor -> Just 0xd10-   GetMapStencil -> Just 0xd11-   GetIndexShift -> Just 0xd12-   GetIndexOffset -> Just 0xd13-   GetRedScale -> Just 0xd14-   GetRedBias -> Just 0xd15-   GetZoomX -> Just 0xd16-   GetZoomY -> Just 0xd17-   GetGreenScale -> Just 0xd18-   GetGreenBias -> Just 0xd19-   GetBlueScale -> Just 0xd1a-   GetBlueBias -> Just 0xd1b-   GetAlphaScale -> Just 0xd1c-   GetAlphaBias -> Just 0xd1d-   GetDepthScale -> Just 0xd1e-   GetDepthBias -> Just 0xd1f-   GetMaxEvalOrder -> Just 0xd30-   GetMaxLights -> Just 0xd31-   GetMaxClipPlanes -> Just 0xd32-   GetMaxTextureSize -> Just 0xd33-   GetMaxPixelMapTable -> Just 0xd34-   GetMaxAttribStackDepth -> Just 0xd35-   GetMaxModelviewStackDepth -> Just 0xd36-   GetMaxNameStackDepth -> Just 0xd37-   GetMaxProjectionStackDepth -> Just 0xd38-   GetMaxTextureStackDepth -> Just 0xd39-   GetMaxViewportDims -> Just 0xd3a-   GetMaxClientAttribStackDepth -> Just 0xd3b-   GetSubpixelBits -> Just 0xd50-   GetIndexBits -> Just 0xd51-   GetRedBits -> Just 0xd52-   GetGreenBits -> Just 0xd53-   GetBlueBits -> Just 0xd54-   GetAlphaBits -> Just 0xd55-   GetDepthBits -> Just 0xd56-   GetStencilBits -> Just 0xd57-   GetAccumRedBits -> Just 0xd58-   GetAccumGreenBits -> Just 0xd59-   GetAccumBlueBits -> Just 0xd5a-   GetAccumAlphaBits -> Just 0xd5b-   GetNameStackDepth -> Just 0xd70-   GetAutoNormal -> Just 0xd80-   GetMap1Color4 -> Just 0xd90-   GetMap1Index -> Just 0xd91-   GetMap1Normal -> Just 0xd92-   GetMap1TextureCoord1 -> Just 0xd93-   GetMap1TextureCoord2 -> Just 0xd94-   GetMap1TextureCoord3 -> Just 0xd95-   GetMap1TextureCoord4 -> Just 0xd96-   GetMap1Vertex3 -> Just 0xd97-   GetMap1Vertex4 -> Just 0xd98-   GetMap2Color4 -> Just 0xdb0-   GetMap2Index -> Just 0xdb1-   GetMap2Normal -> Just 0xdb2-   GetMap2TextureCoord1 -> Just 0xdb3-   GetMap2TextureCoord2 -> Just 0xdb4-   GetMap2TextureCoord3 -> Just 0xdb5-   GetMap2TextureCoord4 -> Just 0xdb6-   GetMap2Vertex3 -> Just 0xdb7-   GetMap2Vertex4 -> Just 0xdb8-   GetMap1GridDomain -> Just 0xdd0-   GetMap1GridSegments -> Just 0xdd1-   GetMap2GridDomain -> Just 0xdd2-   GetMap2GridSegments -> Just 0xdd3-   GetTexture1D -> Just 0xde0-   GetTexture2D -> Just 0xde1-   GetFeedbackBufferSize -> Just 0xdf1-   GetFeedbackBufferType -> Just 0xdf2-   GetSelectionBufferSize -> Just 0xdf4-   GetPolygonOffsetUnits -> Just 0x2a00-   GetPolygonOffsetPoint -> Just 0x2a01-   GetPolygonOffsetLine -> Just 0x2a02-   GetPolygonOffsetFill -> Just 0x8037-   GetPolygonOffsetFactor -> Just 0x8038-   GetTextureBinding1D -> Just 0x8068-   GetTextureBinding2D -> Just 0x8069-   GetTextureBinding3D -> Just 0x806a-   GetVertexArray -> Just 0x8074-   GetNormalArray -> Just 0x8075-   GetColorArray -> Just 0x8076-   GetIndexArray -> Just 0x8077-   GetTextureCoordArray -> Just 0x8078-   GetEdgeFlagArray -> Just 0x8079-   GetFogCoordArray -> Just 0x8457-   GetSecondaryColorArray -> Just 0x845e-   GetMatrixIndexArray -> Just 0x8844-   GetVertexArraySize -> Just 0x807a-   GetVertexArrayType -> Just 0x807b-   GetVertexArrayStride -> Just 0x807c-   GetNormalArrayType -> Just 0x807e-   GetNormalArrayStride -> Just 0x807f-   GetColorArraySize -> Just 0x8081-   GetColorArrayType -> Just 0x8082-   GetColorArrayStride -> Just 0x8083-   GetIndexArrayType -> Just 0x8085-   GetIndexArrayStride -> Just 0x8086-   GetTextureCoordArraySize -> Just 0x8088-   GetTextureCoordArrayType -> Just 0x8089-   GetTextureCoordArrayStride -> Just 0x808a-   GetEdgeFlagArrayStride -> Just 0x808c-   GetFogCoordArrayType -> Just 0x8454-   GetFogCoordArrayStride -> Just 0x8455-   GetSecondaryColorArraySize -> Just 0x845a-   GetSecondaryColorArrayType -> Just 0x845b-   GetSecondaryColorArrayStride -> Just 0x845c-   GetMatrixIndexArraySize -> Just 0x8846-   GetMatrixIndexArrayType -> Just 0x8847-   GetMatrixIndexArrayStride -> Just 0x8848-   GetClipPlane i -> clipPlaneIndexToEnum i-   GetLight i -> lightIndexToEnum i-   GetTransposeModelviewMatrix -> Just 0x84e3-   GetTransposeProjectionMatrix -> Just 0x84e4-   GetTransposeTextureMatrix -> Just 0x84e5-   GetTransposeColorMatrix -> Just 0x84e6-   GetLightModelColorControl -> Just 0x81f8-   GetBlendColor -> Just 0x8005-   GetBlendEquation -> Just 0x8009-   GetBlendEquationAlpha -> Just 0x883d-   GetColorTable -> Just 0x80d0-   GetPostConvolutionColorTable -> Just 0x80d1-   GetPostColorMatrixColorTable -> Just 0x80d2-   GetConvolution1D -> Just 0x8010-   GetConvolution2D -> Just 0x8011-   GetSeparable2D -> Just 0x8012-   GetMaxConvolutionWidth -> Just 0x801a-   GetMaxConvolutionHeight -> Just 0x801b-   GetPostConvolutionRedScale -> Just 0x801c-   GetPostConvolutionGreenScale -> Just 0x801d-   GetPostConvolutionBlueScale -> Just 0x801e-   GetPostConvolutionAlphaScale -> Just 0x801f-   GetPostConvolutionRedBias -> Just 0x8020-   GetPostConvolutionGreenBias -> Just 0x8021-   GetPostConvolutionBlueBias -> Just 0x8022-   GetPostConvolutionAlphaBias -> Just 0x8023-   GetHistogram -> Just 0x8024-   GetMinmax -> Just 0x802e-   GetColorSum -> Just 0x8458-   GetCurrentSecondaryColor -> Just 0x8459-   GetRescaleNormal -> Just 0x803a-   GetSharedTexturePalette -> Just 0x81fb-   GetTexture3DBinding -> Just 0x806a-   GetPackSkipImages -> Just 0x806b-   GetPackImageHeight -> Just 0x806c-   GetUnpackSkipImages -> Just 0x806d-   GetUnpackImageHeight -> Just 0x806e-   GetTexture3D -> Just 0x806f-   GetMax3DTextureSize -> Just 0x8073-   GetMaxTextureLODBias -> Just 0x84fd-   GetMaxTextureMaxAnisotropy -> Just 0x84ff-   GetMultisample -> Just 0x809d-   GetSampleAlphaToCoverage -> Just 0x809e-   GetSampleAlphaToOne -> Just 0x809f-   GetSampleCoverage -> Just 0x80a0-   GetSampleBuffers -> Just 0x80a8-   GetSamples -> Just 0x80a9-   GetSampleCoverageValue -> Just 0x80aa-   GetSampleCoverageInvert -> Just 0x80ab-   GetPointSizeMin -> Just 0x8126-   GetPointSizeMax -> Just 0x8127-   GetPointFadeThresholdSize -> Just 0x8128-   GetPointDistanceAttenuation -> Just 0x8129-   GetColorMatrix -> Just 0x80b1-   GetColorMatrixStackDepth -> Just 0x80b2-   GetMaxColorMatrixStackDepth -> Just 0x80b3-   GetPostColorMatrixRedScale -> Just 0x80b4-   GetPostColorMatrixGreenScale -> Just 0x80b5-   GetPostColorMatrixBlueScale -> Just 0x80b6-   GetPostColorMatrixAlphaScale -> Just 0x80b7-   GetPostColorMatrixRedBias -> Just 0x80b8-   GetPostColorMatrixGreenBias -> Just 0x80b9-   GetPostColorMatrixBlueBias -> Just 0x80ba-   GetPostColorMatrixAlphaBias -> Just 0x80bb-   GetMaxElementsVertices -> Just 0x80e8-   GetMaxElementsIndices -> Just 0x80e9-   GetActiveTexture -> Just 0x84e0-   GetClientActiveTexture -> Just 0x84e1-   GetMaxTextureUnits -> Just 0x84e2-   GetTextureCubeMap -> Just 0x8513-   GetMaxCubeMapTextureSize -> Just 0x851c-   GetMaxRectangleTextureSize -> Just 0x84F8-   GetNumCompressedTextureFormats -> Just 0x86a2-   GetCompressedTextureFormats -> Just 0x86a3-   GetMaxVertexUnits -> Just 0x86a4-   GetActiveVertexUnits -> Just 0x86a5-   GetWeightSumUnity -> Just 0x86a6-   GetVertexBlend -> Just 0x86a7-   GetModelview i -> modelviewIndexToEnum i-   GetCurrentWeight -> Just 0x86a8-   GetWeightArrayType -> Just 0x86a9-   GetWeightArrayStride -> Just 0x86aa-   GetWeightArraySize -> Just 0x86ab-   GetWeightArray -> Just 0x86ad-   GetMatrixPalette -> Just 0x8840-   GetMaxMatrixPaletteStackDepth -> Just 0x8841-   GetMaxPaletteMatrices -> Just 0x8842-   GetCurrentPaletteMatrix -> Just 0x8843-   GetBlendDstRGB -> Just 0x80c8-   GetBlendSrcRGB -> Just 0x80c9-   GetBlendDstAlpha -> Just 0x80ca-   GetBlendSrcAlpha -> Just 0x80cb-   GetPackCMYKHint -> Just 0x800e-   GetUnpackCMYKHint -> Just 0x800f-   GetArrayElementLockFirst -> Just 0x81a8-   GetArrayElementLockCount -> Just 0x81a9-   GetMaxShininess -> Just 0x8504-   GetMaxSpotExponent -> Just 0x8505-   GetFogDistanceMode -> Just 0x855a-   GetDepthBounds -> Just 0x8891-   GetPrimitiveRestartIndex -> Just 0x8559-   GetActiveStencilFace -> Just 0x8911-   GetArrayBufferBinding -> Just 0x8894-   GetElementArrayBufferBinding -> Just 0x8895-   GetVertexArrayBufferBinding -> Just 0x8896-   GetNormalArrayBufferBinding -> Just 0x8897-   GetColorArrayBufferBinding -> Just 0x8898-   GetIndexArrayBufferBinding -> Just 0x8899-   GetTextureCoordArrayBufferBinding -> Just 0x889a-   GetEdgeFlagArrayBufferBinding -> Just 0x889b-   GetSecondaryColorArrayBufferBinding -> Just 0x889c-   GetFogCoordArrayBufferBinding -> Just 0x889d-   GetTextureBindingCubeMap -> Just 0x8514-   GetTextureBindingRectangle -> Just 0x84f6-   GetCurrentMatrix -> Just 0x8641-   GetCurrentMatrixStackDepth -> Just 0x8640-   GetMaxCombinedTextureImageUnits -> Just 0x8b4d-   GetMaxDrawBuffers -> Just 0x8824-   GetMaxFragmentUniformComponents -> Just 0x8b49-   GetMaxTextureCoords -> Just 0x8871-   GetMaxTextureImageUnits -> Just 0x8872-   GetMaxVaryingFloats -> Just 0x8b4b-   GetMaxVertexAttribs -> Just 0x8869-   GetMaxVertexTextureImageUnits -> Just 0x8b4c-   GetMaxVertexUniformComponents -> Just 0x8b4a-   GetCurrentProgram -> Just 0x8b8d-   GetPixelPackBufferBinding -> Just 0x88ed-   GetPixelUnpackBufferBinding -> Just 0x88EF-   GetDrawBufferN i -> drawBufferIndexToEnum i-   GetRGBASignedComponents -> Just 0x8C3C-   GetCopyReadBuffer -> Just 0x8F36-   GetCopyWriteBuffer -> Just 0x8F37-   -- GetWeightArrayBufferBinding -> Just 0x889e-------------------------------------------------------------------------------------- 0x3000 through 0x3FFF are reserved for clip planes--clipPlaneIndexToEnum :: GLsizei -> Maybe GLenum-clipPlaneIndexToEnum i-   | 0 <= i && i <= 0xFFF = Just (0x3000 + fromIntegral i)-   | otherwise = Nothing-------------------------------------------------------------------------------------- 0x4000 through 0x4FFF are reserved for light numbers--lightIndexToEnum :: GLsizei -> Maybe GLenum-lightIndexToEnum i-   | 0 <= i && i <= 0xFFF = Just (0x4000 + fromIntegral i)-   | otherwise = Nothing-------------------------------------------------------------------------------------- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices--modelviewIndexToEnum :: GLsizei -> Maybe GLenum-modelviewIndexToEnum 0 = Just 0x1700-modelviewIndexToEnum 1 = Just 0x850a-modelviewIndexToEnum i-   | 2 <= i && i <= 31 = Just (0x8720 + fromIntegral i)-   | otherwise = Nothing--modelviewEnumToIndex :: GLenum -> Maybe GLsizei-modelviewEnumToIndex x-   | x == 0x1700 = Just 0-   | x == 0x850a = Just 1-   | 0x8722 <= x && x <= 0x873f = Just (fromIntegral x - 0x8720)-   | otherwise = Nothing-------------------------------------------------------------------------------------- 0x8825 through 0x8834 are reserved for draw buffers--drawBufferIndexToEnum :: GLsizei -> Maybe GLenum-drawBufferIndexToEnum i-   | 0 <= i && i <= 15 = Just (0x8825 + fromIntegral i)-   | otherwise = Nothing------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetBooleanv" glGetBooleanv ::-   GLenum -> Ptr GLboolean -> IO ()--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--foreign import CALLCONV unsafe "glGetIntegerv" glGetIntegerv ::-   GLenum -> Ptr GLint -> IO ()------------------------------------------------------------------------------------getEnum1 :: (GLenum -> a) -> GetPName -> IO a-getEnum1 f = getInteger1 (f . fromIntegral)--getSizei1 :: (GLsizei -> a) -> GetPName -> IO a-getSizei1 f = getInteger1 (f . fromIntegral)------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetFloatv" glGetFloatv ::-   GLenum -> Ptr GLfloat -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetDoublev" glGetDoublev ::-   GLenum -> Ptr GLdouble -> IO ()------------------------------------------------------------------------------------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 -> 0x8622-   GetVertexAttribArraySize -> 0x8623-   GetVertexAttribArrayStride -> 0x8624-   GetVertexAttribArrayType -> 0x8625-   GetVertexAttribArrayNormalized -> 0x886A-   GetCurrentVertexAttrib -> 0x8626-   GetVertexAttribArrayBufferBinding -> 0x889F-   GetVertexAttribArrayInteger -> 0x88FD------------------------------------------------------------------------------------getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribInteger1 f location n = alloca $ \buf -> do-   glGetVertexAttribivARB 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)--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glGetVertexAttribivARB,AttribLocation -> GLenum -> Ptr GLint -> IO ())--getVertexAttribFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribFloat4 f location n = alloca $ \buf -> do-   glGetVertexAttribfvARB location (marshalGetVertexAttribPName n) buf-   peek4 f buf--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glGetVertexAttribfvARB,AttribLocation -> GLenum -> Ptr GLfloat -> IO ())--getVertexAttribIInteger4 :: (GLint -> GLint -> GLint -> GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribIInteger4 f location n = alloca $ \buf -> do-   glGetVertexAttribIivARB location (marshalGetVertexAttribPName n) buf-   peek4 f buf--EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glGetVertexAttribIivARB,AttribLocation -> GLenum -> Ptr GLint -> IO ())--getVertexAttribIuInteger4 :: (GLuint -> GLuint -> GLuint -> GLuint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b-getVertexAttribIuInteger4 f location n = alloca $ \buf -> do-   glGetVertexAttribIuivARB location (marshalGetVertexAttribPName n) buf-   peek4 f buf--EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glGetVertexAttribIuivARB,AttribLocation -> GLenum -> Ptr GLuint -> IO ())------------------------------------------------------------------------------------data GetVertexAttribPointerPName =-   VertexAttribArrayPointer--marshalGetVertexAttribPointerPName :: GetVertexAttribPointerPName -> GLenum-marshalGetVertexAttribPointerPName x = case x of-   VertexAttribArrayPointer -> 0x8645------------------------------------------------------------------------------------getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a)-getVertexAttribPointer location n = alloca $ \buf -> do-   glGetVertexAttribPointervARB location (marshalGetVertexAttribPointerPName n) buf-   peek buf--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glGetVertexAttribPointervARB,AttribLocation -> GLenum -> Ptr (Ptr a) -> IO ())
− Graphics/Rendering/OpenGL/GL/RasterPos.hs 
@@ -1,310 +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.Int-import Foreign.Ptr ( Ptr, castPtr )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLshort, GLint, GLfloat, GLdouble, Capability )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapRasterPositionUnclipped), makeCapability )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetCurrentRasterPosition,GetCurrentRasterDistance,-            GetCurrentRasterColor,GetCurrentRasterSecondaryColor,-            GetCurrentRasterIndex,GetCurrentRasterTextureCoords,-            GetCurrentRasterPositionValid),-   getBoolean1, getInteger1, getFloat1, getFloat4 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   Vertex2(..), Vertex3(..), Vertex4(..), TexCoord4(..),-   Color4(..), Index1(..) )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-#include "HsOpenGLTypes.h"------------------------------------------------------------------------------------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 ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRasterPos2s" glRasterPos2s ::-   GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glRasterPos3s" glRasterPos3s ::-   GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glRasterPos4s" glRasterPos4s ::-   GLshort -> GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glRasterPos2sv" glRasterPos2sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glRasterPos3sv" glRasterPos3sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glRasterPos4sv" glRasterPos4sv ::-   Ptr GLshort -> IO ()--instance RasterPosComponent GLshort_ where-   rasterPos2 = glRasterPos2s-   rasterPos3 = glRasterPos3s-   rasterPos4 = glRasterPos4s--   rasterPos2v = glRasterPos2sv-   rasterPos3v = glRasterPos3sv-   rasterPos4v = glRasterPos4sv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRasterPos2i" glRasterPos2i ::-   GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glRasterPos3i" glRasterPos3i ::-   GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glRasterPos4i" glRasterPos4i ::-   GLint -> GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glRasterPos2iv" glRasterPos2iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glRasterPos3iv" glRasterPos3iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glRasterPos4iv" glRasterPos4iv ::-   Ptr GLint -> IO ()--instance RasterPosComponent GLint_ where-   rasterPos2 = glRasterPos2i-   rasterPos3 = glRasterPos3i-   rasterPos4 = glRasterPos4i--   rasterPos2v = glRasterPos2iv-   rasterPos3v = glRasterPos3iv-   rasterPos4v = glRasterPos4iv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRasterPos2f" glRasterPos2f ::-   GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glRasterPos3f" glRasterPos3f ::-   GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glRasterPos4f" glRasterPos4f ::-   GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glRasterPos2fv" glRasterPos2fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glRasterPos3fv" glRasterPos3fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glRasterPos4fv" glRasterPos4fv ::-   Ptr GLfloat -> IO ()--instance RasterPosComponent GLfloat_ where-   rasterPos2 = glRasterPos2f-   rasterPos3 = glRasterPos3f-   rasterPos4 = glRasterPos4f--   rasterPos2v = glRasterPos2fv-   rasterPos3v = glRasterPos3fv-   rasterPos4v = glRasterPos4fv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRasterPos2d" glRasterPos2d ::-   GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glRasterPos3d" glRasterPos3d ::-   GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glRasterPos4d" glRasterPos4d ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glRasterPos2dv" glRasterPos2dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glRasterPos3dv" glRasterPos3dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glRasterPos4dv" glRasterPos4dv ::-   Ptr GLdouble -> IO ()--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 ()------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2sARB,GLshort -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3sARB,GLshort -> GLshort -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2svARB,Ptr GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3svARB,Ptr GLshort -> IO ())--instance WindowPosComponent GLshort_ where-   windowPos2 = glWindowPos2sARB-   windowPos3 = glWindowPos3sARB--   windowPos2v = glWindowPos2svARB-   windowPos3v = glWindowPos3svARB------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2iARB,GLint -> GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3iARB,GLint -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2ivARB,Ptr GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3ivARB,Ptr GLint -> IO ())--instance WindowPosComponent GLint_ where-   windowPos2 = glWindowPos2iARB-   windowPos3 = glWindowPos3iARB--   windowPos2v = glWindowPos2ivARB-   windowPos3v = glWindowPos3ivARB------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2fARB,GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3fARB,GLfloat -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2fvARB,Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3fvARB,Ptr GLfloat -> IO ())--instance WindowPosComponent GLfloat_ where-   windowPos2 = glWindowPos2fARB-   windowPos3 = glWindowPos3fARB--   windowPos2v = glWindowPos2fvARB-   windowPos3v = glWindowPos3fvARB------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2dARB,GLdouble -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3dARB,GLdouble -> GLdouble -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos2dvARB,Ptr GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_window_pos or OpenGL 1.4",glWindowPos3dvARB,Ptr GLdouble -> IO ())--instance WindowPosComponent GLdouble_ where-   windowPos2 = glWindowPos2dARB-   windowPos3 = glWindowPos3dARB--   windowPos2v = glWindowPos2dvARB-   windowPos3v = glWindowPos3dvARB------------------------------------------------------------------------------------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,77 +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 Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLint, GLsizei )-import Graphics.Rendering.OpenGL.GL.BufferMode (-   marshalBufferMode, unmarshalBufferMode )-import Graphics.Rendering.OpenGL.GL.Framebuffer ( BufferMode(..) )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) )-import Graphics.Rendering.OpenGL.GL.PixelData ( withPixelData )-import Graphics.Rendering.OpenGL.GL.PixelRectangles ( PixelData )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetReadBuffer), getEnum1 )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidValue )------------------------------------------------------------------------------------readPixels :: Position -> Size -> PixelData a -> IO ()-readPixels (Position x y) (Size w h) pd =-   withPixelData pd $ glReadPixels x y w h--foreign import CALLCONV unsafe "glReadPixels" glReadPixels ::-   GLint -> GLint -> GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------readBuffer :: StateVar BufferMode-readBuffer =-   makeStateVar-      (getEnum1 unmarshalBufferMode GetReadBuffer)-      (maybe recordInvalidValue glReadBuffer . marshalBufferMode)--foreign import CALLCONV unsafe "glReadBuffer" glReadBuffer :: GLenum -> IO ()------------------------------------------------------------------------------------data PixelCopyType =-     CopyColor-   | CopyDepth-   | CopyStencil-   deriving ( Eq, Ord, Show )--marshalPixelCopyType :: PixelCopyType -> GLenum-marshalPixelCopyType x = case x of-   CopyColor -> 0x1800-   CopyDepth -> 0x1801-   CopyStencil -> 0x1802------------------------------------------------------------------------------------copyPixels :: Position -> Size -> PixelCopyType -> IO ()-copyPixels (Position x y) (Size w h) t =-   glCopyPixels x y w h (marshalPixelCopyType t)--foreign import CALLCONV unsafe "glCopyPixels" glCopyPixels ::-   GLint -> GLint -> GLsizei -> GLsizei -> GLenum -> IO ()
− Graphics/Rendering/OpenGL/GL/Rectangles.hs 
@@ -1,105 +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.Int-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLshort, GLint, GLfloat, GLdouble )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Vertex2(..) )-#ifdef __HADDOCK__-import Graphics.Rendering.OpenGL.GL.BeginEnd ( PrimitiveMode(Polygon) )-#endif------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-#include "HsOpenGLTypes.h"-------------------------------------------------------------------------------------- | '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 ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRects" glRects ::-   GLshort -> GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glRectsv" glRectsv ::-   Ptr GLshort -> Ptr GLshort -> IO ()--instance Rect GLshort_ where-   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRects x1 y1 x2 y2-   rectv ptr1 ptr2 = glRectsv ptr1 ptr2------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRecti" glRecti ::-   GLint -> GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glRectiv" glRectiv ::-   Ptr GLint -> Ptr GLint -> IO ()--instance Rect GLint_ where-   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRecti x1 y1 x2 y2-   rectv ptr1 ptr2 = glRectiv ptr1 ptr2------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRectf" glRectf ::-   GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glRectfv" glRectfv ::-   Ptr GLfloat -> Ptr GLfloat -> IO ()--instance Rect GLfloat_ where-   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectf x1 y1 x2 y2-   rectv ptr1 ptr2 = glRectfv ptr1 ptr2------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glRectd" glRectd ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glRectdv" glRectdv ::-   Ptr GLdouble -> Ptr GLdouble -> IO ()--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,64 +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 Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLint )-import Graphics.Rendering.OpenGL.GL.Exception ( finallyRet )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetRenderMode), getEnum1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), GettableStateVar, makeGettableStateVar )------------------------------------------------------------------------------------data RenderMode =-     Render-   | Feedback-   | Select-   deriving ( Eq, Ord, Show )--marshalRenderMode :: RenderMode -> GLenum-marshalRenderMode x = case x of-   Render -> 0x1c00-   Feedback -> 0x1c01-   Select -> 0x1c02--unmarshalRenderMode :: GLenum -> RenderMode-unmarshalRenderMode x-   | x == 0x1c00 = Render-   | x == 0x1c01 = Feedback-   | x == 0x1c02 = 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--foreign import CALLCONV unsafe "glRenderMode" glRenderMode :: GLenum -> IO GLint------------------------------------------------------------------------------------renderMode :: GettableStateVar RenderMode-renderMode = makeGettableStateVar $ getEnum1 unmarshalRenderMode GetRenderMode
− Graphics/Rendering/OpenGL/GL/SavingState.hs 
@@ -1,117 +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.BasicTypes ( GLbitfield )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )------------------------------------------------------------------------------------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 -> 0x1-   PointAttributes -> 0x2-   LineAttributes -> 0x4-   PolygonAttributes -> 0x8-   PolygonStippleAttributes -> 0x10-   PixelModeAttributes -> 0x20-   LightingAttributes -> 0x40-   FogAttributes -> 0x80-   DepthBufferAttributes -> 0x100-   AccumBufferAttributes -> 0x200-   StencilBufferAttributes -> 0x400-   ViewportAttributes -> 0x800-   TransformAttributes -> 0x1000-   EnableAttributes -> 0x2000-   ColorBufferAttributes -> 0x4000-   HintAttributes -> 0x8000-   EvalAttributes -> 0x10000-   ListAttributes -> 0x20000-   TextureAttributes -> 0x40000-   ScissorAttributes -> 0x80000-   MultisampleAttributes -> 0x20000000-   AllServerAttributes -> 0xffffffff------------------------------------------------------------------------------------preservingAttrib :: [ServerAttributeGroup] -> IO a -> IO a-preservingAttrib groups = bracket_ (pushAttrib groups) glPopAttrib--pushAttrib :: [ServerAttributeGroup] -> IO ()-pushAttrib = glPushAttrib . sum . map marshalServerAttributeGroup--foreign import CALLCONV unsafe "glPushAttrib"-   glPushAttrib :: GLbitfield -> IO ()--foreign import CALLCONV unsafe "glPopAttrib"-   glPopAttrib :: IO ()------------------------------------------------------------------------------------data ClientAttributeGroup =-     PixelStoreAttributes-   | VertexArrayAttributes-   | AllClientAttributes-   deriving ( Eq, Ord, Show )--marshalClientAttributeGroup :: ClientAttributeGroup -> GLbitfield-marshalClientAttributeGroup x = case x of-   PixelStoreAttributes -> 0x1-   VertexArrayAttributes -> 0x2-   AllClientAttributes -> 0xffffffff------------------------------------------------------------------------------------preservingClientAttrib :: [ClientAttributeGroup] -> IO a -> IO a-preservingClientAttrib groups =-   bracket_ (pushClientAttrib groups) glPopClientAttrib--pushClientAttrib :: [ClientAttributeGroup] -> IO ()-pushClientAttrib = glPushClientAttrib . sum . map marshalClientAttributeGroup--foreign import CALLCONV unsafe "glPushClientAttrib"-   glPushClientAttrib :: GLbitfield -> IO ()--foreign import CALLCONV unsafe "glPopClientAttrib"-   glPopClientAttrib :: IO ()
− Graphics/Rendering/OpenGL/GL/Selection.hs 
@@ -1,101 +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 Foreign.Marshal.Array ( allocaArray )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLint, GLsizei, GLuint, GLfloat )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )-import Graphics.Rendering.OpenGL.GL.IOState (-   IOState, peekIOState, evalIOState, nTimes )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetMaxNameStackDepth,GetNameStackDepth), getSizei1 )-import Graphics.Rendering.OpenGL.GL.RenderMode (-   RenderMode(..), withRenderMode, renderMode )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar )------------------------------------------------------------------------------------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)--foreign import CALLCONV unsafe "glInitNames" glInitNames :: IO ()--foreign import CALLCONV unsafe "glSelectBuffer" glSelectBuffer ::-   GLsizei -> Ptr GLuint -> IO ()------------------------------------------------------------------------------------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 = bracket_ (glPushName name) glPopName--foreign import CALLCONV unsafe "glPopName" glPopName :: IO ()--foreign import CALLCONV unsafe "glPushName" glPushName :: Name -> IO ()--foreign import CALLCONV unsafe "glLoadName" loadName :: Name -> IO ()--maxNameStackDepth :: GettableStateVar GLsizei-maxNameStackDepth = makeGettableStateVar (getSizei1 id GetMaxNameStackDepth)--nameStackDepth :: GettableStateVar GLsizei-nameStackDepth = makeGettableStateVar (getSizei1 id GetNameStackDepth)
− Graphics/Rendering/OpenGL/GL/Shaders.hs 
@@ -1,806 +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 ( replicateM, mapM_, foldM )-import Control.Monad.Fix ( MonadFix(..) )-import Data.Int-import Data.List ( genericLength, (\\) )-import Data.Word-import Foreign.C.String ( peekCAStringLen, withCAStringLen, withCAString )-import Foreign.Marshal.Alloc ( alloca, allocaBytes )-import Foreign.Marshal.Array ( allocaArray, withArray, peekArray )-import Foreign.Marshal.Utils ( withMany )-import Foreign.Ptr ( Ptr, castPtr, nullPtr )-import Foreign.Storable ( Storable(peek,sizeOf) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLchar, GLint, GLuint, GLsizei, GLenum, GLfloat )-import Graphics.Rendering.OpenGL.GL.BufferObjects ( ObjectName(..) )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetMaxCombinedTextureImageUnits, GetMaxFragmentUniformComponents,-            GetMaxTextureCoords, GetMaxTextureImageUnits,GetMaxVaryingFloats,-            GetMaxVertexAttribs, GetMaxVertexTextureImageUnits,-            GetMaxVertexUniformComponents, GetCurrentProgram),-   getInteger1, getSizei1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), GettableStateVar, makeGettableStateVar, StateVar,-   makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   AttribLocation(..), Vertex2(..), Vertex3(..), Vertex4(..), TexCoord1(..),-   TexCoord2(..), TexCoord3(..), TexCoord4(..), Normal3(..), FogCoord1(..),-   Color3(..), Color4(..), Index1(..) )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-#include "HsOpenGLTypes.h"------------------------------------------------------------------------------------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 0x8B31--instance Shader FragmentShader where-   makeShader = FragmentShader-   shaderID = fragmentShaderID-   shaderType = const 0x8B30------------------------------------------------------------------------------------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--EXTENSION_ENTRY("OpenGL 2.0",glCreateShader,GLenum -> IO GLuint)-EXTENSION_ENTRY("OpenGL 2.0",glDeleteShader,GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glIsShader,GLuint -> IO GLboolean)------------------------------------------------------------------------------------compileShader :: Shader s => s -> IO ()-compileShader = glCompileShader . shaderID--EXTENSION_ENTRY("OpenGL 2.0",glCompileShader,GLuint -> IO ())------------------------------------------------------------------------------------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 lengths $ \lengthsBuf ->-            glShaderSource (shaderID shader) len charBufsBuf lengthsBuf--EXTENSION_ENTRY("OpenGL 2.0",glShaderSource,GLuint -> GLsizei -> Ptr (Ptr GLchar) -> Ptr GLint -> IO ())--getShaderSource :: Shader s => s -> IO [String]-getShaderSource shader = do-   src <- get (stringQuery (shaderSourceLength shader)-                           (glGetShaderSource (shaderID shader)))-   return [src]--EXTENSION_ENTRY("OpenGL 2.0",glGetShaderSource,GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())--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))--EXTENSION_ENTRY("OpenGL 2.0",glGetShaderInfoLog,GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())------------------------------------------------------------------------------------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 -> 0x8B80-   CompileStatus -> 0x8B81-   ShaderInfoLogLength -> 0x8B84-   ShaderSourceLength -> 0x8B88-   ShaderType -> 0x8B4F--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--EXTENSION_ENTRY("OpenGL 2.0",glGetShaderiv,GLuint -> GLenum -> Ptr GLint -> IO ())------------------------------------------------------------------------------------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--EXTENSION_ENTRY("OpenGL 2.0",glCreateProgram,IO GLuint)-EXTENSION_ENTRY("OpenGL 2.0",glDeleteProgram,GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glIsProgram,GLuint -> IO GLboolean)------------------------------------------------------------------------------------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--EXTENSION_ENTRY("OpenGL 2.0",glGetAttachedShaders,GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLuint -> IO ())--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 program (vs, fs) = do-   currentIDs <- getAttachedShaderIDs program-   let newIDs = map shaderID vs ++ map shaderID fs-   mapM_ (glAttachShader program) (newIDs \\ currentIDs)-   mapM_ (glDetachShader program) (currentIDs \\ newIDs)--EXTENSION_ENTRY("OpenGL 2.0",glAttachShader,Program -> GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glDetachShader,Program -> GLuint -> IO ())------------------------------------------------------------------------------------linkProgram :: Program -> IO ()-linkProgram = glLinkProgram--EXTENSION_ENTRY("OpenGL 2.0",glLinkProgram,Program -> IO ())--currentProgram :: StateVar (Maybe Program)-currentProgram =-   makeStateVar-      (do p <- getCurrentProgram-          return $ if p == noProgram then Nothing else Just p)-      (glUseProgram . maybe noProgram id)--getCurrentProgram :: IO Program-getCurrentProgram = fmap Program $ getInteger1 fromIntegral GetCurrentProgram--noProgram :: Program-noProgram = Program 0--EXTENSION_ENTRY("OpenGL 2.0",glUseProgram,Program -> IO ())--validateProgram :: Program -> IO ()-validateProgram = glValidateProgram--EXTENSION_ENTRY("OpenGL 2.0",glValidateProgram,Program -> IO ())--programInfoLog :: Program -> GettableStateVar String-programInfoLog p =-   stringQuery (programInfoLogLength p) (glGetProgramInfoLog (programID p))--EXTENSION_ENTRY("OpenGL 2.0",glGetProgramInfoLog,GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ())------------------------------------------------------------------------------------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 -> 0x8B80-   LinkStatus -> 0x8B82-   ValidateStatus -> 0x8B83-   ProgramInfoLogLength -> 0x8B84-   AttachedShaders -> 0x8B85-   ActiveAttributes -> 0x8B89-   ActiveAttributeMaxLength -> 0x8B8A-   ActiveUniforms -> 0x8B86-   ActiveUniformMaxLength -> 0x8B87--programVar :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a-programVar f p program =-   makeGettableStateVar $-      alloca $ \buf -> do-         glGetProgramiv (programID program) (marshalGetProgramPName p) buf-         peek1 f buf--EXTENSION_ENTRY("OpenGL 2.0",glGetProgramiv,GLuint -> GLenum -> Ptr GLint -> IO ())------------------------------------------------------------------------------------attribLocation :: Program -> String -> StateVar AttribLocation-attribLocation program name =-   makeStateVar (getAttribLocation program name)-                (\location -> bindAttribLocation program location name)--getAttribLocation :: Program -> String -> IO AttribLocation-getAttribLocation program name =-   fmap (AttribLocation . fromIntegral) $-      withGLString name $-         glGetAttribLocation program--EXTENSION_ENTRY("OpenGL 2.0",glGetAttribLocation,Program -> Ptr GLchar -> IO GLint)--bindAttribLocation :: Program -> AttribLocation -> String -> IO ()-bindAttribLocation program location name =-   withGLString name $-      glBindAttribLocation program location--EXTENSION_ENTRY("OpenGL 2.0",glBindAttribLocation,Program -> AttribLocation -> Ptr GLchar -> IO ())-------------------------------------------------------------------------------------- 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 == 0x1406 = Float'-   | x == 0x8B50 = FloatVec2-   | x == 0x8B51 = FloatVec3-   | x == 0x8B52 = FloatVec4-   | x == 0x1404 = Int'-   | x == 0x8B53 = IntVec2-   | x == 0x8B54 = IntVec3-   | x == 0x8B55 = IntVec4-   | x == 0x1405 = UnsignedInt'-   | x == 0x8DC6 = UnsignedIntVec2-   | x == 0x8DC7 = UnsignedIntVec3-   | x == 0x8DC8 = UnsignedIntVec4-   | x == 0x8B56 = Bool-   | x == 0x8B57 = BoolVec2-   | x == 0x8B58 = BoolVec3-   | x == 0x8B59 = BoolVec4-   | x == 0x8B5A = FloatMat2-   | x == 0x8B5B = FloatMat3-   | x == 0x8B5C = FloatMat4-   | x == 0x8B65 = FloatMat2x3-   | x == 0x8B66 = FloatMat2x4-   | x == 0x8B67 = FloatMat3x2-   | x == 0x8B68 = FloatMat3x4-   | x == 0x8B69 = FloatMat4x2-   | x == 0x8B6A = FloatMat4x3-   | x == 0x8B5D = Sampler1D-   | x == 0x8B5E = Sampler2D-   | x == 0x8B5F = Sampler3D-   | x == 0x8B60 = SamplerCube-   | x == 0x8B61 = Sampler1DShadow-   | x == 0x8B62 = Sampler2DShadow-   | x == 0x8DC0 = Sampler1DArray-   | x == 0x8DC1 = Sampler2DArray-   | x == 0x8DC3 = Sampler1DArrayShadow-   | x == 0x8DC4 = Sampler2DArrayShadow-   | x == 0x8DC5 = SamplerCubeShadow-   | x == 0x8B63 = Sampler2DRect-   | x == 0x8B64 = Sampler2DRectShadow-   | x == 0x8DC9 = IntSampler1D-   | x == 0x8DCA = IntSampler2D-   | x == 0x8DCB = IntSampler3D-   | x == 0x8DCC = IntSamplerCube-   | x == 0x8DCE = IntSampler1DArray-   | x == 0x8DCF = IntSampler2DArray-   | x == 0x8DD1 = UnsignedIntSampler1D-   | x == 0x8DD2 = UnsignedIntSampler2D-   | x == 0x8DD3 = UnsignedIntSampler3D-   | x == 0x8DD4 = UnsignedIntSamplerCube-   | x == 0x8DD6 = UnsignedIntSampler1DArray-   | x == 0x8DD7 = UnsignedIntSampler2DArray-   | otherwise = error ("unmarshalVariableType: illegal value " ++ show x)------------------------------------------------------------------------------------activeVars :: (Program -> GettableStateVar GLuint)-           -> (Program -> GettableStateVar GLsizei)-           -> (Program -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())-           -> Program -> GettableStateVar [(GLint,VariableType,String)]-activeVars numVars maxLength getter program =-   makeGettableStateVar $ do-      numActiveVars <- get (numVars program)-      maxLen <- get (maxLength program)-      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--EXTENSION_ENTRY("OpenGL 2.0",glGetActiveAttrib,Program -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())------------------------------------------------------------------------------------newtype UniformLocation = UniformLocation GLint-   deriving ( Eq, Ord, Show )--uniformLocation :: Program -> String -> GettableStateVar UniformLocation-uniformLocation program name =-   makeGettableStateVar $-      fmap UniformLocation $-         withGLString name $-            glGetUniformLocation program--EXTENSION_ENTRY("OpenGL 2.0",glGetUniformLocation,Program -> Ptr GLchar -> IO GLint)------------------------------------------------------------------------------------activeUniforms :: Program -> GettableStateVar [(GLint,VariableType,String)]-activeUniforms = activeVars numActiveUniforms activeUniformMaxLength glGetActiveUniform--EXTENSION_ENTRY("OpenGL 2.0",glGetActiveUniform,Program -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())------------------------------------------------------------------------------------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 ()------------------------------------------------------------------------------------EXTENSION_ENTRY("OpenGL 2.0",glUniform1i,UniformLocation -> GLint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform2i,UniformLocation -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform3i,UniformLocation -> GLint -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform4i,UniformLocation -> GLint -> GLint -> GLint -> GLint -> IO ())--EXTENSION_ENTRY("OpenGL 2.0",glGetUniformiv,Program -> UniformLocation -> Ptr GLint -> IO ())--EXTENSION_ENTRY("OpenGL 2.0",glUniform1iv,UniformLocation -> GLsizei -> Ptr GLint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform2iv,UniformLocation -> GLsizei -> Ptr GLint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform3iv,UniformLocation -> GLsizei -> Ptr GLint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform4iv,UniformLocation -> GLsizei -> Ptr GLint -> IO ())--instance UniformComponent GLint_ where-   uniform1 = glUniform1i-   uniform2 = glUniform2i-   uniform3 = glUniform3i-   uniform4 = glUniform4i--   getUniform program location = glGetUniformiv program location . castPtr--   uniform1v = glUniform1iv-   uniform2v = glUniform2iv-   uniform3v = glUniform3iv-   uniform4v = glUniform4iv------------------------------------------------------------------------------------EXTENSION_ENTRY("OpenGL 2.0",glUniform1ui,UniformLocation -> GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform2ui,UniformLocation -> GLuint -> GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform3ui,UniformLocation -> GLuint -> GLuint -> GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform4ui,UniformLocation -> GLuint -> GLuint -> GLuint -> GLuint -> IO ())--EXTENSION_ENTRY("OpenGL 2.0",glGetUniformuiv,Program -> UniformLocation -> Ptr GLuint -> IO ())--EXTENSION_ENTRY("OpenGL 2.0",glUniform1uiv,UniformLocation -> GLsizei -> Ptr GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform2uiv,UniformLocation -> GLsizei -> Ptr GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform3uiv,UniformLocation -> GLsizei -> Ptr GLuint -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform4uiv,UniformLocation -> GLsizei -> Ptr GLuint -> IO ())--instance UniformComponent GLuint_ where-   uniform1 = glUniform1ui-   uniform2 = glUniform2ui-   uniform3 = glUniform3ui-   uniform4 = glUniform4ui--   getUniform program location = glGetUniformuiv program location . castPtr--   uniform1v = glUniform1uiv-   uniform2v = glUniform2uiv-   uniform3v = glUniform3uiv-   uniform4v = glUniform4uiv------------------------------------------------------------------------------------EXTENSION_ENTRY("OpenGL 2.0",glUniform1f,UniformLocation -> GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform2f,UniformLocation -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform3f,UniformLocation -> GLfloat -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform4f,UniformLocation -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())--EXTENSION_ENTRY("OpenGL 2.0",glGetUniformfv,Program -> UniformLocation -> Ptr GLfloat -> IO ())--EXTENSION_ENTRY("OpenGL 2.0",glUniform1fv,UniformLocation -> GLsizei -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform2fv,UniformLocation -> GLsizei -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform3fv,UniformLocation -> GLsizei -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniform4fv,UniformLocation -> GLsizei -> Ptr GLfloat -> IO ())--instance UniformComponent GLfloat_ where-   uniform1 = glUniform1f-   uniform2 = glUniform2f-   uniform3 = glUniform3f-   uniform4 = glUniform4f--   getUniform program location = glGetUniformfv program location . castPtr--   uniform1v = glUniform1fv-   uniform2v = glUniform2fv-   uniform3v = glUniform3fv-   uniform4v = glUniform4fv------------------------------------------------------------------------------------EXTENSION_ENTRY("OpenGL 2.0",glUniformMatrix2fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniformMatrix3fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.0",glUniformMatrix4fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.1",glUniformMatrix2x3fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.1",glUniformMatrix3x2fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.1",glUniformMatrix2x4fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.1",glUniformMatrix4x2fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.1",glUniformMatrix3x4fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("OpenGL 2.1",glUniformMatrix4x3fv,UniformLocation -> GLsizei -> GLboolean -> Ptr GLfloat -> IO ())------------------------------------------------------------------------------------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/StateVar.hs 
@@ -1,101 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.StateVar--- Copyright   :  (c) Sven Panne 2002-2009--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)--- --- Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(..),-   GettableStateVar, makeGettableStateVar,-   HasSetter(..), set,-   SettableStateVar, makeSettableStateVar,-   StateVar, makeStateVar,-   ($~), ($=!), ($~!)-) where--import Data.IORef ( IORef, readIORef, writeIORef )------------------------------------------------------------------------------------infixr 2 $=------------------------------------------------------------------------------------class HasGetter g where-   get :: g a -> IO a------------------------------------------------------------------------------------newtype GettableStateVar a = GettableStateVar (IO a)--instance HasGetter GettableStateVar where-   get (GettableStateVar g) = g--makeGettableStateVar :: IO a -> GettableStateVar a-makeGettableStateVar = GettableStateVar------------------------------------------------------------------------------------class HasSetter s where-   ($=) :: s a -> a -> IO ()--{-# DEPRECATED set "use `sequence_' instead" #-}-set :: [IO ()] -> IO ()-set = sequence_------------------------------------------------------------------------------------newtype SettableStateVar a = SettableStateVar (a -> IO ())--instance HasSetter SettableStateVar where-   ($=) (SettableStateVar s) a = s a---- | A strict variant of '$='.-($=!) :: HasSetter s => s a -> a -> IO ()-v $=! x = x `seq` v $= x--makeSettableStateVar :: (a -> IO ()) -> SettableStateVar a-makeSettableStateVar = SettableStateVar------------------------------------------------------------------------------------data StateVar a =-   StateVar (GettableStateVar a) (SettableStateVar a)--instance HasGetter StateVar where-   get (StateVar g _) = get g--instance HasSetter StateVar where-   ($=) (StateVar _ s) a = s $= a--makeStateVar :: IO a -> (a -> IO ()) -> StateVar a-makeStateVar g s = StateVar (makeGettableStateVar g) (makeSettableStateVar s)-------------------------------------------------------------------------------------- | A modificator convenience function.--($~) :: (HasGetter v, HasSetter v) => v a -> (a -> a) -> IO ()-v $~ f = do-   x <- get v-   v $= f x---- | A strict variant of '$~'.-($~!) :: (HasGetter v, HasSetter v) => v a -> (a -> a) -> IO ()-v $~! f = do-   x <- get v-   v $=! f x------------------------------------------------------------------------------------instance HasGetter IORef where-   get = readIORef--instance HasSetter IORef where-   ($=) = writeIORef
− 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.11 (Pointer and String--- Queries) of the OpenGL 2.1 specs.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.StringQueries (-   vendor, renderer, glVersion, glExtensions, shadingLanguageVersion, majorMinor-) where--import Data.Char ( isDigit )-import Foreign.C.String ( peekCString )-import Foreign.Ptr ( Ptr, castPtr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLubyte )-import Graphics.Rendering.OpenGL.GL.QueryUtils ( maybeNullPtr )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), GettableStateVar, makeGettableStateVar )------------------------------------------------------------------------------------vendor :: GettableStateVar String-vendor = makeGettableStateVar (getString Vendor)--renderer :: GettableStateVar String-renderer = makeGettableStateVar (getString Renderer)--glVersion :: GettableStateVar String-glVersion = makeGettableStateVar (getString Version)--glExtensions :: GettableStateVar [String]-glExtensions = makeGettableStateVar (fmap words $ getString Extensions)--shadingLanguageVersion :: GettableStateVar String-shadingLanguageVersion = makeGettableStateVar (getString ShadingLanguageVersion)------------------------------------------------------------------------------------data StringName =-     Vendor-   | Renderer-   | Version-   | Extensions-   | ShadingLanguageVersion--marshalStringName :: StringName -> GLenum-marshalStringName x = case x of-   Vendor -> 0x1f00-   Renderer -> 0x1f01-   Version -> 0x1f02-   Extensions -> 0x1f03-   ShadingLanguageVersion -> 0x8b8c------------------------------------------------------------------------------------getString :: StringName -> IO String-getString n = glGetString (marshalStringName n) >>=-              maybeNullPtr (return "") (peekCString . castPtr)--foreign import CALLCONV unsafe "glGetString" glGetString ::-   GLenum -> IO (Ptr GLubyte)-------------------------------------------------------------------------------------- | 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/Tensor.hs 
@@ -1,327 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.Rendering.OpenGL.GL.Tensor--- 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 points, vectors and matrices.--------------------------------------------------------------------------------------module Graphics.Rendering.OpenGL.GL.Tensor (-   Vertex1(..), Vertex2(..), Vertex3(..), Vertex4(..),-   Vector1(..), Vector2(..), Vector3(..), Vector4(..)-) where--import Control.Applicative ( Applicative(..) )-import Control.Monad ( ap )-import Data.Foldable ( Foldable(..) )-import Data.Ix ( Ix )-import Data.Traversable ( Traversable(..) )-import Data.Typeable (-   Typeable(..), mkTyCon, mkTyConApp, Typeable1(..), typeOfDefault )-import Foreign.Ptr ( castPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.PeekPoke (-   poke1, poke2, poke3, poke4, peek1, peek2, peek3, peek4 )-------------------------------------------------------------------------------------- | A vertex with /y/=0, /z/=0 and /w/=1.-newtype Vertex1 a = Vertex1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vertex1 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vertex1") []--instance Typeable a => Typeable (Vertex1 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vertex1 a) where-   sizeOf    ~(Vertex1 s) = sizeOf s-   alignment ~(Vertex1 s) = alignment s-   peek = peek1 Vertex1 . castPtr-   poke ptr (Vertex1 s) = poke1 (castPtr ptr) s-------------------------------------------------------------------------------------- | A vertex with /z/=0 and /w/=1.-data Vertex2 a = Vertex2 !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vertex2 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vertex2") []--instance Typeable a => Typeable (Vertex2 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vertex2 a) where-   sizeOf ~(Vertex2 x _) = 2 * sizeOf x-   alignment ~(Vertex2 x _) = alignment x-   peek = peek2 Vertex2 . castPtr-   poke ptr (Vertex2 x y) = poke2 (castPtr ptr) x y-------------------------------------------------------------------------------------- | A vertex with /w/=1.-data Vertex3 a = Vertex3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vertex3 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vertex3") []--instance Typeable a => Typeable (Vertex3 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vertex3 a) where-   sizeOf ~(Vertex3 x _ _) = 3 * sizeOf x-   alignment ~(Vertex3 x _ _) = alignment x-   peek = peek3 Vertex3 . castPtr-   poke ptr (Vertex3 x y z) = poke3 (castPtr ptr) x y z-------------------------------------------------------------------------------------- | A fully-fledged four-dimensional vertex.-data Vertex4 a = Vertex4 !a !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vertex4 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vertex4") []--instance Typeable a => Typeable (Vertex4 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vertex4 a) where-   sizeOf ~(Vertex4 x _ _ _) = 4 * sizeOf x-   alignment ~(Vertex4 x _ _ _) = alignment x-   peek = peek4 Vertex4 . castPtr-   poke ptr (Vertex4 x y z w) = poke4 (castPtr ptr) x y z w-------------------------------------------------------------------------------------- | A one-dimensional vector.-newtype Vector1 a = Vector1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vector1 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vector1") []--instance Typeable a => Typeable (Vector1 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vector1 a) where-   sizeOf    ~(Vector1 s) = sizeOf s-   alignment ~(Vector1 s) = alignment s-   peek = peek1 Vector1 . castPtr-   poke ptr (Vector1 s) = poke1 (castPtr ptr) s-------------------------------------------------------------------------------------- | A two-dimensional vector.-data Vector2 a = Vector2 !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vector2 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vector2") []--instance Typeable a => Typeable (Vector2 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vector2 a) where-   sizeOf ~(Vector2 x _) = 2 * sizeOf x-   alignment ~(Vector2 x _) = alignment x-   peek = peek2 Vector2 . castPtr-   poke ptr (Vector2 x y) = poke2 (castPtr ptr) x y-------------------------------------------------------------------------------------- | A three-dimensional vector.-data Vector3 a = Vector3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vector3 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vector3") []--instance Typeable a => Typeable (Vector3 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vector3 a) where-   sizeOf ~(Vector3 x _ _) = 3 * sizeOf x-   alignment ~(Vector3 x _ _) = alignment x-   peek = peek3 Vector3 . castPtr-   poke ptr (Vector3 x y z) = poke3 (castPtr ptr) x y z-------------------------------------------------------------------------------------- | A four-dimensional vector.-data Vector4 a = Vector4 !a !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Vector4 where-   typeOf1 _ = mkTyConApp (mkTyCon "Vector4") []--instance Typeable a => Typeable (Vector4 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Vector4 a) where-   sizeOf ~(Vector4 x _ _ _) = 4 * sizeOf x-   alignment ~(Vector4 x _ _ _) = alignment x-   peek = peek4 Vector4 . castPtr-   poke ptr (Vector4 x y z w) = poke4 (castPtr ptr) x y z w
− 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,41 +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 Graphics.Rendering.OpenGL.GL.BasicTypes ( Capability )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapTexture1D,CapTexture2D,CapTexture3D,CapTextureCubeMap,-             CapTextureRectangle),-   makeCapability )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.Specification (-   TextureTarget(..) )-------------------------------------------------------------------------------------- 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,365 +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 ( liftM2 )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Ptr ( Ptr )-import Foreign.Storable ( Storable )-import Foreign.Marshal.Utils ( with )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLenum, GLfloat )-import Graphics.Rendering.OpenGL.GL.BlendingFactor (-   marshalBlendingFactor, unmarshalBlendingFactor )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.PerFragment ( BlendingFactor )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), HasSetter(($=)), StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.Parameters ( LOD )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit (-   marshalTextureUnit, unmarshalTextureUnit )-import Graphics.Rendering.OpenGL.GL.VertexSpec( Color4(..), TextureUnit )------------------------------------------------------------------------------------data TextureEnvTarget =-     TextureEnv-   | TextureFilterControl   -- GL_TEXTURE_LOD_BIAS_EXT-   | PointSprite            -- GL_COORD_REPLACE_NV--marshalTextureEnvTarget :: TextureEnvTarget -> GLenum-marshalTextureEnvTarget x = case x of-   TextureEnv -> 0x2300-   TextureFilterControl -> 0x8500-   PointSprite -> 0x8861------------------------------------------------------------------------------------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 -> 0x2200-   TexEnvParamTextureEnvColor -> 0x2201-   TexEnvParamCombineRGB -> 0x8571-   TexEnvParamCombineAlpha -> 0x8572-   TexEnvParamSrc0RGB -> 0x8580-   TexEnvParamSrc1RGB -> 0x8581-   TexEnvParamSrc2RGB -> 0x8582-   TexEnvParamSrc3RGB -> 0x8583-   TexEnvParamSrc0Alpha -> 0x8588-   TexEnvParamSrc1Alpha -> 0x8589-   TexEnvParamSrc2Alpha -> 0x858a-   TexEnvParamSrc3Alpha -> 0x858b-   TexEnvParamOperand0RGB -> 0x8590-   TexEnvParamOperand1RGB -> 0x8591-   TexEnvParamOperand2RGB -> 0x8592-   TexEnvParamOperand3RGB -> 0x8593-   TexEnvParamOperand0Alpha -> 0x8598-   TexEnvParamOperand1Alpha -> 0x8599-   TexEnvParamOperand2Alpha -> 0x859a-   TexEnvParamOperand3Alpha -> 0x859b-   TexEnvParamRGBScale -> 0x8573-   TexEnvParamAlphaScale -> 0xd1c-   TexEnvParamLODBias -> 0x8501------------------------------------------------------------------------------------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)--foreign import CALLCONV unsafe "glTexEnvi"-   glTexEnvi :: GLenum -> GLenum ->  GLint -> IO ()--foreign import CALLCONV unsafe "glTexEnvf"-   glTexEnvf :: GLenum -> GLenum ->  GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexEnvfv"-   glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetTexEnviv"-   glGetTexEnviv :: GLenum -> GLenum -> Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glGetTexEnvfv"-   glGetTexEnvfv :: GLenum -> GLenum -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glGetTexEnvfv"-   glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------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 = case x of-   Modulate -> 0x2100-   Decal -> 0x2101-   Blend -> 0xbe2-   Replace -> 0x1e01-   AddUnsigned -> 0x104-   Combine -> 0x8570-   Combine4 -> 0x8503--unmarshalTextureFunction :: GLint -> TextureFunction-unmarshalTextureFunction x-   | x == 0x2100 = Modulate-   | x == 0x2101 = Decal-   | x == 0xbe2 = Blend-   | x == 0x1e01 = Replace-   | x == 0x104 = AddUnsigned-   | x == 0x8570 = Combine-   | x == 0x8503 = Combine4-   | otherwise = error ("unmarshalTextureFunction: illegal value " ++ show 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 = case x of-   Replace' -> 0x1e01-   Modulate' -> 0x2100-   AddUnsigned' -> 0x104-   AddSigned -> 0x8574-   Interpolate -> 0x8575-   Subtract -> 0x84e7-   Dot3RGB -> 0x86ae-   Dot3RGBA -> 0x86af--unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction-unmarshalTextureCombineFunction x-   | x == 0x1e01 = Replace'-   | x == 0x2100 = Modulate'-   | x == 0x104 = AddUnsigned'-   | x == 0x8574 = AddSigned-   | x == 0x8575 = Interpolate-   | x == 0x84e7 = Subtract-   | x == 0x86ae = Dot3RGB-   | x == 0x86af = Dot3RGBA-   | otherwise = error ("unmarshalTextureCombineFunction: illegal value " ++ show 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 = case x of-   CurrentUnit -> 0x1702-   Previous -> 0x8578-   Crossbar u -> fromIntegral (marshalTextureUnit u)-   Constant -> 0x8576-   PrimaryColor -> 0x8577--unmarshalSrc :: GLint -> Src-unmarshalSrc x-   | x == 0x1702 = CurrentUnit-   | x == 0x8578 = Previous-   | x == 0x8576 = Constant-   | x == 0x8577 = PrimaryColor-   | otherwise = Crossbar (unmarshalTextureUnit (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,130 +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 ( partition )-import Foreign.Marshal.Array ( withArray, withArrayLen, peekArray, allocaArray )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLuint, GLsizei, GLenum, GLclampf )-import Graphics.Rendering.OpenGL.GL.BufferObjects ( ObjectName(..) )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetTextureBinding1D,GetTextureBinding2D,GetTextureBinding3D,-            GetTextureBindingCubeMap,GetTextureBindingRectangle),-   getEnum1)-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter (-   TexParameter(TextureResident,TexturePriority), texParamf, getTexParameteri )-import Graphics.Rendering.OpenGL.GL.Texturing.Specification (-   TextureTarget(..) )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (-   marshalTextureTarget )------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGenTextures"-   glGenTextures :: GLsizei -> Ptr GLuint -> IO ()--foreign import CALLCONV unsafe "glDeleteTextures"-   glDeleteTextures :: GLsizei -> Ptr GLuint -> IO ()--foreign import CALLCONV unsafe "glIsTexture"-   glIsTexture :: GLuint -> IO GLboolean------------------------------------------------------------------------------------textureBinding :: TextureTarget -> StateVar (Maybe TextureObject)-textureBinding t =-   makeStateVar-      (do o <- getEnum1 TextureObject (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--foreign import CALLCONV unsafe "glBindTexture"-   glBindTexture :: GLenum -> GLuint -> IO ()------------------------------------------------------------------------------------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)--foreign import CALLCONV unsafe "glAreTexturesResident"-   glAreTexturesResident :: GLsizei -> Ptr GLuint -> Ptr GLboolean -> IO GLboolean------------------------------------------------------------------------------------type TexturePriority = GLclampf--texturePriority :: TextureTarget -> StateVar TexturePriority-texturePriority = texParamf id id TexturePriority--prioritizeTextures :: [(TextureObject,TexturePriority)] -> IO ()-prioritizeTextures tps =-   withArrayLen (map (textureID . fst) tps) $ \len texObjsBuf ->-      withArray (map snd tps) $-         glPrioritizeTextures (fromIntegral len) texObjsBuf--foreign import CALLCONV unsafe "glPrioritizeTextures"-   glPrioritizeTextures :: GLsizei -> Ptr GLuint -> Ptr GLclampf -> IO ()
− Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs 
@@ -1,266 +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 Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLint, GLfloat, GLclampf, Capability(..) )-import Graphics.Rendering.OpenGL.GL.Capability (-   marshalCapability, unmarshalCapability )-import Graphics.Rendering.OpenGL.GL.ComparisonFunction (-   marshalComparisonFunction, unmarshalComparisonFunction )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( TextureCoordName(..) )-import Graphics.Rendering.OpenGL.GL.PerFragment ( ComparisonFunction )-import Graphics.Rendering.OpenGL.GL.PixelRectangles (-   PixelInternalFormat(..) )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetMaxTextureMaxAnisotropy,GetMaxTextureLODBias), getFloat1)-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar,-   StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.Specification (-   Level, TextureTarget(..) )-import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter (-   TexParameter(TextureMinFilter,TextureMagFilter,TextureWrapS,TextureWrapT,-                TextureWrapR,TextureBorderColor,TextureMinLOD,TextureMaxLOD,-                TextureBaseLevel,TextureMaxLevel,TextureMaxAnisotropy,-                TextureLODBias,GenerateMipmap,DepthTextureMode,-                TextureCompareMode,TextureCompareFunc,TextureCompareFailValue,-                TextureCompare,TextureCompareOperator),-   texParami, texParamf, texParamC4f, combineTexParams, combineTexParamsMaybe )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   marshalPixelInternalFormat, unmarshalPixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.VertexSpec( Color4(..) )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidEnum )------------------------------------------------------------------------------------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 = case x of-   (Nearest, Nothing     ) -> 0x2600-   (Linear', Nothing     ) -> 0x2601-   (Nearest, Just Nearest) -> 0x2700-   (Linear', Just Nearest) -> 0x2701-   (Nearest, Just Linear') -> 0x2702-   (Linear', Just Linear') -> 0x2703--marshalMagnificationFilter :: MagnificationFilter -> GLint-marshalMagnificationFilter = marshalMinificationFilter . magToMin--unmarshalMinificationFilter :: GLint -> MinificationFilter-unmarshalMinificationFilter x-   | x ==  0x2600 = (Nearest, Nothing     )-   | x ==  0x2601 = (Linear', Nothing     )-   | x ==  0x2700 = (Nearest, Just Nearest)-   | x ==  0x2701 = (Linear', Just Nearest)-   | x ==  0x2702 = (Nearest, Just Linear')-   | x ==  0x2703 = (Linear', Just Linear')-   | otherwise = error ("unmarshalMinificationFilter: illegal value " ++ show 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 = case x of-   (Repeated, Clamp) -> 0x2900-   (Repeated, Repeat) -> 0x2901-   (Repeated, ClampToEdge) -> 0x812f-   (Repeated, ClampToBorder) -> 0x812d-   (Mirrored, Clamp) -> 0x8742-   (Mirrored, Repeat) -> 0x8370-   (Mirrored, ClampToEdge) -> 0x8743-   (Mirrored, ClampToBorder) -> 0x8912--unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)-unmarshalTextureWrapMode x-   | x == 0x2900 = (Repeated, Clamp)-   | x == 0x2901 = (Repeated, Repeat)-   | x == 0x812f = (Repeated, ClampToEdge)-   | x == 0x812d = (Repeated, ClampToBorder)-   | x == 0x8742 = (Mirrored, Clamp)-   | x == 0x8370 = (Mirrored, Repeat)-   | x == 0x8743 = (Mirrored, ClampToEdge)-   | x == 0x8912 = (Mirrored, ClampToBorder)-   | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show 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 = case x of-   Disabled -> 0x0     -- i.e. None-   Enabled -> 0x884e   -- i.e. CompareRToTexture--unmarshalTextureCompareMode :: GLint -> Capability-unmarshalTextureCompareMode x-   | x == 0x0 = Disabled-   | x == 0x884e = Enabled-   | otherwise = error ("unmarshalTextureCompareMode: illegal value " ++ show 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 id id 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,245 +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.GL.BasicTypes ( GLint, GLenum )------------------------------------------------------------------------------------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 = case x of-   Alpha' -> 0x1906-   DepthComponent' -> 0x1902-   Luminance' -> 0x1909-   LuminanceAlpha' -> 0x190a-   RGB' -> 0x1907-   RGBA' -> 0x1908-   SRGB -> 0x8c40-   SRGBAlpha -> 0x8c42-   SLuminance -> 0x8c46-   SLuminanceAlpha -> 0x8c44-   Alpha4 -> 0x803b-   Alpha8 -> 0x803c-   Alpha12 -> 0x803d-   Alpha16 -> 0x803e-   DepthComponent16 -> 0x81a5-   DepthComponent24 -> 0x81a6-   DepthComponent32 -> 0x81a7-   Luminance4 -> 0x803f-   Luminance8 -> 0x8040-   Luminance12 -> 0x8041-   Luminance16 -> 0x8042-   Luminance4Alpha4 -> 0x8043-   Luminance6Alpha2 -> 0x8044-   Luminance8Alpha8 -> 0x8045-   Luminance12Alpha4 -> 0x8046-   Luminance12Alpha12 -> 0x8047-   Luminance16Alpha16 -> 0x8048-   Intensity -> 0x8049-   Intensity4 -> 0x804a-   Intensity8 -> 0x804b-   Intensity12 -> 0x804c-   Intensity16 -> 0x804d-   R3G3B2 -> 0x2a10-   RGB4 -> 0x804f-   RGB5 -> 0x8050-   RGB8 -> 0x8051-   RGB10 -> 0x8052-   RGB12 -> 0x8053-   RGB16 -> 0x8054-   RGBA2 -> 0x8055-   RGBA4 -> 0x8056-   RGB5A1 -> 0x8057-   RGBA8 -> 0x8058-   RGB10A2 -> 0x8059-   RGBA12 -> 0x805a-   RGBA16 -> 0x805b-   SRGB8 -> 0x8c41-   SRGB8Alpha8 -> 0x8c43-   SLuminance8 -> 0x8c47-   SLuminance8Alpha8 -> 0x8c45-   CompressedAlpha -> 0x84e9-   CompressedLuminance -> 0x84ea-   CompressedLuminanceAlpha -> 0x84eb-   CompressedIntensity -> 0x84ec-   CompressedRGB -> 0x84ed-   CompressedRGBA -> 0x84ee-   CompressedSRGB -> 0x8c48-   CompressedSRGBAlpha -> 0x8c49-   CompressedSLuminance -> 0x8c4a-   CompressedSLuminanceAlpha -> 0x8c4b-   DepthComponent32f -> 0x8CAC-   Depth32fStencil8 -> 0x8CAD-   RGB9E5 -> 0x8C3D-   R11fG11fB10f -> 0x8C3A---- *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-   | x == 0x1906 = Alpha'-   | x == 0x1902 = DepthComponent'-   | x == 0x1909 = Luminance'-   | x == 0x190a = LuminanceAlpha'-   | x == 0x1907 = RGB'-   | x == 0x1908 = RGBA'-   | x == 0x8c40 = SRGB-   | x == 0x8c42 = SRGBAlpha-   | x == 0x8c46 = SLuminance-   | x == 0x8c44 = SLuminanceAlpha-   | x == 0x803b = Alpha4-   | x == 0x803c = Alpha8-   | x == 0x803d = Alpha12-   | x == 0x803e = Alpha16-   | x == 0x81a5 = DepthComponent16-   | x == 0x81a6 = DepthComponent24-   | x == 0x81a7 = DepthComponent32-   | x == 0x803f = Luminance4-   | x == 0x8040 = Luminance8-   | x == 0x8041 = Luminance12-   | x == 0x8042 = Luminance16-   | x == 0x8043 = Luminance4Alpha4-   | x == 0x8044 = Luminance6Alpha2-   | x == 0x8045 = Luminance8Alpha8-   | x == 0x8046 = Luminance12Alpha4-   | x == 0x8047 = Luminance12Alpha12-   | x == 0x8048 = Luminance16Alpha16-   | x == 0x8049 = Intensity-   | x == 0x804a = Intensity4-   | x == 0x804b = Intensity8-   | x == 0x804c = Intensity12-   | x == 0x804d = Intensity16-   | x == 0x2a10 = R3G3B2-   | x == 0x804f = RGB4-   | x == 0x8050 = RGB5-   | x == 0x8051 = RGB8-   | x == 0x8052 = RGB10-   | x == 0x8053 = RGB12-   | x == 0x8054 = RGB16-   | x == 0x8055 = RGBA2-   | x == 0x8056 = RGBA4-   | x == 0x8057 = RGB5A1-   | x == 0x8058 = RGBA8-   | x == 0x8059 = RGB10A2-   | x == 0x805a = RGBA12-   | x == 0x805b = RGBA16-   | x == 0x8c41 = SRGB8-   | x == 0x8c43 = SRGB8Alpha8-   | x == 0x8c47 = SLuminance8-   | x == 0x8c45 = SLuminance8Alpha8-   | x == 0x84e9 = CompressedAlpha-   | x == 0x84ea = CompressedLuminance-   | x == 0x84eb = CompressedLuminanceAlpha-   | x == 0x84ec = CompressedIntensity-   | x == 0x84ed = CompressedRGB-   | x == 0x84ee = CompressedRGBA-   | x == 0x8c48 = CompressedSRGB-   | x == 0x8c49 = CompressedSRGBAlpha-   | x == 0x8c4a = CompressedSLuminance-   | x == 0x8c4b = CompressedSLuminanceAlpha-   | x == 0x8CAC = DepthComponent32f-   | x == 0x8CAD = Depth32fStencil8-   | x == 0x8C3D = RGB9E5-   -- legacy values-   | x == 1 = Luminance'-   | x == 2 = LuminanceAlpha'-   | x == 3 = RGB'-   | x == 4 = RGBA'-   | otherwise = error ("unmarshalPixelInternalFormat: illegal value " ++ show 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,168 +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 ( liftM2, liftM3, liftM4 )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLsizei, GLenum )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   unmarshalPixelInternalFormat )-import Graphics.Rendering.OpenGL.GL.PixelRectangles (-   Proxy(..), PixelInternalFormat(..) )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.Specification (-   TextureTarget(..), CubeMapTarget, Level, Border,-   TextureSize1D(..), TextureSize2D(..), TextureSize3D(..) )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (-   marshalProxyTextureTarget, marshalCubeMapTarget )-import Graphics.Rendering.OpenGL.GL.VertexSpec( Color4(..) )------------------------------------------------------------------------------------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 -> 0x1003-   TextureWidth -> 0x1000-   TextureHeight -> 0x1001-   TextureDepth -> 0x8071-   TextureBorder -> 0x1005-   TextureRedSize -> 0x805C-   TextureGreenSize -> 0x805D-   TextureBlueSize -> 0x805E-   TextureAlphaSize -> 0x805F-   TextureIntensitySize -> 0x8061-   TextureLuminanceSize -> 0x8060-   TextureIndexSize -> 0x80ED-   DepthBits -> 0x0D56-   TextureCompressedImageSize -> 0x86A0-   TextureCompressed -> 0x86A1-   TextureSharedSize -> 0x8C3F------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetTexLevelParameteriv"-   glGetTexLevelParameteriv :: GLenum -> GLint -> GLenum -> Ptr GLint -> IO ()
− Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs 
@@ -1,327 +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 Foreign.Marshal.Array ( peekArray, allocaArray )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLsizei, GLenum )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..) )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.PixelData ( withPixelData )-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (-   marshalPixelInternalFormat, marshalPixelInternalFormat' )-import Graphics.Rendering.OpenGL.GL.PixelRectangles (-   PixelInternalFormat, PixelData, Proxy(..) )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetNumCompressedTextureFormats,GetCompressedTextureFormats,-            GetMaxTextureSize,GetMax3DTextureSize,GetMaxCubeMapTextureSize,-            GetMaxRectangleTextureSize),-   getInteger1, getIntegerv)-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (-   TextureTarget(..), marshalTextureTarget, marshalProxyTextureTarget,-   CubeMapTarget(..), marshalCubeMapTarget )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glTexImage1D"-   glTexImage1D :: GLenum -> GLint -> GLint -> GLsizei -> GLint -> GLenum -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glTexImage2D"-   glTexImage2D :: GLenum -> GLint -> GLint -> GLsizei -> GLsizei -> GLint -> GLenum -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------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--EXTENSION_ENTRY("GL_EXT_texture3D or OpenGL 1.2",glTexImage3D,GLenum -> GLint -> GLint -> GLsizei -> GLsizei -> GLsizei -> GLint -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------getTexImage :: Either TextureTarget CubeMapTarget -> Level -> PixelData a -> IO ()-getTexImage t level pd =-   withPixelData pd $-      glGetTexImage (either marshalTextureTarget marshalCubeMapTarget t) level--foreign import CALLCONV unsafe "glGetTexImage"-   glGetTexImage :: GLenum -> GLint -> GLenum -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glCopyTexImage1D"-   glCopyTexImage1D :: GLenum -> GLint -> GLenum -> GLint -> GLint -> GLsizei -> GLint -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glCopyTexImage2D"-   glCopyTexImage2D :: GLenum -> GLint -> GLenum -> GLint -> GLint -> GLsizei -> GLsizei -> GLint -> IO ()------------------------------------------------------------------------------------texSubImage1D :: Level -> TexturePosition1D -> TextureSize1D -> PixelData a -> IO ()-texSubImage1D level (TexturePosition1D xOff) (TextureSize1D w) pd =-   withPixelData pd $-      glTexSubImage1D (marshalTextureTarget Texture1D) level xOff w--foreign import CALLCONV unsafe "glTexSubImage1D"-   glTexSubImage1D :: GLenum -> GLint -> GLint -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glTexSubImage2D"-   glTexSubImage2D :: GLenum -> GLint -> GLint -> GLint -> GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ()------------------------------------------------------------------------------------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--EXTENSION_ENTRY("GL_EXT_texture3D or OpenGL 1.2",glTexSubImage3D,GLenum -> GLint -> GLint -> GLint -> GLint -> GLsizei -> GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO ())------------------------------------------------------------------------------------copyTexSubImage1D :: Level -> TexturePosition1D -> Position -> TextureSize1D -> IO ()-copyTexSubImage1D level (TexturePosition1D xOff) (Position x y) (TextureSize1D w) =-   glCopyTexSubImage1D (marshalTextureTarget Texture1D) level xOff x y w--foreign import CALLCONV unsafe "glCopyTexSubImage1D"-   glCopyTexSubImage1D :: GLenum -> GLint -> GLint -> GLint -> GLint -> GLsizei -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glCopyTexSubImage2D"-   glCopyTexSubImage2D :: GLenum -> GLint -> GLint -> GLint -> GLint -> GLint -> GLsizei -> GLsizei -> IO ()------------------------------------------------------------------------------------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--EXTENSION_ENTRY("GL_EXT_texture3D or OpenGL 1.2",glCopyTexSubImage3D,GLenum -> GLint -> GLint -> GLint -> GLint -> GLint -> GLint -> GLsizei -> GLsizei -> IO ())------------------------------------------------------------------------------------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)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq (CompressedPixelData a)-instance Ord (CompressedPixelData a)-instance Show (CompressedPixelData a)-#else-   deriving ( Eq, Ord, Show )-#endif--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 ->-      glCompressedTexImage1DARB-         (marshalProxyTextureTarget proxy Texture1D) level fmt w border--EXTENSION_ENTRY("GL_ARB_texture_compression or OpenGL 1.3",glCompressedTexImage1DARB,GLenum -> GLint -> GLenum -> GLsizei -> GLint -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------compressedTexImage2D :: Maybe CubeMapTarget -> Proxy -> Level -> TextureSize2D -> Border -> CompressedPixelData a -> IO ()-compressedTexImage2D mbCubeMap proxy level (TextureSize2D w h) border cpd =-   withCompressedPixelData cpd $ \fmt ->-      glCompressedTexImage2DARB-         (maybe (marshalProxyTextureTarget proxy Texture2D)-                (\c -> if proxy == Proxy then marshalProxyTextureTarget Proxy TextureCubeMap else marshalCubeMapTarget c)-                mbCubeMap)-         level fmt w h border--EXTENSION_ENTRY("GL_ARB_texture_compression or OpenGL 1.3",glCompressedTexImage2DARB,GLenum -> GLint -> GLenum -> GLsizei -> GLsizei ->GLint -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------compressedTexImage3D :: Proxy -> Level -> TextureSize3D -> Border -> CompressedPixelData a -> IO ()-compressedTexImage3D proxy level (TextureSize3D w h d) border cpd =-   withCompressedPixelData cpd $ \fmt ->-      glCompressedTexImage3DARB-         (marshalProxyTextureTarget proxy Texture3D) level fmt w h d border--EXTENSION_ENTRY("GL_ARB_texture_compression or OpenGL 1.3",glCompressedTexImage3DARB,GLenum -> GLint -> GLenum -> GLsizei -> GLsizei -> GLsizei -> GLint -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------getCompressedTexImage :: Either TextureTarget CubeMapTarget -> Level -> Ptr a -> IO ()-getCompressedTexImage = glGetCompressedTexImageARB . either marshalTextureTarget marshalCubeMapTarget--EXTENSION_ENTRY("GL_ARB_texture_compression or OpenGL 1.3",glGetCompressedTexImageARB,GLenum -> GLint -> Ptr a -> IO ())------------------------------------------------------------------------------------compressedTexSubImage1D :: Level -> TexturePosition1D -> TextureSize1D -> CompressedPixelData a -> IO ()-compressedTexSubImage1D level (TexturePosition1D xOff) (TextureSize1D w) cpd =-   withCompressedPixelData cpd $-      glCompressedTexSubImage1DARB (marshalTextureTarget Texture1D) level xOff w--EXTENSION_ENTRY("GL_ARB_texture_compression or OpenGL 1.3",glCompressedTexSubImage1DARB,GLenum -> GLint -> GLint -> GLsizei -> GLenum -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------compressedTexSubImage2D :: Maybe CubeMapTarget -> Level -> TexturePosition2D -> TextureSize2D -> CompressedPixelData a -> IO ()-compressedTexSubImage2D mbCubeMap level (TexturePosition2D xOff yOff) (TextureSize2D w h) cpd =-   withCompressedPixelData cpd $-      glCompressedTexSubImage2DARB (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level xOff yOff w h--EXTENSION_ENTRY("GL_ARB_texture_compression or OpenGL 1.3",glCompressedTexSubImage2DARB,GLenum -> GLint -> GLint -> GLint -> GLsizei -> GLsizei -> GLenum -> GLsizei -> Ptr a-> IO ())------------------------------------------------------------------------------------compressedTexSubImage3D :: Level -> TexturePosition3D -> TextureSize3D -> CompressedPixelData a -> IO ()-compressedTexSubImage3D level (TexturePosition3D xOff yOff zOff) (TextureSize3D w h d) cpd =-   withCompressedPixelData cpd $-      glCompressedTexSubImage3DARB (marshalTextureTarget Texture3D) level xOff yOff zOff w h d--EXTENSION_ENTRY("GL_ARB_texture_compression or OpenGL 1.3",glCompressedTexSubImage3DARB,GLenum -> GLint -> GLint -> GLint -> GLint -> GLsizei -> GLsizei -> GLsizei -> GLenum -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------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,171 +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 ( liftM2 )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Utils ( with )-import Foreign.Storable ( Storable )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLint, GLenum, GLfloat, Capability(..) )-import Graphics.Rendering.OpenGL.GL.PeekPoke ( peek1 )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), HasSetter(($=)), StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (-   TextureTarget(..), marshalTextureTarget )-import Graphics.Rendering.OpenGL.GL.VertexSpec( Color4(..) )------------------------------------------------------------------------------------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 -> 0x2801-   TextureMagFilter -> 0x2800-   TextureWrapS -> 0x2802-   TextureWrapT -> 0x2803-   TextureWrapR -> 0x8072-   TextureBorderColor -> 0x1004-   TextureMinLOD -> 0x813A-   TextureMaxLOD -> 0x813B-   TextureBaseLevel -> 0x813C-   TextureMaxLevel -> 0x813D-   TexturePriority -> 0x8066-   TextureMaxAnisotropy -> 0x84FE-   TextureCompare -> 0x819A-   TextureCompareOperator -> 0x819B-   TextureCompareFailValue -> 0x80BF-   GenerateMipmap -> 0x8191-   TextureCompareMode -> 0x884C-   TextureCompareFunc -> 0x884D-   DepthTextureMode -> 0x884B-   TextureLODBias -> 0x8501-   TextureResident -> 0x8067------------------------------------------------------------------------------------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)--foreign import CALLCONV unsafe "glTexParameteri"-   glTexParameteri :: GLenum -> GLenum ->  GLint -> IO ()--foreign import CALLCONV unsafe "glTexParameterf"-   glTexParameterf :: GLenum -> GLenum ->  GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexParameterfv"-   glTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glGetTexParameteriv"-   glGetTexParameteriv :: GLenum -> GLenum -> Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glGetTexParameterfv"-   glGetTexParameterfv :: GLenum -> GLenum -> Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glGetTexParameterfv"-   glGetTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()------------------------------------------------------------------------------------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)--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.BasicTypes ( GLenum )-import Graphics.Rendering.OpenGL.GL.PixelRectangles ( Proxy(..) )------------------------------------------------------------------------------------data TextureTarget =-     Texture1D-   | Texture2D-   | Texture3D-   | TextureCubeMap-   | TextureRectangle-   deriving ( Eq, Ord, Show )--marshalTextureTarget :: TextureTarget -> GLenum-marshalTextureTarget x = case x of-   Texture1D -> 0xde0-   Texture2D -> 0xde1-   Texture3D -> 0x806f-   TextureCubeMap -> 0x8513-   TextureRectangle -> 0x84f5--marshalProxyTextureTarget :: Proxy -> TextureTarget -> GLenum-marshalProxyTextureTarget NoProxy x = marshalTextureTarget x-marshalProxyTextureTarget Proxy   x = case x of-   Texture1D -> 0x8063-   Texture2D -> 0x8064-   Texture3D -> 0x8070-   TextureCubeMap -> 0x851b-   TextureRectangle -> 0x84f7------------------------------------------------------------------------------------data CubeMapTarget =-     TextureCubeMapPositiveX-   | TextureCubeMapNegativeX-   | TextureCubeMapPositiveY-   | TextureCubeMapNegativeY-   | TextureCubeMapPositiveZ-   | TextureCubeMapNegativeZ-   deriving ( Eq, Ord, Show )--marshalCubeMapTarget :: CubeMapTarget -> GLenum-marshalCubeMapTarget x = case x of-   TextureCubeMapPositiveX -> 0x8515-   TextureCubeMapNegativeX -> 0x8516-   TextureCubeMapPositiveY -> 0x8517-   TextureCubeMapNegativeY -> 0x8518-   TextureCubeMapPositiveZ -> 0x8519-   TextureCubeMapNegativeZ -> 0x851a
− 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.GL.BasicTypes ( GLenum, GLuint )-------------------------------------------------------------------------------------- | 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) = 0x84c0 + fromIntegral x--unmarshalTextureUnit :: GLenum -> TextureUnit-unmarshalTextureUnit x = TextureUnit (fromIntegral (x - 0x84c0))
− Graphics/Rendering/OpenGL/GL/VertexArrays.hs 
@@ -1,575 +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-   ClientArrayType(..), arrayPointer,-   InterleavedArrays(..), interleavedArrays,--   -- * Enabling Arrays-   clientState, clientActiveTexture,--   -- * Dereferencing and Rendering-   ArrayIndex, NumArrayIndices, NumIndexBlocks,-   arrayElement, drawArrays, multiDrawArrays, drawElements, multiDrawElements,-   drawRangeElements, maxElementsVertices, maxElementsIndices, lockArrays,-   primitiveRestartIndex,--   -- * Generic Vertex Attribute Arrays-   vertexAttribPointer, vertexAttribArray-) where--import Foreign.Marshal.Alloc ( alloca )-import Foreign.Ptr ( Ptr, nullPtr )-import Foreign.Storable ( Storable(peek) )-import Graphics.Rendering.OpenGL.GL.Capability (-   EnableCap(CapVertexArray,CapNormalArray,CapColorArray,CapIndexArray,-             CapTextureCoordArray,CapEdgeFlagArray,CapFogCoordArray,-             CapSecondaryColorArray,CapMatrixIndexArray,CapPrimitiveRestart),-   makeCapability, unmarshalCapability )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLenum, GLint, GLuint, GLsizei, Capability(Disabled,Enabled) )-import Graphics.Rendering.OpenGL.GL.DataType (-   DataType(..), marshalDataType, unmarshalDataType )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.GLboolean (-   marshalGLboolean, unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   GetPName(GetVertexArraySize,GetVertexArrayType,GetVertexArrayStride,-            GetNormalArrayType,GetNormalArrayStride,GetColorArraySize,-            GetColorArrayType,GetColorArrayStride,GetSecondaryColorArraySize,-            GetSecondaryColorArrayType,GetSecondaryColorArrayStride,-            GetIndexArrayType,GetIndexArrayStride,-            GetFogCoordArrayType,GetFogCoordArrayStride,-            GetTextureCoordArraySize,GetTextureCoordArrayType,-            GetTextureCoordArrayStride,GetEdgeFlagArrayStride,-            GetMaxElementsVertices,GetMaxElementsIndices,-            GetClientActiveTexture,GetArrayElementLockFirst,-            GetArrayElementLockCount,GetPrimitiveRestartIndex),-   getInteger1, getEnum1, getSizei1, AttribLocation,-   GetVertexAttribPName(..),-   getVertexAttribInteger1, getVertexAttribEnum1, getVertexAttribBoolean1,-   GetVertexAttribPointerPName(..), getVertexAttribPointer )-import Graphics.Rendering.OpenGL.GL.PrimitiveMode ( marshalPrimitiveMode )-import Graphics.Rendering.OpenGL.GL.BeginEnd ( PrimitiveMode )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get),-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit (-   TextureUnit, marshalTextureUnit, unmarshalTextureUnit )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   recordInvalidEnum, recordInvalidValue )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( IntegerHandling(..) )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------type NumComponents = GLint--type Stride = GLsizei--data VertexArrayDescriptor a =-   VertexArrayDescriptor !NumComponents !DataType !Stride !(Ptr a)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq (VertexArrayDescriptor a)-instance Ord (VertexArrayDescriptor a)-instance Show (VertexArrayDescriptor a)-#else-   deriving ( Eq, Ord, Show )-#endif--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 -> 0x8074-   NormalArray -> 0x8075-   ColorArray -> 0x8076-   IndexArray -> 0x8077-   TextureCoordArray -> 0x8078-   EdgeFlagArray -> 0x8079-   FogCoordArray -> 0x8457-   SecondaryColorArray -> 0x845e-   MatrixIndexArray -> 0x8844---- 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--foreign import CALLCONV unsafe "glVertexPointer" glVertexPointer ::-   GLint -> GLenum -> GLsizei -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glNormalPointer" glNormalPointer ::-   GLenum -> GLsizei -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glColorPointer" glColorPointer ::-   GLint -> GLenum -> GLsizei -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glIndexPointer" glIndexPointer ::-   GLenum -> GLsizei -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glTexCoordPointer" glTexCoordPointer ::-   GLint -> GLenum -> GLsizei -> Ptr a -> IO ()------------------------------------------------------------------------------------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--foreign import CALLCONV unsafe "glEdgeFlagPointer" glEdgeFlagPointer ::-   GLsizei -> Ptr a -> IO ()------------------------------------------------------------------------------------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) $ glFogCoordPointerEXT (marshalDataType d) s p--EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoordPointerEXT,GLenum -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------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) =-   glSecondaryColorPointerEXT n (marshalDataType d) s p--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColorPointerEXT,GLint -> GLenum -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------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 -> 0x2a20-   V3f -> 0x2a21-   C4ubV2f -> 0x2a22-   C4ubV3f -> 0x2a23-   C3fV3f -> 0x2a24-   N3fV3f -> 0x2a25-   C4fN3fV3f -> 0x2a26-   T2fV3f -> 0x2a27-   T4fV4f -> 0x2a28-   T2fC4ubV3f -> 0x2a29-   T2fC3fV3f -> 0x2a2a-   T2fN3fV3f -> 0x2a2b-   T2fC4fN3fV3f -> 0x2a2c-   T4fC4fN3fV4f -> 0x2a2d------------------------------------------------------------------------------------interleavedArrays :: InterleavedArrays -> Stride -> Ptr a -> IO ()-interleavedArrays = glInterleavedArrays . marshalInterleavedArrays--foreign import CALLCONV unsafe "glInterleavedArrays" glInterleavedArrays ::-   GLenum -> GLsizei -> Ptr a -> IO ()------------------------------------------------------------------------------------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)--foreign import CALLCONV unsafe "glEnableClientState" glEnableClientState ::-   GLenum -> IO ()--foreign import CALLCONV unsafe "glDisableClientState" glDisableClientState ::-   GLenum -> IO ()------------------------------------------------------------------------------------clientActiveTexture :: StateVar TextureUnit-clientActiveTexture =-   makeStateVar (getEnum1 unmarshalTextureUnit GetClientActiveTexture)-                (glClientActiveTextureARB . marshalTextureUnit)--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glClientActiveTextureARB,GLenum -> IO ())------------------------------------------------------------------------------------type ArrayIndex = GLint--type NumArrayIndices = GLsizei--type NumIndexBlocks = GLsizei------------------------------------------------------------------------------------arrayElement :: ArrayIndex -> IO ()-arrayElement = glArrayElement--foreign import CALLCONV unsafe "glArrayElement" glArrayElement :: GLint -> IO ()--drawArrays :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> IO ()-drawArrays = glDrawArrays . marshalPrimitiveMode--foreign import CALLCONV unsafe "glDrawArrays" glDrawArrays ::-   GLenum -> GLint -> GLsizei -> IO ()--multiDrawArrays ::-      PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks-   -> IO ()-multiDrawArrays = glMultiDrawArraysEXT . marshalPrimitiveMode--EXTENSION_ENTRY("GL_EXT_multi_draw_arrays or OpenGL 1.4",glMultiDrawArraysEXT,GLenum -> Ptr ArrayIndex -> Ptr GLsizei -> GLsizei -> IO ())--drawElements :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> IO ()-drawElements m c = glDrawElements (marshalPrimitiveMode m) c . marshalDataType--foreign import CALLCONV unsafe "glDrawElements" glDrawElements ::-   GLenum -> GLsizei -> GLenum -> Ptr a -> IO ()--multiDrawElements ::-      PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a)-   -> NumIndexBlocks -> IO ()-multiDrawElements m c =-   glMultiDrawElementsEXT (marshalPrimitiveMode m) c . marshalDataType--EXTENSION_ENTRY("GL_EXT_multi_draw_arrays or OpenGL 1.4",glMultiDrawElementsEXT,GLenum -> Ptr GLsizei -> GLenum -> Ptr (Ptr a) -> GLsizei -> IO ())--drawRangeElements ::-      PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType-   -> Ptr a -> IO ()-drawRangeElements m (s, e) c =-   glDrawRangeElementsEXT (marshalPrimitiveMode m) (fromIntegral s)-                          (fromIntegral e) c . marshalDataType--EXTENSION_ENTRY("GL_EXT_draw_range_elements or OpenGL 1.2",glDrawRangeElementsEXT,GLenum -> GLuint -> GLuint -> GLsizei -> GLenum -> Ptr a -> IO ())--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)--EXTENSION_ENTRY("GL_EXT_compiled_vertex_array",glLockArraysEXT,GLint -> GLsizei -> IO ())-EXTENSION_ENTRY("GL_EXT_compiled_vertex_array",glUnlockArraysEXT,IO ())-------------------------------------------------------------------------------------- We almost could use makeStateVarMaybe below, but, alas, this is client state.--primitiveRestartIndex :: StateVar (Maybe ArrayIndex)-primitiveRestartIndex =-   makeStateVar getPrimitiverestartIndex setPrimitiverestartIndex--getPrimitiverestartIndex :: IO (Maybe ArrayIndex)-getPrimitiverestartIndex = do-   state <- get (makeCapability CapPrimitiveRestart)-   if state == Enabled-      then fmap Just $ getInteger1 fromIntegral GetPrimitiveRestartIndex-      else return Nothing--setPrimitiverestartIndex :: Maybe ArrayIndex -> IO ()-setPrimitiverestartIndex maybeIdx = case maybeIdx of-   Nothing  -> glDisableClientState primitiveRestartNV-   Just idx -> do glEnableClientState primitiveRestartNV-                  glPrimitiveRestartIndexNV (fromIntegral idx)-   where primitiveRestartNV = 0x8558   -- ToDo: HACK!--EXTENSION_ENTRY("GL_NV_primitive_restart",glPrimitiveRestartIndexNV,GLuint -> IO ())------------------------------------------------------------------------------------data GetPointervPName =-     VertexArrayPointer-   | NormalArrayPointer-   | ColorArrayPointer-   | IndexArrayPointer-   | TextureCoordArrayPointer-   | EdgeFlagArrayPointer-   | FogCoordArrayPointer-   | SecondaryColorArrayPointer-   | FeedbackBufferPointer-   | SelectionBufferPointer-   | WeightArrayPointer-   | MatrixIndexArrayPointer--marshalGetPointervPName :: GetPointervPName -> GLenum-marshalGetPointervPName x = case x of-   VertexArrayPointer -> 0x808e-   NormalArrayPointer -> 0x808f-   ColorArrayPointer -> 0x8090-   IndexArrayPointer -> 0x8091-   TextureCoordArrayPointer -> 0x8092-   EdgeFlagArrayPointer -> 0x8093-   FogCoordArrayPointer -> 0x8456-   SecondaryColorArrayPointer -> 0x845d-   FeedbackBufferPointer -> 0xdf0-   SelectionBufferPointer -> 0xdf3-   WeightArrayPointer -> 0x86ac-   MatrixIndexArrayPointer -> 0x8849------------------------------------------------------------------------------------getPointer :: GetPointervPName -> IO (Ptr a)-getPointer n = alloca $ \buf -> do-   glGetPointerv (marshalGetPointervPName n) buf-   peek buf--foreign import CALLCONV unsafe "glGetPointerv" glGetPointerv ::-   GLenum -> Ptr (Ptr a) -> IO ()------------------------------------------------------------------------------------vertexAttribPointer :: AttribLocation -> StateVar (IntegerHandling, VertexArrayDescriptor a)-vertexAttribPointer location = undefined-   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 location (h, VertexArrayDescriptor n d s p) = case h of-   ToFloat -> glVertexAttribPointerARB location n md (marshalGLboolean False) s p-   ToNormalizedFloat -> glVertexAttribPointerARB location n md (marshalGLboolean True) s p-   KeepIntegral -> glVertexAttribIPointer location n md s p-  where md = marshalDataType d--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttribPointerARB,AttribLocation -> GLint -> GLenum -> GLboolean -> GLsizei -> Ptr a -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribIPointer,AttribLocation -> GLint -> GLenum -> GLsizei -> Ptr a -> IO ())------------------------------------------------------------------------------------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 = glDisableVertexAttribArrayARB-setVertexAttribArray Enabled = glEnableVertexAttribArrayARB--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glDisableVertexAttribArrayARB,AttribLocation -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glEnableVertexAttribArrayARB,AttribLocation -> IO ())
− Graphics/Rendering/OpenGL/GL/VertexAttributes.hs 
@@ -1,366 +0,0 @@--- #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 ( Applicative(..) )-import Control.Monad ( ap )-import Data.Foldable ( Foldable(..) )-import Data.Ix ( Ix )-import Data.Traversable ( Traversable(..) )-import Data.Typeable (-   Typeable(..), mkTyCon, mkTyConApp, Typeable1(..), typeOfDefault )-import Foreign.Ptr ( castPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.PeekPoke (-   peek1, poke2, poke3, poke4, poke1, peek2, peek3, peek4 )-------------------------------------------------------------------------------------- | Texture coordinates with /t/=0, /r/=0, and /q/=1.-newtype TexCoord1 a = TexCoord1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 TexCoord1 where-   typeOf1 _ = mkTyConApp (mkTyCon "TexCoord1") []--instance Typeable a => Typeable (TexCoord1 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (TexCoord1 a) where-   sizeOf    ~(TexCoord1 s) = sizeOf s-   alignment ~(TexCoord1 s) = alignment s-   peek = peek1 TexCoord1 . castPtr-   poke ptr (TexCoord1 s) = poke1 (castPtr ptr) s-------------------------------------------------------------------------------------- | Texture coordinates with /r/=0 and /q/=1.-data TexCoord2 a = TexCoord2 !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 TexCoord2 where-   typeOf1 _ = mkTyConApp (mkTyCon "TexCoord2") []--instance Typeable a => Typeable (TexCoord2 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (TexCoord2 a) where-   sizeOf ~(TexCoord2 x _) = 2 * sizeOf x-   alignment ~(TexCoord2 x _) = alignment x-   peek = peek2 TexCoord2 . castPtr-   poke ptr (TexCoord2 x y) = poke2 (castPtr ptr) x y-------------------------------------------------------------------------------------- | Texture coordinates with /q/=1.-data TexCoord3 a = TexCoord3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 TexCoord3 where-   typeOf1 _ = mkTyConApp (mkTyCon "TexCoord3") []--instance Typeable a => Typeable (TexCoord3 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (TexCoord3 a) where-   sizeOf ~(TexCoord3 x _ _) = 3 * sizeOf x-   alignment ~(TexCoord3 x _ _) = alignment x-   peek = peek3 TexCoord3 . castPtr-   poke ptr (TexCoord3 x y z) = poke3 (castPtr ptr) x y z-------------------------------------------------------------------------------------- | Fully-fledged four-dimensional texture coordinates.-data TexCoord4 a = TexCoord4 !a !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 TexCoord4 where-   typeOf1 _ = mkTyConApp (mkTyCon "TexCoord4") []--instance Typeable a => Typeable (TexCoord4 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (TexCoord4 a) where-   sizeOf ~(TexCoord4 x _ _ _) = 4 * sizeOf x-   alignment ~(TexCoord4 x _ _ _) = alignment x-   peek = peek4 TexCoord4 . castPtr-   poke ptr (TexCoord4 x y z w) = poke4 (castPtr ptr) x y z w-------------------------------------------------------------------------------------- A three-dimensional normal.-data Normal3 a = Normal3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read) -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 Typeable1 Normal3 where-   typeOf1 _ = mkTyConApp (mkTyCon "Normal3") []--instance Typeable a => Typeable (Normal3 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Normal3 a) where-   sizeOf ~(Normal3 x _ _) = 3 * sizeOf x-   alignment ~(Normal3 x _ _) = alignment x-   peek = peek3 Normal3 . castPtr-   poke ptr (Normal3 x y z) = poke3 (castPtr ptr) x y z-------------------------------------------------------------------------------------- | A fog coordinate.-newtype FogCoord1 a = FogCoord1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 FogCoord1 where-   typeOf1 _ = mkTyConApp (mkTyCon "FogCoord1") []--instance Typeable a => Typeable (FogCoord1 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (FogCoord1 a) where-   sizeOf    ~(FogCoord1 s) = sizeOf s-   alignment ~(FogCoord1 s) = alignment s-   peek = peek1 FogCoord1 . castPtr-   poke ptr (FogCoord1 s) = poke1 (castPtr ptr) s-------------------------------------------------------------------------------------- An RGBA color with /A/=1.-data Color3 a = Color3 !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Color3 where-   typeOf1 _ = mkTyConApp (mkTyCon "Color3") []--instance Typeable a => Typeable (Color3 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Color3 a) where-   sizeOf ~(Color3 x _ _) = 3 * sizeOf x-   alignment ~(Color3 x _ _) = alignment x-   peek = peek3 Color3 . castPtr-   poke ptr (Color3 x y z) = poke3 (castPtr ptr) x y z-------------------------------------------------------------------------------------- | A fully-fledged RGBA color.-data Color4 a = Color4 !a !a !a !a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Color4 where-   typeOf1 _ = mkTyConApp (mkTyCon "Color4") []--instance Typeable a => Typeable (Color4 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Color4 a) where-   sizeOf ~(Color4 x _ _ _) = 4 * sizeOf x-   alignment ~(Color4 x _ _ _) = alignment x-   peek = peek4 Color4 . castPtr-   poke ptr (Color4 x y z w) = poke4 (castPtr ptr) x y z w-------------------------------------------------------------------------------------- | A color index.-newtype Index1 a = Index1 a-   deriving (Eq, Ord, Ix, Bounded, Show, Read)--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 Typeable1 Index1 where-   typeOf1 _ = mkTyConApp (mkTyCon "Index1") []--instance Typeable a => Typeable (Index1 a) where-   typeOf = typeOfDefault--instance Storable a => Storable (Index1 a) where-   sizeOf    ~(Index1 s) = sizeOf s-   alignment ~(Index1 s) = alignment s-   peek = peek1 Index1 . castPtr-   poke ptr (Index1 s) = poke1 (castPtr ptr) s
− Graphics/Rendering/OpenGL/GL/VertexSpec.hs 
@@ -1,1558 +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,-   Vertex1(..), Vertex2(..), Vertex3(..), Vertex4(..),--   -- * 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.Int-import Data.Word-import Foreign.Marshal.Array ( allocaArray )-import Foreign.Ptr ( Ptr, castPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLbyte, GLshort, GLint, GLubyte, GLushort, GLuint, GLfloat,-   GLdouble )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.PeekPoke (-   poke4, peek1M, peek2M, peek3M, peek4M )-import Graphics.Rendering.OpenGL.GL.QueryUtils (-   AttribLocation(..),-   GetPName(GetCurrentTextureCoords, GetCurrentNormal, GetCurrentFogCoord,-            GetCurrentColor, GetCurrentSecondaryColor, GetCurrentIndex,-            GetMaxTextureUnits,GetRGBAMode),-   getBoolean1, getInteger1, getEnum1, getFloat1, getFloat3, getFloat4,-   GetVertexAttribPName(GetCurrentVertexAttrib),-   getVertexAttribFloat4, getVertexAttribIInteger4, getVertexAttribIuInteger4  )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.Tensor (-   Vertex1(..), Vertex2(..), Vertex3(..), Vertex4(..),-   Vector1(..), Vector2(..), Vector3(..), Vector4(..) )-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit (-   TextureUnit(..), marshalTextureUnit, unmarshalTextureUnit )-import Graphics.Rendering.OpenGL.GL.VertexAttributes (-   TexCoord1(..), TexCoord2(..), TexCoord3(..), TexCoord4(..),-   Normal3(..), FogCoord1(..), Color3(..), Color4(..), Index1(..) )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"-#include "HsOpenGLTypes.h"-------------------------------------------------------------------------------------- | 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 ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glVertex2s" glVertex2s ::-   GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glVertex3s" glVertex3s ::-   GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glVertex4s" glVertex4s ::-   GLshort -> GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glVertex2sv" glVertex2sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glVertex3sv" glVertex3sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glVertex4sv" glVertex4sv ::-   Ptr GLshort -> IO ()--instance VertexComponent GLshort_ where-   vertex2 = glVertex2s-   vertex3 = glVertex3s-   vertex4 = glVertex4s--   vertex2v = glVertex2sv-   vertex3v = glVertex3sv-   vertex4v = glVertex4sv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glVertex2i" glVertex2i ::-   GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glVertex3i" glVertex3i ::-   GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glVertex4i" glVertex4i ::-   GLint -> GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glVertex2iv" glVertex2iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glVertex3iv" glVertex3iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glVertex4iv" glVertex4iv ::-   Ptr GLint -> IO ()--instance VertexComponent GLint_ where-   vertex2 = glVertex2i-   vertex3 = glVertex3i-   vertex4 = glVertex4i--   vertex2v = glVertex2iv-   vertex3v = glVertex3iv-   vertex4v = glVertex4iv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glVertex2f" glVertex2f ::-   GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glVertex3f" glVertex3f ::-   GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glVertex4f" glVertex4f ::-   GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glVertex2fv" glVertex2fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glVertex3fv" glVertex3fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glVertex4fv" glVertex4fv ::-   Ptr GLfloat -> IO ()--instance VertexComponent GLfloat_ where-   vertex2 = glVertex2f-   vertex3 = glVertex3f-   vertex4 = glVertex4f--   vertex2v = glVertex2fv-   vertex3v = glVertex3fv-   vertex4v = glVertex4fv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glVertex2d" glVertex2d ::-   GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glVertex3d" glVertex3d ::-   GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glVertex4d" glVertex4d ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glVertex2dv" glVertex2dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glVertex3dv" glVertex3dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glVertex4dv" glVertex4dv ::-   Ptr GLdouble -> IO ()--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 ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glTexCoord1s" glTexCoord1s ::-   GLshort -> IO ()--foreign import CALLCONV unsafe "glTexCoord2s" glTexCoord2s ::-   GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glTexCoord3s" glTexCoord3s ::-   GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glTexCoord4s" glTexCoord4s ::-   GLshort -> GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glTexCoord1sv" glTexCoord1sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glTexCoord2sv" glTexCoord2sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glTexCoord3sv" glTexCoord3sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glTexCoord4sv" glTexCoord4sv ::-   Ptr GLshort -> IO ()--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1sARB,GLenum -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2sARB,GLenum -> GLshort -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3sARB,GLenum -> GLshort -> GLshort -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4sARB,GLenum -> GLshort -> GLshort -> GLshort -> GLshort -> IO ())--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1svARB,GLenum -> Ptr GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2svARB,GLenum -> Ptr GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3svARB,GLenum -> Ptr GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4svARB,GLenum -> Ptr GLshort -> IO ())--instance TexCoordComponent GLshort_ where-   texCoord1 = glTexCoord1s-   texCoord2 = glTexCoord2s-   texCoord3 = glTexCoord3s-   texCoord4 = glTexCoord4s--   texCoord1v = glTexCoord1sv-   texCoord2v = glTexCoord2sv-   texCoord3v = glTexCoord3sv-   texCoord4v = glTexCoord4sv--   multiTexCoord1 = glMultiTexCoord1sARB-   multiTexCoord2 = glMultiTexCoord2sARB-   multiTexCoord3 = glMultiTexCoord3sARB-   multiTexCoord4 = glMultiTexCoord4sARB--   multiTexCoord1v = glMultiTexCoord1svARB-   multiTexCoord2v = glMultiTexCoord2svARB-   multiTexCoord3v = glMultiTexCoord3svARB-   multiTexCoord4v = glMultiTexCoord4svARB------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glTexCoord1i" glTexCoord1i ::-   GLint -> IO ()--foreign import CALLCONV unsafe "glTexCoord2i" glTexCoord2i ::-   GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glTexCoord3i" glTexCoord3i ::-   GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glTexCoord4i" glTexCoord4i ::-   GLint -> GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glTexCoord1iv" glTexCoord1iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glTexCoord2iv" glTexCoord2iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glTexCoord3iv" glTexCoord3iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glTexCoord4iv" glTexCoord4iv ::-   Ptr GLint -> IO ()--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1iARB,GLenum -> GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2iARB,GLenum -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3iARB,GLenum -> GLint -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4iARB,GLenum -> GLint -> GLint -> GLint -> GLint -> IO ())--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1ivARB,GLenum -> Ptr GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2ivARB,GLenum -> Ptr GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3ivARB,GLenum -> Ptr GLint -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4ivARB,GLenum -> Ptr GLint -> IO ())--instance TexCoordComponent GLint_ where-   texCoord1 = glTexCoord1i-   texCoord2 = glTexCoord2i-   texCoord3 = glTexCoord3i-   texCoord4 = glTexCoord4i--   texCoord1v = glTexCoord1iv-   texCoord2v = glTexCoord2iv-   texCoord3v = glTexCoord3iv-   texCoord4v = glTexCoord4iv--   multiTexCoord1 = glMultiTexCoord1iARB-   multiTexCoord2 = glMultiTexCoord2iARB-   multiTexCoord3 = glMultiTexCoord3iARB-   multiTexCoord4 = glMultiTexCoord4iARB--   multiTexCoord1v = glMultiTexCoord1ivARB-   multiTexCoord2v = glMultiTexCoord2ivARB-   multiTexCoord3v = glMultiTexCoord3ivARB-   multiTexCoord4v = glMultiTexCoord4ivARB------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glTexCoord1f" glTexCoord1f ::-   GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexCoord2f" glTexCoord2f ::-   GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexCoord3f" glTexCoord3f ::-   GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexCoord4f" glTexCoord4f ::-   GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexCoord1fv" glTexCoord1fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexCoord2fv" glTexCoord2fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexCoord3fv" glTexCoord3fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glTexCoord4fv" glTexCoord4fv ::-   Ptr GLfloat -> IO ()--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1fARB,GLenum -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2fARB,GLenum -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3fARB,GLenum -> GLfloat -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4fARB,GLenum -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1fvARB,GLenum -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2fvARB,GLenum -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3fvARB,GLenum -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4fvARB,GLenum -> Ptr GLfloat -> IO ())--instance TexCoordComponent GLfloat_ where-   texCoord1 = glTexCoord1f-   texCoord2 = glTexCoord2f-   texCoord3 = glTexCoord3f-   texCoord4 = glTexCoord4f--   texCoord1v = glTexCoord1fv-   texCoord2v = glTexCoord2fv-   texCoord3v = glTexCoord3fv-   texCoord4v = glTexCoord4fv--   multiTexCoord1 = glMultiTexCoord1fARB-   multiTexCoord2 = glMultiTexCoord2fARB-   multiTexCoord3 = glMultiTexCoord3fARB-   multiTexCoord4 = glMultiTexCoord4fARB--   multiTexCoord1v = glMultiTexCoord1fvARB-   multiTexCoord2v = glMultiTexCoord2fvARB-   multiTexCoord3v = glMultiTexCoord3fvARB-   multiTexCoord4v = glMultiTexCoord4fvARB------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glTexCoord1d" glTexCoord1d ::-   GLdouble -> IO ()--foreign import CALLCONV unsafe "glTexCoord2d" glTexCoord2d ::-   GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glTexCoord3d" glTexCoord3d ::-   GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glTexCoord4d" glTexCoord4d ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glTexCoord1dv" glTexCoord1dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glTexCoord2dv" glTexCoord2dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glTexCoord3dv" glTexCoord3dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glTexCoord4dv" glTexCoord4dv ::-   Ptr GLdouble -> IO ()--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1dARB,GLenum -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2dARB,GLenum -> GLdouble -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3dARB,GLenum -> GLdouble -> GLdouble -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4dARB,GLenum -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ())--EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord1dvARB,GLenum -> Ptr GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord2dvARB,GLenum -> Ptr GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord3dvARB,GLenum -> Ptr GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_multitexture or OpenGL 1.3",glMultiTexCoord4dvARB,GLenum -> Ptr GLdouble -> IO ())--instance TexCoordComponent GLdouble_ where-   texCoord1 = glTexCoord1d-   texCoord2 = glTexCoord2d-   texCoord3 = glTexCoord3d-   texCoord4 = glTexCoord4d--   texCoord1v = glTexCoord1dv-   texCoord2v = glTexCoord2dv-   texCoord3v = glTexCoord3dv-   texCoord4v = glTexCoord4dv--   multiTexCoord1 = glMultiTexCoord1dARB-   multiTexCoord2 = glMultiTexCoord2dARB-   multiTexCoord3 = glMultiTexCoord3dARB-   multiTexCoord4 = glMultiTexCoord4dARB--   multiTexCoord1v = glMultiTexCoord1dvARB-   multiTexCoord2v = glMultiTexCoord2dvARB-   multiTexCoord3v = glMultiTexCoord3dvARB-   multiTexCoord4v = glMultiTexCoord4dvARB-------------------------------------------------------------------------------------- | 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 ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glNormal3b" glNormal3b ::-   GLbyte -> GLbyte -> GLbyte -> IO ()--foreign import CALLCONV unsafe "glNormal3bv" glNormal3bv ::-   Ptr GLbyte -> IO ()--instance NormalComponent GLbyte_ where-   normal3 = glNormal3b-   normal3v = glNormal3bv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glNormal3s" glNormal3s ::-   GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glNormal3sv" glNormal3sv ::-   Ptr GLshort -> IO ()--instance NormalComponent GLshort_ where-   normal3 = glNormal3s-   normal3v = glNormal3sv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glNormal3i" glNormal3i ::-   GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glNormal3iv" glNormal3iv ::-   Ptr GLint -> IO ()--instance NormalComponent GLint_ where-   normal3 = glNormal3i-   normal3v = glNormal3iv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glNormal3f" glNormal3f ::-   GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glNormal3fv" glNormal3fv ::-   Ptr GLfloat -> IO ()--instance NormalComponent GLfloat_ where-   normal3 = glNormal3f-   normal3v = glNormal3fv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glNormal3d" glNormal3d ::-   GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glNormal3dv" glNormal3dv ::-   Ptr GLdouble -> IO ()--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 ()------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoordfEXT,GLfloat -> IO ())-EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoordfvEXT,Ptr GLfloat -> IO ())--instance FogCoordComponent GLfloat_ where-   fogCoord1 = glFogCoordfEXT-   fogCoord1v = glFogCoordfvEXT------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoorddEXT,GLdouble -> IO ())-EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoorddvEXT,Ptr GLdouble -> IO ())--instance FogCoordComponent GLdouble_ where-   fogCoord1 = glFogCoorddEXT-   fogCoord1v = glFogCoorddvEXT-------------------------------------------------------------------------------------- | 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 ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3b" glColor3b ::-   GLbyte -> GLbyte -> GLbyte -> IO ()--foreign import CALLCONV unsafe "glColor4b" glColor4b ::-   GLbyte -> GLbyte -> GLbyte -> GLbyte -> IO ()--foreign import CALLCONV unsafe "glColor3bv" glColor3bv ::-   Ptr GLbyte -> IO ()--foreign import CALLCONV unsafe "glColor4bv" glColor4bv ::-   Ptr GLbyte -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3bEXT,GLbyte -> GLbyte -> GLbyte -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3bvEXT,Ptr GLbyte -> IO ())--instance ColorComponent GLbyte_ where-   color3 = glColor3b-   color4 = glColor4b--   color3v = glColor3bv-   color4v = glColor4bv--   secondaryColor3 = glSecondaryColor3bEXT-   secondaryColor3v = glSecondaryColor3bvEXT------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3s" glColor3s ::-   GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glColor4s" glColor4s ::-   GLshort -> GLshort -> GLshort -> GLshort -> IO ()--foreign import CALLCONV unsafe "glColor3sv" glColor3sv ::-   Ptr GLshort -> IO ()--foreign import CALLCONV unsafe "glColor4sv" glColor4sv ::-   Ptr GLshort -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3sEXT,GLshort -> GLshort -> GLshort -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3svEXT,Ptr GLshort -> IO ())--instance ColorComponent GLshort_ where-   color3 = glColor3s-   color4 = glColor4s--   color3v = glColor3sv-   color4v = glColor4sv--   secondaryColor3 = glSecondaryColor3sEXT-   secondaryColor3v = glSecondaryColor3svEXT------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3i" glColor3i ::-   GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glColor4i" glColor4i ::-   GLint -> GLint -> GLint -> GLint -> IO ()--foreign import CALLCONV unsafe "glColor3iv" glColor3iv ::-   Ptr GLint -> IO ()--foreign import CALLCONV unsafe "glColor4iv" glColor4iv ::-   Ptr GLint -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3iEXT,GLint -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3ivEXT,Ptr GLint -> IO ())--instance ColorComponent GLint_ where-   color3 = glColor3i-   color4 = glColor4i--   color3v = glColor3iv-   color4v = glColor4iv--   secondaryColor3 = glSecondaryColor3iEXT-   secondaryColor3v = glSecondaryColor3ivEXT------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3f" glColor3f ::-   GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glColor4f" glColor4f ::-   GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()--foreign import CALLCONV unsafe "glColor3fv" glColor3fv ::-   Ptr GLfloat -> IO ()--foreign import CALLCONV unsafe "glColor4fv" glColor4fv ::-   Ptr GLfloat -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3fEXT,GLfloat -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3fvEXT,Ptr GLfloat -> IO ())--instance ColorComponent GLfloat_ where-   color3 = glColor3f-   color4 = glColor4f--   color3v = glColor3fv-   color4v = glColor4fv--   secondaryColor3 = glSecondaryColor3fEXT-   secondaryColor3v = glSecondaryColor3fvEXT------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3d" glColor3d ::-   GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glColor4d" glColor4d ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "glColor3dv" glColor3dv ::-   Ptr GLdouble -> IO ()--foreign import CALLCONV unsafe "glColor4dv" glColor4dv ::-   Ptr GLdouble -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3dEXT,GLdouble -> GLdouble -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3dvEXT,Ptr GLdouble -> IO ())--instance ColorComponent GLdouble_ where-   color3 = glColor3d-   color4 = glColor4d--   color3v = glColor3dv-   color4v = glColor4dv--   secondaryColor3 = glSecondaryColor3dEXT-   secondaryColor3v = glSecondaryColor3dvEXT------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3ub" glColor3ub ::-   GLubyte -> GLubyte -> GLubyte -> IO ()--foreign import CALLCONV unsafe "glColor4ub" glColor4ub ::-   GLubyte -> GLubyte -> GLubyte -> GLubyte -> IO ()---foreign import CALLCONV unsafe "glColor3ubv" glColor3ubv ::-   Ptr GLubyte -> IO ()--foreign import CALLCONV unsafe "glColor4ubv" glColor4ubv ::-   Ptr GLubyte -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3ubEXT,GLubyte -> GLubyte -> GLubyte -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3ubvEXT,Ptr GLubyte -> IO ())--instance ColorComponent GLubyte_ where-   color3 = glColor3ub-   color4 = glColor4ub--   color3v = glColor3ubv-   color4v = glColor4ubv--   secondaryColor3 = glSecondaryColor3ubEXT-   secondaryColor3v = glSecondaryColor3ubvEXT------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3us" glColor3us ::-   GLushort -> GLushort -> GLushort -> IO ()--foreign import CALLCONV unsafe "glColor4us" glColor4us ::-   GLushort -> GLushort -> GLushort -> GLushort -> IO ()--foreign import CALLCONV unsafe "glColor3usv" glColor3usv ::-   Ptr GLushort -> IO ()--foreign import CALLCONV unsafe "glColor4usv" glColor4usv ::-   Ptr GLushort -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3usEXT,GLushort -> GLushort -> GLushort -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3usvEXT,Ptr GLushort -> IO ())--instance ColorComponent GLushort_ where-   color3 = glColor3us-   color4 = glColor4us--   color3v = glColor3usv-   color4v = glColor4usv--   secondaryColor3 = glSecondaryColor3usEXT-   secondaryColor3v = glSecondaryColor3usvEXT------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glColor3ui" glColor3ui ::-   GLuint -> GLuint -> GLuint -> IO ()--foreign import CALLCONV unsafe "glColor4ui" glColor4ui ::-   GLuint -> GLuint -> GLuint -> GLuint -> IO ()--foreign import CALLCONV unsafe "glColor3uiv" glColor3uiv ::-   Ptr GLuint -> IO ()--foreign import CALLCONV unsafe "glColor4uiv" glColor4uiv ::-   Ptr GLuint -> IO ()--EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3uiEXT,GLuint -> GLuint -> GLuint -> IO ())-EXTENSION_ENTRY("GL_EXT_secondary_color or OpenGL 1.4",glSecondaryColor3uivEXT,Ptr GLuint -> IO ())--instance ColorComponent GLuint_ where-   color3 = glColor3ui-   color4 = glColor4ui--   color3v = glColor3uiv-   color4v = glColor4uiv--   secondaryColor3 = glSecondaryColor3uiEXT-   secondaryColor3v = glSecondaryColor3uivEXT-------------------------------------------------------------------------------------- | 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 ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glIndexs" glIndexs ::-   GLshort -> IO ()--foreign import CALLCONV unsafe "glIndexsv" glIndexsv ::-   Ptr GLshort -> IO ()--instance IndexComponent GLshort_ where-   index1 = glIndexs-   index1v = glIndexsv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glIndexi" glIndexi ::-   GLint -> IO ()--foreign import CALLCONV unsafe "glIndexiv" glIndexiv ::-   Ptr GLint -> IO ()--instance IndexComponent GLint_ where-   index1 = glIndexi-   index1v = glIndexiv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glIndexf" glIndexf ::-   GLfloat -> IO ()--foreign import CALLCONV unsafe "glIndexfv" glIndexfv ::-   Ptr GLfloat -> IO ()--instance IndexComponent GLfloat_ where-   index1 = glIndexf-   index1v = glIndexfv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glIndexd" glIndexd ::-   GLdouble -> IO ()--foreign import CALLCONV unsafe "glIndexdv" glIndexdv ::-   Ptr GLdouble -> IO ()--instance IndexComponent GLdouble_ where-   index1 = glIndexd-   index1v = glIndexdv------------------------------------------------------------------------------------foreign import CALLCONV unsafe "glIndexub" glIndexub ::-   GLubyte -> IO ()--foreign import CALLCONV unsafe "glIndexubv" glIndexubv ::-   Ptr GLubyte -> IO ()--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------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4bvARB,AttribLocation -> Ptr GLbyte -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4NbvARB,AttribLocation -> Ptr GLbyte -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4bv,AttribLocation -> Ptr GLbyte -> IO ())--instance VertexAttribComponent GLbyte_ where-   vertexAttrib4v = glVertexAttrib4bvARB-   vertexAttrib4Nv = glVertexAttrib4NbvARB-   vertexAttrib4Iv = glVertexAttribI4bv------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4NubARB,AttribLocation -> GLubyte -> GLubyte -> GLubyte -> GLubyte -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4ubvARB,AttribLocation -> Ptr GLubyte -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4NubvARB,AttribLocation -> Ptr GLubyte -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4ubv,AttribLocation -> Ptr GLubyte -> IO ())--instance VertexAttribComponent GLubyte_ where-   vertexAttrib4N = glVertexAttrib4NubARB-   vertexAttrib4v = glVertexAttrib4ubvARB-   vertexAttrib4Nv = glVertexAttrib4NubvARB-   vertexAttrib4Iv = glVertexAttribI4ubv------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib1sARB,AttribLocation -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib2sARB,AttribLocation -> GLshort -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib3sARB,AttribLocation -> GLshort -> GLshort -> GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4sARB,AttribLocation -> GLshort -> GLshort -> GLshort -> GLshort -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib1svARB,AttribLocation -> Ptr GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib2svARB,AttribLocation -> Ptr GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib3svARB,AttribLocation -> Ptr GLshort -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4svARB,AttribLocation -> Ptr GLshort -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4NsvARB,AttribLocation -> Ptr GLshort -> IO ())--EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4sv,AttribLocation -> Ptr GLshort -> IO ())--instance VertexAttribComponent GLshort_ where-   vertexAttrib1 = glVertexAttrib1sARB-   vertexAttrib2 = glVertexAttrib2sARB-   vertexAttrib3 = glVertexAttrib3sARB-   vertexAttrib4 = glVertexAttrib4sARB--   vertexAttrib1v = glVertexAttrib1svARB-   vertexAttrib2v = glVertexAttrib2svARB-   vertexAttrib3v = glVertexAttrib3svARB-   vertexAttrib4v = glVertexAttrib4svARB--   vertexAttrib4Nv = glVertexAttrib4NsvARB--   vertexAttrib4Iv = glVertexAttribI4sv------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4usvARB,AttribLocation -> Ptr GLushort -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4NusvARB,AttribLocation -> Ptr GLushort -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4usv,AttribLocation -> Ptr GLushort -> IO ())--instance VertexAttribComponent GLushort_ where-   vertexAttrib4v = glVertexAttrib4usvARB-   vertexAttrib4Nv = glVertexAttrib4NusvARB-   vertexAttrib4Iv = glVertexAttribI4usv------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI1i,AttribLocation -> GLint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI2i,AttribLocation -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI3i,AttribLocation -> GLint -> GLint -> GLint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4i,AttribLocation -> GLint -> GLint -> GLint -> GLint -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4ivARB,AttribLocation -> Ptr GLint -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4NivARB,AttribLocation -> Ptr GLint -> IO ())--EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI1iv,AttribLocation -> Ptr GLint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI2iv,AttribLocation -> Ptr GLint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI3iv,AttribLocation -> Ptr GLint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4iv,AttribLocation -> Ptr GLint -> IO ())--instance VertexAttribComponent GLint_ where-   vertexAttrib1I = glVertexAttribI1i-   vertexAttrib2I = glVertexAttribI2i-   vertexAttrib3I = glVertexAttribI3i-   vertexAttrib4I = glVertexAttribI4i--   vertexAttrib4v = glVertexAttrib4ivARB--   vertexAttrib4Nv = glVertexAttrib4NivARB--   vertexAttrib1Iv = glVertexAttribI1iv-   vertexAttrib2Iv = glVertexAttribI2iv-   vertexAttrib3Iv = glVertexAttribI3iv-   vertexAttrib4Iv = glVertexAttribI4iv------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI1ui,AttribLocation -> GLuint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI2ui,AttribLocation -> GLuint -> GLuint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI3ui,AttribLocation -> GLuint -> GLuint -> GLuint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4ui,AttribLocation -> GLuint -> GLuint -> GLuint -> GLuint -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4uivARB,AttribLocation -> Ptr GLuint -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4NuivARB,AttribLocation -> Ptr GLuint -> IO ())--EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI1uiv,AttribLocation -> Ptr GLuint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI2uiv,AttribLocation -> Ptr GLuint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI3uiv,AttribLocation -> Ptr GLuint -> IO ())-EXTENSION_ENTRY("GL_EXT_gpu_shader4 or OpenGL 3.0",glVertexAttribI4uiv,AttribLocation -> Ptr GLuint -> IO ())--instance VertexAttribComponent GLuint_ where-   vertexAttrib1I = glVertexAttribI1ui-   vertexAttrib2I = glVertexAttribI2ui-   vertexAttrib3I = glVertexAttribI3ui-   vertexAttrib4I = glVertexAttribI4ui--   vertexAttrib4v = glVertexAttrib4uivARB--   vertexAttrib4Nv = glVertexAttrib4NuivARB--   vertexAttrib1Iv = glVertexAttribI1uiv-   vertexAttrib2Iv = glVertexAttribI2uiv-   vertexAttrib3Iv = glVertexAttribI3uiv-   vertexAttrib4Iv = glVertexAttribI4uiv------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib1fARB,AttribLocation -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib2fARB,AttribLocation -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib3fARB,AttribLocation -> GLfloat -> GLfloat -> GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4fARB,AttribLocation -> GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib1fvARB,AttribLocation -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib2fvARB,AttribLocation -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib3fvARB,AttribLocation -> Ptr GLfloat -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4fvARB,AttribLocation -> Ptr GLfloat -> IO ())--instance VertexAttribComponent GLfloat_ where-   vertexAttrib1 = glVertexAttrib1fARB-   vertexAttrib2 = glVertexAttrib2fARB-   vertexAttrib3 = glVertexAttrib3fARB-   vertexAttrib4 = glVertexAttrib4fARB--   vertexAttrib1v = glVertexAttrib1fvARB-   vertexAttrib2v = glVertexAttrib2fvARB-   vertexAttrib3v = glVertexAttrib3fvARB-   vertexAttrib4v = glVertexAttrib4fvARB--   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------------------------------------------------------------------------------------EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib1dARB,AttribLocation -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib2dARB,AttribLocation -> GLdouble -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib3dARB,AttribLocation -> GLdouble -> GLdouble -> GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4dARB,AttribLocation -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ())--EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib1dvARB,AttribLocation -> Ptr GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib2dvARB,AttribLocation -> Ptr GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib3dvARB,AttribLocation -> Ptr GLdouble -> IO ())-EXTENSION_ENTRY("GL_ARB_vertex_shader or OpenGL 2.0",glVertexAttrib4dvARB,AttribLocation -> Ptr GLdouble -> IO ())--instance VertexAttribComponent GLdouble_ where-   vertexAttrib1 = glVertexAttrib1dARB-   vertexAttrib2 = glVertexAttrib2dARB-   vertexAttrib3 = glVertexAttrib3dARB-   vertexAttrib4 = glVertexAttrib4dARB--   vertexAttrib1v = glVertexAttrib1dvARB-   vertexAttrib2v = glVertexAttrib2dvARB-   vertexAttrib3v = glVertexAttrib3dvARB-   vertexAttrib4v = glVertexAttrib4dvARB--   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 unmarshalTextureUnit 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,36 +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 Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   Error(..), ErrorCategory(..), getErrors )-------------------------------------------------------------------------------------- | 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,256 +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 ( Ptr, castPtr )-import Foreign.C.String ( peekCString )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-import System.IO.Unsafe ( unsafePerformIO )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLubyte )------------------------------------------------------------------------------------- Alas, GL and GLU define error enumerants with the same names, so we have to--- rename these to avoid name clashes. Ugly, ugly, ugly...--data GL_ErrorCode =-     GL_NoError-   | GL_InvalidEnum-   | GL_InvalidValue-   | GL_InvalidOperation-   | GL_InvalidFramebufferOperation-   | GL_OutOfMemory-   | GL_StackOverflow-   | GL_StackUnderflow-   | GL_TableTooLarge--gl_marshalErrorCode :: GL_ErrorCode -> GLenum-gl_marshalErrorCode x = case x of-   GL_NoError -> 0x0-   GL_InvalidEnum -> 0x500-   GL_InvalidValue -> 0x501-   GL_InvalidOperation -> 0x502-   GL_InvalidFramebufferOperation -> 0x0506-   GL_OutOfMemory -> 0x505-   GL_StackOverflow -> 0x503-   GL_StackUnderflow -> 0x504-   GL_TableTooLarge -> 0x8031------------------------------------------------------------------------------------- See comment above--data GLU_ErrorCode =-     GLU_InvalidEnum-   | GLU_InvalidValue-   | GLU_OutOfMemory-   | GLU_InvalidOperation--glu_marshalErrorCode :: GLU_ErrorCode -> GLenum-glu_marshalErrorCode x = case x of-   GLU_InvalidEnum -> 0x18a24-   GLU_InvalidValue -> 0x18a25-   GLU_OutOfMemory -> 0x18a26-   GLU_InvalidOperation -> 0x18a28-------------------------------------------------------------------------------------- only the errors with the smallest and the largsest enum value-data NurbsError =-     NurbsError1-   | NurbsError37--marshalNurbsError :: NurbsError -> GLenum-marshalNurbsError x = case x of-   NurbsError1 -> 0x1879b-   NurbsError37 -> 0x187bf-------------------------------------------------------------------------------------- only the errors with the smallest and the largsest enum value-data TessError =-     TessError1-   | TessError8--marshalTessError :: TessError -> GLenum-marshalTessError x = case x of-   TessError1 -> 0x18737-   TessError8 -> 0x1873e-------------------------------------------------------------------------------------- | 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_marshalErrorCode  GL_InvalidEnum ||-   c == glu_marshalErrorCode GLU_InvalidEnum--isInvalidValue :: GLenum -> Bool-isInvalidValue c =-   c == gl_marshalErrorCode  GL_InvalidValue ||-   c == glu_marshalErrorCode GLU_InvalidValue--isInvalidOperation :: GLenum -> Bool-isInvalidOperation c =-   c == gl_marshalErrorCode  GL_InvalidOperation ||-   c == glu_marshalErrorCode GLU_InvalidOperation--isInvalidFramebufferOperation :: GLenum -> Bool-isInvalidFramebufferOperation c =-   c == gl_marshalErrorCode GL_InvalidFramebufferOperation--isOutOfMemory :: GLenum -> Bool-isOutOfMemory c =-   c == gl_marshalErrorCode  GL_OutOfMemory ||-   c == glu_marshalErrorCode GLU_OutOfMemory--isStackOverflow :: GLenum -> Bool-isStackOverflow c =-   c == gl_marshalErrorCode GL_StackOverflow--isStackUnderflow :: GLenum -> Bool-isStackUnderflow c =-   c == gl_marshalErrorCode GL_StackUnderflow--isTableTooLarge :: GLenum -> Bool-isTableTooLarge c =-   c == gl_marshalErrorCode GL_TableTooLarge--isTesselatorError :: GLenum -> Bool-isTesselatorError c =-   marshalTessError TessError1 <= c &&-   c <= marshalTessError TessError8--isNURBSError :: GLenum -> Bool-isNURBSError c =-   marshalNurbsError NurbsError1 <= c &&-   c <= marshalNurbsError NurbsError37-------------------------------------------------------------------------------------- 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--foreign import CALLCONV unsafe "gluErrorString" gluErrorString ::-   GLenum -> IO (Ptr GLubyte)-------------------------------------------------------------------------------------- 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_marshalErrorCode GL_NoError)--foreign import CALLCONV unsafe "glGetError" glGetError :: IO GLenum------------------------------------------------------------------------------------getErrors :: IO [Error]-getErrors = do-   es <- getErrorCodesAux (const ([], True))-   mapM makeError es--recordErrorCode :: GLenum -> IO ()-recordErrorCode e = do-   getErrorCodesAux (\es -> (if null es then [e] else [], False))-   return ()--recordInvalidEnum :: IO ()-recordInvalidEnum = recordErrorCode (gl_marshalErrorCode GL_InvalidEnum)--recordInvalidValue :: IO ()-recordInvalidValue = recordErrorCode (gl_marshalErrorCode GL_InvalidValue)--recordOutOfMemory :: IO ()-recordOutOfMemory = recordErrorCode (glu_marshalErrorCode GLU_OutOfMemory)---- 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,53 +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 Foreign.Ptr ( Ptr, castPtr )-import Foreign.C.String ( peekCString )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum, GLubyte )-import Graphics.Rendering.OpenGL.GL.QueryUtils ( maybeNullPtr )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar )------------------------------------------------------------------------------------gluVersion :: GettableStateVar String-gluVersion = makeGettableStateVar (getString Version)--gluExtensions :: GettableStateVar [String]-gluExtensions = makeGettableStateVar (fmap words $ getString Extensions)------------------------------------------------------------------------------------data StringName =-     Version-   | Extensions-   deriving ( Eq, Ord, Show )--marshalStringName :: StringName -> GLenum-marshalStringName x = case x of-   Version -> 0x189c0-   Extensions -> 0x189c1------------------------------------------------------------------------------------getString :: StringName -> IO String-getString n = gluGetString (marshalStringName n) >>=-              maybeNullPtr (return "") (peekCString . castPtr)--foreign import CALLCONV unsafe "gluGetString" gluGetString ::-   GLenum -> IO (Ptr GLubyte)
− Graphics/Rendering/OpenGL/GLU/Matrix.hs 
@@ -1,161 +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 Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( withArray )-import Foreign.Ptr ( Ptr )-import Foreign.Storable ( Storable(peek,peekElemOff) )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLdouble, GLclampd )-import Graphics.Rendering.OpenGL.GL.CoordTrans (-   MatrixOrder(..), Matrix(..), MatrixComponent,-   Vector3(..), Position(..), Size(..) )-import Graphics.Rendering.OpenGL.GL.Extensions (-   FunPtr, unsafePerformIO, Invoker, getProcAddress )-import Graphics.Rendering.OpenGL.GL.GLboolean ( unmarshalGLboolean )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Vertex3(..), Vertex4(..) )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidValue )------------------------------------------------------------------------------------#include "HsOpenGLExt.h"------------------------------------------------------------------------------------- matrix setup--foreign import CALLCONV unsafe "gluOrtho2D" ortho2D ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--foreign import CALLCONV unsafe "gluPerspective" perspective ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()--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--foreign import CALLCONV unsafe "gluLookAt" gluLookAt ::-      GLdouble -> GLdouble -> GLdouble-   -> GLdouble -> GLdouble -> GLdouble-   -> GLdouble -> GLdouble -> GLdouble -> IO ()--pickMatrix ::-   (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> (Position, Size) -> IO ()-pickMatrix (x, y) (w, h) viewport =-   withViewport viewport $ gluPickMatrix x y w h--foreign import CALLCONV unsafe "gluPickMatrix" gluPickMatrix ::-   GLdouble -> GLdouble -> GLdouble -> GLdouble -> Ptr GLint -> IO ()------------------------------------------------------------------------------------- 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--foreign import CALLCONV unsafe "gluProject" gluProject ::-      GLdouble -> GLdouble -> GLdouble-   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLint-   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint--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--foreign import CALLCONV unsafe "gluUnProject" gluUnProject ::-      GLdouble -> GLdouble -> GLdouble-   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLint-   -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint--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--EXTENSION_ENTRY("GLU 1.3",gluUnProject4,GLdouble -> GLdouble -> GLdouble -> GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLint -> GLclampd -> GLclampd -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)------------------------------------------------------------------------------------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,75 +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 Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLsizei, GLint, GLenum )-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 gluScaleImage-                    fIn widthIn heightIn dIn pIn widthOut heightOut dOut pOut-            else recordInvalidValue--foreign import CALLCONV unsafe "gluScaleImage" gluScaleImage ::-   GLenum -> GLsizei -> GLsizei -> GLenum -> Ptr a-          -> GLsizei -> GLsizei -> GLenum -> Ptr b -> IO ()------------------------------------------------------------------------------------- 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?--foreign import CALLCONV unsafe "gluBuild1DMipmaps" gluBuild1DMipmaps ::-      GLenum -> GLint -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO GLint------------------------------------------------------------------------------------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?--foreign import CALLCONV unsafe "gluBuild2DMipmaps" gluBuild2DMipmaps ::-      GLenum -> GLint -> GLsizei -> GLsizei -> GLenum -> GLenum -> Ptr a -> IO GLint
− Graphics/Rendering/OpenGL/GLU/NURBS.hs 
@@ -1,465 +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 ( unless )-import Foreign.Marshal.Array ( withArray )-import Foreign.Ptr ( Ptr, nullPtr, castPtr, FunPtr, freeHaskellFunPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLenum, GLint, GLfloat, Capability )-import Graphics.Rendering.OpenGL.GL.Capability ( marshalCapability )-import Graphics.Rendering.OpenGL.GL.ControlPoint-import Graphics.Rendering.OpenGL.GL.CoordTrans (-   Position(..), Size(..), MatrixOrder(ColumnMajor), MatrixComponent, Matrix(..) )-import Graphics.Rendering.OpenGL.GL.Exception ( bracket, bracket_ )-import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )-import Graphics.Rendering.OpenGL.GL.PrimitiveMode ( unmarshalPrimitiveMode )-import Graphics.Rendering.OpenGL.GL.BeginEnd ( PrimitiveMode )-import Graphics.Rendering.OpenGL.GL.VertexSpec (-   Vertex2, Vertex3, Normal3, Color4 )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   recordErrorCode, recordOutOfMemory )------------------------------------------------------------------------------------data NURBSCallback =-     Error-   | Begin-   | Vertex-   | Normal-   | Color-   | TextureCoord-   | End-   | BeginData-   | VertexData-   | NormalData-   | ColorData-   | TextureCoordData-   | EndData--marshalNURBSCallback :: NURBSCallback -> GLenum-marshalNURBSCallback x = case x of-   Error -> 100103-   Begin -> 100164-   Vertex -> 100165-   Normal -> 100166-   Color -> 100167-   TextureCoord -> 100168-   End -> 100169-   BeginData -> 100170-   VertexData -> 100171-   NormalData -> 100172-   ColorData -> 100173-   TextureCoordData -> 100174-   EndData -> 100175------------------------------------------------------------------------------------- chapter 7.1: The NURBS Object---- an opaque pointer to a NURBS object-newtype NURBSObj = NURBSObj (Ptr NURBSObj)--isNullNURBSObj :: NURBSObj -> Bool-isNullNURBSObj (NURBSObj ptr) = ptr == 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)--foreign import CALLCONV safe "gluNewNurbsRenderer"-   gluNewNurbsRenderer :: IO NURBSObj--safeDeleteNurbsRenderer :: NURBSObj -> IO ()-safeDeleteNurbsRenderer nurbsObj =-   unless (isNullNURBSObj nurbsObj) $ gluDeleteNurbsRenderer nurbsObj--foreign import CALLCONV safe "gluDeleteNurbsRenderer"-   gluDeleteNurbsRenderer :: NURBSObj -> IO ()------------------------------------------------------------------------------------- chapter 7.2: Callbacks (begin)--type NURBSBeginCallback = PrimitiveMode -> IO ()--type BeginCallback' = GLenum -> IO ()--withNURBSBeginCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a-withNURBSBeginCallback nurbsObj beginCallback action =-   bracket (makeBeginCallback (beginCallback . unmarshalPrimitiveMode))-           freeHaskellFunPtr $ \callbackPtr -> do-      setBeginCallback nurbsObj (marshalNURBSCallback Begin) callbackPtr-      action--foreign import CALLCONV "wrapper" makeBeginCallback ::-   BeginCallback' -> IO (FunPtr BeginCallback')--foreign import CALLCONV safe "gluNurbsCallback"-   setBeginCallback :: NURBSObj -> GLenum -> FunPtr BeginCallback' -> IO ()------------------------------------------------------------------------------------- chapter 7.2: Callbacks (vertex)--type NURBSVertexCallback = Vertex3 GLfloat -> IO ()--type VertexCallback' = Ptr (Vertex3 GLfloat) -> IO ()--withNURBSVertexCallback :: NURBSObj -> NURBSVertexCallback -> IO a -> IO a-withNURBSVertexCallback nurbsObj vertexCallback action =-   bracket (makeVertexCallback (\p -> peek p >>= vertexCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      setVertexCallback nurbsObj (marshalNURBSCallback Vertex) callbackPtr-      action--foreign import CALLCONV "wrapper" makeVertexCallback ::-   VertexCallback' -> IO (FunPtr VertexCallback')--foreign import CALLCONV safe "gluNurbsCallback"-   setVertexCallback :: NURBSObj -> GLenum -> FunPtr VertexCallback' -> IO ()------------------------------------------------------------------------------------- chapter 7.2: Callbacks (normal)--type NURBSNormalCallback = Normal3 GLfloat -> IO ()--type NormalCallback' = Ptr (Normal3 GLfloat) -> IO ()--withNURBSNormalCallback :: NURBSObj -> NURBSNormalCallback -> IO a -> IO a-withNURBSNormalCallback nurbsObj normalCallback action =-   bracket (makeNormalCallback (\p -> peek p >>= normalCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      setNormalCallback nurbsObj (marshalNURBSCallback Normal) callbackPtr-      action--foreign import CALLCONV "wrapper" makeNormalCallback ::-   NormalCallback' -> IO (FunPtr NormalCallback')--foreign import CALLCONV safe "gluNurbsCallback"-   setNormalCallback :: NURBSObj -> GLenum -> FunPtr NormalCallback' -> IO ()------------------------------------------------------------------------------------- chapter 7.2: Callbacks (color)--type NURBSColorCallback = Color4 GLfloat -> IO ()--type ColorCallback' = Ptr (Color4 GLfloat) -> IO ()--withNURBSColorCallback :: NURBSObj -> NURBSColorCallback -> IO a -> IO a-withNURBSColorCallback nurbsObj colorCallback action =-   bracket (makeColorCallback (\p -> peek p >>= colorCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      setColorCallback nurbsObj (marshalNURBSCallback Color) callbackPtr-      action--foreign import CALLCONV "wrapper" makeColorCallback ::-   ColorCallback' -> IO (FunPtr ColorCallback')--foreign import CALLCONV safe "gluNurbsCallback"-   setColorCallback :: NURBSObj -> GLenum -> FunPtr ColorCallback' -> IO ()------------------------------------------------------------------------------------- chapter 7.2: Callbacks (end)--type NURBSEndCallback = IO ()--withNURBSEndCallback :: NURBSObj -> NURBSEndCallback -> IO a -> IO a-withNURBSEndCallback nurbsObj endCallback action =-   bracket (makeEndCallback endCallback)-           freeHaskellFunPtr $ \callbackPtr -> do-      setEndCallback nurbsObj (marshalNURBSCallback End) callbackPtr-      action--foreign import CALLCONV "wrapper" makeEndCallback ::-   NURBSEndCallback -> IO (FunPtr NURBSEndCallback)--foreign import CALLCONV safe "gluNurbsCallback"-   setEndCallback :: NURBSObj -> GLenum -> FunPtr NURBSEndCallback -> IO ()------------------------------------------------------------------------------------- chapter 7.2: Callbacks (error)--type ErrorCallback = GLenum -> IO ()--withErrorCallback :: NURBSObj -> ErrorCallback -> IO a -> IO a-withErrorCallback nurbsObj errorCallback action =-   bracket (makeErrorCallback errorCallback)-           freeHaskellFunPtr $ \callbackPtr -> do-      setErrorCallback nurbsObj (marshalNURBSCallback Error) callbackPtr-      action--foreign import CALLCONV "wrapper" makeErrorCallback ::-   ErrorCallback -> IO (FunPtr ErrorCallback)--foreign import CALLCONV safe "gluNurbsCallback"-   setErrorCallback :: NURBSObj -> GLenum -> FunPtr ErrorCallback -> IO ()--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)--foreign import CALLCONV safe "gluBeginCurve"-   gluBeginCurve :: NURBSObj -> IO ()--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--foreign import CALLCONV safe "gluNurbsCurve"-   gluNurbsCurve :: NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr GLfloat -> GLint -> GLenum -> IO ()--foreign import CALLCONV safe "gluEndCurve"-   gluEndCurve :: NURBSObj -> IO ()------------------------------------------------------------------------------------- chapter 7.4: NURBS Surfaces--nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a-nurbsBeginEndSurface nurbsObj =-   bracket_ (gluBeginSurface nurbsObj) (gluEndSurface nurbsObj)--foreign import CALLCONV safe "gluBeginSurface"-   gluBeginSurface :: NURBSObj -> IO ()--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))--foreign import CALLCONV safe "gluNurbsSurface"-   gluNurbsSurface :: NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr GLfloat -> GLint -> GLint -> Ptr GLfloat -> GLint -> GLint -> GLenum -> IO ()--foreign import CALLCONV safe "gluEndSurface"-   gluEndSurface :: NURBSObj -> IO ()------------------------------------------------------------------------------------- chapter 7.5: Trimming--class TrimmingPoint p where-   trimmingTarget :: p GLfloat -> GLenum--instance TrimmingPoint Vertex2 where-   trimmingTarget = marshalNURBSTrim . const Map1Trim2--instance TrimmingPoint Vertex3 where-   trimmingTarget = marshalNURBSTrim . const Map1Trim3--data NURBSTrim =-     Map1Trim2-   | Map1Trim3--marshalNURBSTrim :: NURBSTrim -> GLenum-marshalNURBSTrim x = case x of-   Map1Trim2 -> 100210-   Map1Trim3 -> 100211--nurbsBeginEndTrim :: NURBSObj -> IO a -> IO a-nurbsBeginEndTrim nurbsObj =-   bracket_ (gluBeginTrim nurbsObj) (gluEndTrim nurbsObj)--foreign import CALLCONV safe "gluBeginTrim"-   gluBeginTrim :: NURBSObj -> IO ()--pwlCurve :: TrimmingPoint p => NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()-pwlCurve nurbsObj count points stride =-   gluPwlCurve nurbsObj count (castPtr points) stride (trimmingTarget (pseudoPeek points))--foreign import CALLCONV safe "gluPwlCurve"-   gluPwlCurve :: NURBSObj -> GLint -> Ptr GLfloat -> GLint -> GLenum -> IO ()--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))--foreign import CALLCONV safe "gluEndTrim"-   gluEndTrim :: NURBSObj -> IO ()------------------------------------------------------------------------------------- chapter 7.6: NURBS Properties--data NURBSProperty =-     AutoLoadMatrix-   | Culling-   | ParametricTolerance-   | SamplingTolerance-   | DisplayMode'-   | SamplingMethod-   | UStep-   | VStep-   | NURBSMode--marshalNURBSProperty :: NURBSProperty -> GLenum-marshalNURBSProperty x = case x of-   AutoLoadMatrix -> 100200-   Culling -> 100201-   ParametricTolerance -> 100202-   SamplingTolerance -> 100203-   DisplayMode' -> 100204-   SamplingMethod -> 100205-   UStep -> 100206-   VStep -> 100207-   NURBSMode -> 100160------------------------------------------------------------------------------------setNURBSProperty :: NURBSObj -> NURBSProperty -> GLfloat -> IO ()-setNURBSProperty nurbsObj = gluNurbsProperty nurbsObj . marshalNURBSProperty--foreign import CALLCONV safe "gluNurbsProperty"-   gluNurbsProperty :: NURBSObj -> GLenum -> GLfloat -> IO ()------------------------------------------------------------------------------------data NURBSMode =-     NURBSTessellator-   | NURBSRenderer-   deriving ( Eq, Ord, Show )--marshalNURBSMode :: NURBSMode -> GLfloat-marshalNURBSMode x = case x of-   NURBSTessellator -> 100161-   NURBSRenderer -> 100162--setNURBSMode :: NURBSObj -> NURBSMode -> IO ()-setNURBSMode nurbsObj = setNURBSProperty nurbsObj NURBSMode . marshalNURBSMode------------------------------------------------------------------------------------setNURBSCulling :: NURBSObj -> Capability -> IO ()-setNURBSCulling nurbsObj = setNURBSProperty nurbsObj Culling . fromIntegral . marshalCapability------------------------------------------------------------------------------------data SamplingMethod' =-     PathLength'-   | ParametricError'-   | DomainDistance'-   | ObjectPathLength'-   | ObjectParametricError'--marshalSamplingMethod' :: SamplingMethod' -> GLfloat-marshalSamplingMethod' x = case x of-   PathLength' -> 100215-   ParametricError' -> 100216-   DomainDistance' -> 100217-   ObjectPathLength' -> 100209-   ObjectParametricError' -> 100208--setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()-setSamplingMethod' nurbsObj = setNURBSProperty nurbsObj SamplingMethod . 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-      setNURBSProperty nurbsObj SamplingTolerance s-      setSamplingMethod' nurbsObj PathLength'-   ParametricError p -> do-      setNURBSProperty nurbsObj ParametricTolerance p-      setSamplingMethod' nurbsObj ParametricError'-   DomainDistance u v -> do-      setNURBSProperty nurbsObj UStep u-      setNURBSProperty nurbsObj VStep v-      setSamplingMethod' nurbsObj DomainDistance'-   ObjectPathLength s -> do-      setNURBSProperty nurbsObj SamplingTolerance s-      setSamplingMethod' nurbsObj ObjectPathLength'-   ObjectParametricError p -> do-      setNURBSProperty nurbsObj ParametricTolerance p-      setSamplingMethod' nurbsObj ObjectParametricError'------------------------------------------------------------------------------------setAutoLoadMatrix :: NURBSObj -> Bool -> IO ()-setAutoLoadMatrix nurbsObj = setNURBSProperty nurbsObj AutoLoadMatrix . 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, w, 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--foreign import CALLCONV safe "gluLoadSamplingMatrices"-   gluLoadSamplingMatrices :: NURBSObj -> Ptr GLfloat -> Ptr GLfloat -> Ptr GLint -> IO ()------------------------------------------------------------------------------------data DisplayMode' =-     Fill'-   | OutlinePolygon-   | OutlinePatch-   deriving ( Eq, Ord, Show )--marshalDisplayMode' :: DisplayMode' -> GLfloat-marshalDisplayMode' x = case x of-   Fill' -> 100012-   OutlinePolygon -> 100240-   OutlinePatch -> 100241--setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()-setDisplayMode' nurbsObj = setNURBSProperty nurbsObj DisplayMode' . marshalDisplayMode'
− Graphics/Rendering/OpenGL/GLU/Quadrics.hs 
@@ -1,212 +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, FunPtr, freeHaskellFunPtr )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLenum, GLint, GLdouble )-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 -> 0x186aa-   LineStyle -> 0x186ab-   FillStyle -> 0x186ac-   SilhouetteStyle -> 0x186ad------------------------------------------------------------------------------------data QuadricCallback =-     Error'2-   deriving ( Eq, Ord, Show )--marshalQuadricCallback :: QuadricCallback -> GLenum-marshalQuadricCallback x = case x of-   Error'2 -> 0x18707------------------------------------------------------------------------------------type QuadricNormal = Maybe ShadingModel--marshalQuadricNormal :: QuadricNormal -> GLenum-marshalQuadricNormal (Just Smooth) = 0x186a0-marshalQuadricNormal (Just Flat  ) = 0x186a1-marshalQuadricNormal Nothing       = 0x186a2------------------------------------------------------------------------------------data QuadricOrientation =-     Outside-   | Inside-   deriving ( Eq, Ord, Show )--marshalQuadricOrientation :: QuadricOrientation -> GLenum-marshalQuadricOrientation x = case x of-   Outside -> 0x186b4-   Inside -> 0x186b5------------------------------------------------------------------------------------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)--withErrorCallback :: QuadricObj -> QuadricCallback' -> IO a -> IO a-withErrorCallback quadricObj callback action =-   bracket (makeQuadricCallback callback) freeHaskellFunPtr $ \callbackPtr -> do-      gluQuadricCallback quadricObj (marshalQuadricCallback Error'2) 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-------------------------------------------------------------------------------------- 'Char' is a fake here, any marshalable type would do-newtype QuadricObj = QuadricObj (Ptr Char)-   deriving ( Eq )--isNullQuadricObj :: QuadricObj -> Bool-isNullQuadricObj = (QuadricObj nullPtr ==)------------------------------------------------------------------------------------foreign import CALLCONV unsafe "gluNewQuadric" gluNewQuadric :: IO QuadricObj--safeDeleteQuadric :: QuadricObj -> IO ()-safeDeleteQuadric quadricObj =-   unless (isNullQuadricObj quadricObj) $ gluDeleteQuadric quadricObj--foreign import CALLCONV unsafe "gluDeleteQuadric" gluDeleteQuadric ::-   QuadricObj -> IO ()------------------------------------------------------------------------------------type QuadricCallback' = GLenum -> IO ()--foreign import CALLCONV "wrapper" makeQuadricCallback ::-   QuadricCallback' -> IO (FunPtr QuadricCallback')--foreign import CALLCONV unsafe "gluQuadricCallback" gluQuadricCallback ::-   QuadricObj -> GLenum -> FunPtr QuadricCallback' -> IO ()------------------------------------------------------------------------------------foreign import CALLCONV unsafe "gluQuadricNormals" gluQuadricNormals ::-   QuadricObj -> GLenum -> IO ()--foreign import CALLCONV unsafe "gluQuadricTexture" gluQuadricTexture ::-   QuadricObj -> GLboolean -> IO ()--foreign import CALLCONV unsafe "gluQuadricOrientation" gluQuadricOrientation ::-   QuadricObj -> GLenum -> IO ()--foreign import CALLCONV unsafe "gluQuadricDrawStyle" gluQuadricDrawStyle ::-   QuadricObj -> GLenum -> IO ()------------------------------------------------------------------------------------foreign import CALLCONV safe "gluSphere" gluSphere ::-   QuadricObj -> Radius -> Slices -> Stacks -> IO ()--foreign import CALLCONV safe "gluCylinder" gluCylinder ::-  QuadricObj -> Radius -> Radius -> Height -> Slices -> Stacks -> IO ()--foreign import CALLCONV safe "gluDisk" gluDisk ::-   QuadricObj -> Radius -> Radius -> Slices -> Loops -> IO ()--foreign import CALLCONV safe "gluPartialDisk" gluPartialDisk ::-   QuadricObj -> Radius -> Radius -> Slices -> Loops -> Angle -> Angle -> IO ()
− Graphics/Rendering/OpenGL/GLU/Tessellation.hs 
@@ -1,709 +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 Foreign.Marshal.Alloc ( allocaBytes )-import Foreign.Marshal.Array ( peekArray, pokeArray )-import Foreign.Marshal.Pool ( Pool, withPool, pooledNew )-import Foreign.Ptr ( Ptr, nullPtr, plusPtr, castPtr, FunPtr, freeHaskellFunPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.BasicTypes (-   GLboolean, GLclampf, GLdouble, GLenum )-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 (-   Vertex3(..), Normal3(..) )-import Graphics.Rendering.OpenGL.GL.QueryUtils ( maybeNullPtr )-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (-   recordErrorCode, recordOutOfMemory )------------------------------------------------------------------------------------data TessCallback =-     TessBegin-   | Begin-   | TessVertex-   | Vertex-   | TessEnd-   | End-   | TessError-   | Error'-   | TessEdgeFlag-   | EdgeFlag-   | TessCombine-   | TessBeginData-   | TessVertexData-   | TessEndData-   | TessErrorData-   | TessEdgeFlagData-   | TessCombineData--marshalTessCallback :: TessCallback -> GLenum-marshalTessCallback x = case x of-   TessBegin -> 0x18704-   Begin -> 0x18704-   TessVertex -> 0x18705-   Vertex -> 0x18705-   TessEnd -> 0x18706-   End -> 0x18706-   TessError -> 0x18707-   Error' -> 0x18707-   TessEdgeFlag -> 0x18708-   EdgeFlag -> 0x18708-   TessCombine -> 0x18709-   TessBeginData -> 0x1870a-   TessVertexData -> 0x1870b-   TessEndData -> 0x1870c-   TessErrorData -> 0x1870d-   TessEdgeFlagData -> 0x1870e-   TessCombineData -> 0x1870f------------------------------------------------------------------------------------data TessProperty =-     TessWindingRule-   | TessBoundaryOnly-   | TessTolerance--marshalTessProperty :: TessProperty -> GLenum-marshalTessProperty x = case x of-   TessWindingRule -> 0x1872c-   TessBoundaryOnly -> 0x1872d-   TessTolerance -> 0x1872e------------------------------------------------------------------------------------data TessWinding =-     TessWindingOdd-   | TessWindingNonzero-   | TessWindingPositive-   | TessWindingNegative-   | TessWindingAbsGeqTwo-   deriving ( Eq, Ord, Show )--marshalTessWinding :: TessWinding -> GLenum-marshalTessWinding x = case x of-   TessWindingOdd -> 0x18722-   TessWindingNonzero -> 0x18723-   TessWindingPositive -> 0x18724-   TessWindingNegative -> 0x18725-   TessWindingAbsGeqTwo -> 0x18726-------------------------------------------------------------------------------------- | 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-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (AnnotatedVertex v)-instance Ord v => Ord (AnnotatedVertex v)-#else-   deriving ( Eq, Ord )-#endif--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]-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (ComplexContour v)-instance Ord v => Ord (ComplexContour v)-#else-   deriving ( Eq, Ord )-#endif--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]-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (ComplexPolygon v)-instance Ord v => Ord (ComplexPolygon v)-#else-   deriving ( Eq, Ord )-#endif--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 (GLclampf, v)-                        (GLclampf, v)-                        (GLclampf, v)-                        (GLclampf, v)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (WeightedProperties v)-instance Ord v => Ord (WeightedProperties v)-#else-   deriving ( Eq, Ord )-#endif---- | 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]-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (SimpleContour v)-instance Ord v => Ord (SimpleContour v)-#else-   deriving ( Eq, Ord )-#endif---- | The contours of a complex polygon, represented by one or more--- non-intersecting simple contours--newtype PolygonContours v = PolygonContours [SimpleContour v]-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (PolygonContours v)-instance Ord v => Ord (PolygonContours v)-#else-   deriving ( Eq, Ord )-#endif--extractContours :: Storable v => Tessellator PolygonContours v-extractContours windingRule tolerance normal 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 normal 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)-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (Triangle v)-instance Ord v => Ord (Triangle v)-#else-   deriving ( Eq, Ord )-#endif---- | A triangulation of a complex polygon--newtype Triangulation v = Triangulation [Triangle v]-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (Triangulation v)-instance Ord v => Ord (Triangulation v)-#else-   deriving ( Eq, Ord )-#endif--triangulate :: Storable v => Tessellator Triangulation v-triangulate windingRule tolerance normal 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 normal 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]-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (Primitive v)-instance Ord v => Ord (Primitive v)-#else-   deriving ( Eq, Ord )-#endif--newtype SimplePolygon v = SimplePolygon [Primitive v]-#ifdef __HADDOCK__--- Help Haddock a bit, because it doesn't do any instance inference.-instance Eq v => Eq (SimplePolygon v)-instance Ord v => Ord (SimplePolygon v)-#else-   deriving ( Eq, Ord )-#endif--tessellate :: Storable v => Tessellator SimplePolygon v-tessellate windingRule tolerance normal 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 normal 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-newtype TessellatorObj = TessellatorObj (Ptr TessellatorObj)--isNullTesselatorObj :: TessellatorObj -> Bool-isNullTesselatorObj (TessellatorObj ptr) = ptr == 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)--foreign import CALLCONV unsafe "gluNewTess" gluNewTess :: IO TessellatorObj--safeDeleteTess :: TessellatorObj -> IO ()-safeDeleteTess tessObj =-   unless (isNullTesselatorObj tessObj) $ gluDeleteTess tessObj--foreign import CALLCONV unsafe "gluDeleteTess" gluDeleteTess ::-   TessellatorObj -> IO ()------------------------------------------------------------------------------------- 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--foreign import CALLCONV safe "gluTessBeginPolygon" gluTessBeginPolygon ::-   TessellatorObj -> Ptr p -> IO ()--foreign import CALLCONV safe "gluTessEndPolygon" gluTessEndPolygon ::-   TessellatorObj -> IO ()------------------------------------------------------------------------------------- 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--foreign import CALLCONV safe "gluTessBeginContour" gluTessBeginContour ::-   TessellatorObj -> IO ()--foreign import CALLCONV safe "gluTessEndContour" gluTessEndContour ::-   TessellatorObj -> IO ()------------------------------------------------------------------------------------- chapter 5.2: Polygon Definition (vertices)--defineVertex :: TessellatorObj -> Ptr (AnnotatedVertex v) -> IO ()-defineVertex tessObj ptr = gluTessVertex tessObj (castPtr ptr) ptr--foreign import CALLCONV safe "gluTessVertex" gluTessVertex ::-   TessellatorObj -> Ptr (Vertex3 GLdouble) -> Ptr (AnnotatedVertex v) -> IO ()------------------------------------------------------------------------------------- chapter 5.3: Callbacks (begin)--type BeginCallback  = PrimitiveMode -> IO ()--type BeginCallback' = GLenum -> IO ()--withBeginCallback :: TessellatorObj -> BeginCallback -> IO a -> IO a-withBeginCallback tessObj beginCallback action =-   bracket (makeBeginCallback (beginCallback . unmarshalPrimitiveMode))-           freeHaskellFunPtr $ \callbackPtr -> do-      setBeginCallback tessObj (marshalTessCallback TessBegin) callbackPtr-      action--foreign import CALLCONV "wrapper" makeBeginCallback ::-   BeginCallback' -> IO (FunPtr BeginCallback')--foreign import CALLCONV unsafe "gluTessCallback" setBeginCallback ::-   TessellatorObj -> GLenum -> FunPtr BeginCallback' -> IO ()------------------------------------------------------------------------------------- chapter 5.3: Callbacks (edgeFlag)--type EdgeFlagCallback  = EdgeFlag -> IO ()--type EdgeFlagCallback' = GLboolean -> IO ()--withEdgeFlagCallback :: TessellatorObj -> EdgeFlagCallback -> IO a -> IO a-withEdgeFlagCallback tessObj edgeFlagCallback action =-   bracket (makeEdgeFlagCallback (edgeFlagCallback . unmarshalEdgeFlag))-           freeHaskellFunPtr $ \callbackPtr -> do-      setEdgeFlagCallback tessObj (marshalTessCallback TessEdgeFlag) callbackPtr-      action--foreign import CALLCONV "wrapper" makeEdgeFlagCallback ::-   EdgeFlagCallback' -> IO (FunPtr EdgeFlagCallback')--foreign import CALLCONV unsafe "gluTessCallback" setEdgeFlagCallback ::-   TessellatorObj -> GLenum -> FunPtr EdgeFlagCallback' -> IO ()------------------------------------------------------------------------------------- chapter 5.3: Callbacks (vertex)--type VertexCallback v = AnnotatedVertex v -> IO ()--type VertexCallback' v = Ptr (AnnotatedVertex v) -> IO ()--withVertexCallback ::-   Storable v => TessellatorObj -> VertexCallback v -> IO a -> IO a-withVertexCallback tessObj vertexCallback action =-   bracket (makeVertexCallback (\p -> peek p >>= vertexCallback))-           freeHaskellFunPtr $ \callbackPtr -> do-      setVertexCallback tessObj (marshalTessCallback TessVertex) callbackPtr-      action--foreign import CALLCONV "wrapper" makeVertexCallback ::-   VertexCallback' v -> IO (FunPtr (VertexCallback' v))--foreign import CALLCONV unsafe "gluTessCallback" setVertexCallback ::-   TessellatorObj -> GLenum -> FunPtr (VertexCallback' v) -> IO ()------------------------------------------------------------------------------------- chapter 5.3: Callbacks (end)--type EndCallback  = IO ()--withEndCallback :: TessellatorObj -> EndCallback -> IO a -> IO a-withEndCallback tessObj endCallback action =-   bracket (makeEndCallback endCallback) freeHaskellFunPtr $ \callbackPtr -> do-      setEndCallback tessObj (marshalTessCallback TessEnd) callbackPtr-      action--foreign import CALLCONV "wrapper" makeEndCallback ::-   EndCallback -> IO (FunPtr EndCallback)--foreign import CALLCONV unsafe "gluTessCallback" setEndCallback ::-   TessellatorObj -> GLenum -> FunPtr EndCallback -> IO ()------------------------------------------------------------------------------------- chapter 5.3: Callbacks (error)--type ErrorCallback = GLenum -> IO ()--withErrorCallback :: TessellatorObj -> ErrorCallback -> IO a -> IO a-withErrorCallback tessObj errorCallback action =-   bracket (makeErrorCallback errorCallback)-           freeHaskellFunPtr $ \callbackPtr -> do-      setErrorCallback tessObj (marshalTessCallback TessError) callbackPtr-      action--foreign import CALLCONV "wrapper" makeErrorCallback ::-   ErrorCallback -> IO (FunPtr ErrorCallback)--foreign import CALLCONV unsafe "gluTessCallback" setErrorCallback ::-   TessellatorObj -> GLenum -> FunPtr ErrorCallback -> IO ()--checkForError :: TessellatorObj -> IO a -> IO a-checkForError tessObj = withErrorCallback tessObj recordErrorCode------------------------------------------------------------------------------------- chapter 5.3: Callbacks (combine)--type CombineCallback v =-      Ptr (Vertex3 GLdouble)-   -> Ptr (Ptr (AnnotatedVertex v))-   -> Ptr GLclampf-   -> Ptr (Ptr (AnnotatedVertex v))-   -> IO ()--withCombineCallback ::-   Storable v => TessellatorObj -> Combiner v -> IO a -> IO a-withCombineCallback tessObj combiner action =-   withPool $ \vertexPool ->-      bracket (makeCombineCallback (combineProperties vertexPool combiner))-              freeHaskellFunPtr $ \callbackPtr -> do-         setCombineCallback tessObj (marshalTessCallback TessCombine) 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 newVertexPtr-   [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)--foreign import CALLCONV "wrapper" makeCombineCallback ::-   CombineCallback v -> IO (FunPtr (CombineCallback v))--foreign import CALLCONV unsafe "gluTessCallback" setCombineCallback ::-   TessellatorObj -> GLenum -> FunPtr (CombineCallback v) -> IO ()------------------------------------------------------------------------------------- chapter 5.4: Control over Tessellation--setTessellatorProperties ::-    TessellatorObj -> TessWinding -> Tolerance -> Normal3 GLdouble -> Bool- -> IO ()-setTessellatorProperties tessObj windingRule tolerance normal boundaryOnly = do-   setWindingRule tessObj windingRule-   setTolerance tessObj tolerance-   setNormal tessObj normal-   setBoundaryOnly tessObj boundaryOnly--setWindingRule :: TessellatorObj -> TessWinding -> IO ()-setWindingRule tessObj =-   tessProperty tessObj TessWindingRule . fromIntegral . marshalTessWinding--setBoundaryOnly :: TessellatorObj -> Bool -> IO ()-setBoundaryOnly tessObj =-   tessProperty tessObj TessBoundaryOnly . marshalGLboolean--setTolerance :: TessellatorObj -> Tolerance -> IO ()-setTolerance tessObj =-   tessProperty tessObj TessTolerance--tessProperty :: TessellatorObj -> TessProperty -> GLdouble -> IO ()-tessProperty tessObj =-   gluTessProperty tessObj . marshalTessProperty--foreign import CALLCONV unsafe "gluTessProperty" gluTessProperty ::-   TessellatorObj -> GLenum -> GLdouble -> IO ()--setNormal :: TessellatorObj -> Normal3 GLdouble -> IO ()-setNormal tessObj (Normal3 x y z) = gluTessNormal tessObj x y z--foreign import CALLCONV unsafe "gluTessNormal" gluTessNormal ::-   TessellatorObj -> GLdouble -> GLdouble -> GLdouble -> IO ()
− OpenGL.buildinfo.in 
@@ -1,8 +0,0 @@--- @configure_input@--- System-dependent values used by Distribution.Simple.defaultUserHooks----buildable: @BUILD_PACKAGE_BOOL@-ghc-options: -DCALLCONV=@CALLCONV@-cc-options: -DCALLCONV=@CALLCONV@ @GLU_CFLAGS@-ld-options: @GLU_LIBS@-frameworks: @GLU_FRAMEWORKS@
OpenGL.cabal view
@@ -1,119 +1,187 @@-name:		OpenGL-version:	2.2.3.1-license:	BSD3-license-file:	LICENSE-maintainer:	Sven Panne <sven.panne@aedion.de>-bug-reports:	mailto:hopengl@haskell.org-homepage:	http://www.haskell.org/HOpenGL/-category:	Graphics-synopsis:	A binding for the OpenGL graphics system+name: OpenGL+version: 3.0.3.0+synopsis: A binding for the OpenGL graphics system description:-	A Haskell binding for the OpenGL graphics system (GL, version-	2.1) 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, please see: <http://www.opengl.org/>.-build-type:     Configure+  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+author: Sven Panne+maintainer: Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com>+category: Graphics+build-type: Simple+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:-	OpenGL.buildinfo.in README aclocal.m4 config.guess config.sub configure-	configure.ac include/HsOpenGL.h.in include/HsOpenGLExt.h-	include/HsOpenGLTypes.h install-sh include/HsOpenGLConfig.h.in-extra-tmp-files:-	config.log config.status autom4te.cache-	OpenGL.buildinfo include/HsOpenGLConfig.h include/HsOpenGL.h-exposed-modules:-	Graphics.Rendering.OpenGL.GL.Antialiasing,-	Graphics.Rendering.OpenGL.GL.BasicTypes,-	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.StateVar,-	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-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.Extensions,-	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.Tensor,-	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-c-sources:	cbits/HsOpenGL.c-include-dirs:	include-includes: HsOpenGL.h-install-includes: HsOpenGL.h-build-depends:	base < 5-extensions:	CPP, ForeignFunctionInterface+   CHANGELOG.md+   README.md++library+  exposed-modules:+    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.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,+    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.git
− README 
@@ -1,4 +0,0 @@-To build this package using Cabal directly from darcs, you must run-"autoreconf" before the usual Cabal build steps (configure/build/install).-autoreconf is included in the GNU autoconf tools.  There is no need to run-the "configure" script: the "setup configure" step will do this for you.
+ 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)
Setup.hs view
@@ -1,6 +1,2 @@-module Main (main) where- import Distribution.Simple--main :: IO ()-main = defaultMainWithHooks autoconfUserHooks+main = defaultMain
− aclocal.m4 
@@ -1,288 +0,0 @@-# Extra autoconf macros for the Glasgow fptools-#-# To be a good autoconf citizen, names of local macros have prefixed with FP_ to-# ensure we don't clash with any pre-supplied autoconf ones.--dnl ** Map an arithmetic C type to a Haskell type.-dnl    Based on autconf's AC_CHECK_SIZEOF.--dnl FPTOOLS_CHECK_HTYPE(TYPE [, DEFAULT_VALUE, [, VALUE-FOR-CROSS-COMPILATION])-AC_DEFUN([FPTOOLS_CHECK_HTYPE],-[changequote(<<, >>)dnl-dnl The name to #define.-define(<<AC_TYPE_NAME>>, translit(htype_$1, [a-z *], [A-Z_P]))dnl-dnl The cache variable name.-define(<<AC_CV_NAME>>, translit(fptools_cv_htype_$1, [ *], [_p]))dnl-define(<<AC_CV_NAME_supported>>, translit(fptools_cv_htype_sup_$1, [ *], [_p]))dnl-changequote([, ])dnl-AC_MSG_CHECKING(Haskell type for $1)-AC_CACHE_VAL(AC_CV_NAME,-[AC_CV_NAME_supported=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef $1 testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}]])],[AC_CV_NAME=`cat conftestval`],-[ifelse([$2], , [AC_CV_NAME=NotReallyAType; AC_CV_NAME_supported=no], [AC_CV_NAME=$2])],-[ifelse([$3], , [AC_CV_NAME=NotReallyATypeCross; AC_CV_NAME_supported=no], [AC_CV_NAME=$3])])-CPPFLAGS="$fp_check_htype_save_cppflags"]) dnl-if test "$AC_CV_NAME_supported" = yes; then-  AC_MSG_RESULT($AC_CV_NAME)-  AC_DEFINE_UNQUOTED(AC_TYPE_NAME, $AC_CV_NAME, [Define to Haskell type for $1])-else-  AC_MSG_RESULT([not supported])-fi-undefine([AC_TYPE_NAME])dnl-undefine([AC_CV_NAME])dnl-undefine([AC_CV_NAME_supported])dnl-])---# FP_ARG_OPENGL-# --------------AC_DEFUN([FP_ARG_OPENGL],-[AC_ARG_ENABLE([opengl],-  [AC_HELP_STRING([--enable-opengl],-    [build a Haskell binding for OpenGL (GL/GLU). On Mac OS X, use-     --enable-opengl=x11 to use X11 instead of the "native" libraries.-     (default=autodetect)])],-  [enable_opengl=$enableval],-  [enable_opengl=yes])-])# FP_ARG_OPENGL---# FP_CHECK_QUARTZ_OPENGL-# -----------------------AC_DEFUN([FP_CHECK_QUARTZ_OPENGL],-[AC_REQUIRE([FP_ARG_OPENGL])-AC_REQUIRE([AC_CANONICAL_TARGET])--use_quartz_opengl=no-if test x"$enable_opengl" = xyes; then-  case $target_os in-  darwin*)-    AC_DEFINE([USE_QUARTZ_OPENGL], [1],-              [Define to 1 if native OpenGL should be used on Mac OS X])-    use_quartz_opengl=yes-    ;;-  esac-fi--GLU_FRAMEWORKS=-GLUT_FRAMEWORKS=-if test x"$use_quartz_opengl" = xyes; then-  GLU_FRAMEWORKS=OpenGL-  GLUT_FRAMEWORKS=GLUT-fi-AC_SUBST([GLU_FRAMEWORKS])-AC_SUBST([GLUT_FRAMEWORKS])-])# FP_CHECK_QUARTZ_OPENGL---# FP_CHECK_WIN32-# ---------------# If Windows is the target platform (e.g. MinGW/MSYS or Cygwin with-# -mno-cygwin), the variable "fp_is_win32" is set to "yes", otherwise (e.g. *nix-# systems or plain Cygwin) it is set to "no".-AC_DEFUN([FP_CHECK_WIN32],-[AC_CACHE_CHECK([for Windows environment], [fp_cv_is_win32],-  [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [-#if !_WIN32-   syntax error;-#endif-])], [fp_cv_is_win32=yes], [fp_cv_is_win32=no])])-fp_is_win32="$fp_cv_is_win32"[]dnl-])# FP_CHECK_WIN32---# FP_PATH_XTRA-# -------------# Same as AC_PATH_XTRA, but works even for broken Cygwins which try to include-# the non-existant <gl/mesa_wgl.h> header when -mno-cygwin is used.-AC_DEFUN([FP_PATH_XTRA],-[AC_REQUIRE([FP_CHECK_WIN32])-if test x"$fp_is_win32" = xyes; then-  no_x=yes-else-  AC_PATH_XTRA-fi-])# FP_PATH_XTRA---# FP_CHECK_GL_HELPER(LIBNAME, LIBS, INCLUDES, FUNCTION-BODY)-# -----------------------------------------------------------# Try each library in LIBS to successfully link INCLUDES plus FUNCTION-BODY,-# setting LIBNAME_CFLAGS and LIBNAME_LIBS to the corresponding values. Sets-# no_LIBNAME to "yes" if no suitable library was found. (LIBNAME_CFLAGS0-# contains the value of LIBNAME_CFLAGS without CPPFLAGS, and LIBNAME_LIBS0-# contains the value of LIBNAME_LIBS without LDFLAGS, but these are only-# used internally.)-AC_DEFUN([FP_CHECK_GL_HELPER],-[AC_CACHE_CHECK([for $1 library], [fp_cv_check_$1_lib],-  [fp_cv_check_$1_lib="no"-  fp_save_CPPFLAGS="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS ${$1_CFLAGS}"-  fp_save_LIBS="$LIBS"-  for fp_try_lib in $2; do-    # transform "-lfoo" to "foo.lib" when using cl-    if test x"$CC" = xcl; then-      fp_try_lib=`echo $fp_try_lib | sed -e 's/^-l//' -e 's/$/.lib/'`-    fi-    LIBS="$fp_try_lib ${$1_LIBS} $fp_save_LIBS"-    AC_LINK_IFELSE([AC_LANG_PROGRAM([$3], [$4])], [fp_cv_check_$1_lib="$fp_try_lib ${$1_LIBS}"; break])-  done-  LIBS="$fp_save_LIBS"-  CPPFLAGS="$fp_save_CPPFLAGS"])--  if test x"$fp_cv_check_$1_lib" = xno; then-    no_$1=yes-    $1_CFLAGS=-    $1_LIBS=-  else-    $1_CFLAGS0="${$1_CFLAGS}"-    $1_CFLAGS="$CPPFLAGS ${$1_CFLAGS0}"-    $1_LIBS0="$fp_cv_check_$1_lib"-    $1_LIBS="$LDFLAGS ${$1_LIBS0}"-  fi-])# FP_CHECK_GL_HELPER---# FP_CHECK_GL-# ------------AC_DEFUN([FP_CHECK_GL],-[AC_REQUIRE([FP_PATH_XTRA])-AC_REQUIRE([FP_CHECK_QUARTZ_OPENGL])-AC_REQUIRE([FP_CHECK_WIN32])--if test x"$use_quartz_opengl" = xno; then-  AC_CHECK_FUNC(atan,[fp_libm_not_needed=yes],[fp_libm_not_needed=dunno])-  if test x"$fp_libm_not_needed" = xdunno; then-     AC_CHECK_LIB([m], [atan], [GL_LIBS="-lm $GL_LIBS"])-  fi--  if test x"$no_x" != xyes; then-    test -n "$x_includes" && GL_CFLAGS="-I$x_includes $GL_CFLAGS"-    test -n "$x_libraries" && GL_LIBS="-L$x_libraries -lX11 $GL_LIBS"-  fi--  FP_CHECK_GL_HELPER([GL], [-lGL -lopengl32], [@%:@include <GL/gl.h>], [glEnd()])--  if test x"$fp_is_win32" = xyes; then-    # Ugly: To get wglGetProcAddress on Windows, we have to link with-    # opengl32.dll, too, even when we are using Cygwin with X11.-    case "$GL_LIBS" in-      *-lopengl32*|*opengl32.lib*) ;;-      *) fp_save_LIBS="$LIBS"-         LIBS="$LIBS -lopengl32"-         AC_LINK_IFELSE([AC_LANG_PROGRAM([[@%:@include <GL/gl.h>]], [[glEnd()]])],-           [GL_LIBS="$GL_LIBS -lopengl32"; GL_LIBS0="$GL_LIBS0 -lopengl32"])-         LIBS="$fp_save_LIBS"-         ;;-    esac-  fi-fi-AC_SUBST([GL_CFLAGS])-AC_SUBST([GL_LIBS])-])# FP_CHECK_GL---# FP_CHECK_GLU-# -------------AC_DEFUN([FP_CHECK_GLU],-[AC_REQUIRE([FP_CHECK_GL])dnl-GLU_CFLAGS="$GL_CFLAGS0"-GLU_LIBS="$GL_LIBS0"--if test x"$use_quartz_opengl" = xno; then-  FP_CHECK_GL_HELPER([GLU], [-lglu32 -lGLU], [@%:@include <GL/glu.h>], [gluNewQuadric()])-fi--AC_SUBST([GLU_CFLAGS])-AC_SUBST([GLU_LIBS])-])# FP_CHECK_GLU---# FP_ARG_COMPILER-# --------------AC_DEFUN([FP_ARG_COMPILER],-[AC_ARG_WITH([compiler],-  [AC_HELP_STRING([--with-compiler@<:@=HC@:>@],-    [use the given Haskell compiler (default=ghc)])],-  [with_compiler=$withval],-  [with_compiler=ghc])-])# FP_ARG_COMPILER
− cbits/HsOpenGL.c 
@@ -1,125 +0,0 @@-/* ------------------------------------------------------------------------------ *- * Module      :  C support for Graphics.Rendering.OpenGL.GL.Extensions- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/GLUT/LICENSE)- * - * Maintainer  :  sven.panne@aedion.de- * Stability   :  experimental- * Portability :  portable- *- * -------------------------------------------------------------------------- */--#include "HsOpenGL.h"-#include <string.h>--#if defined(_WIN32)-#define hs_OpenGL_gpa(x) wglGetProcAddress((LPCSTR)(x))-#elif defined(USE_QUARTZ_OPENGL)-#include <mach-o/dyld.h>-#include <stdlib.h>-#include <stdio.h>--static void*-hs_OpenGL_gpa(const char *name)-{-  NSSymbol symbol;--  /* Prepend a '_' for the Unix C symbol mangling convention */-  char* symbolName = (char*)malloc(strlen(name) + 2);-  if (!symbolName) {-    fprintf(stderr, "Failed to allocate memory for NSGLGetProcAddress\n");-    return NULL;-  }-  symbolName[0] = '_';-  strcpy(symbolName + 1, name);--  if (!NSIsSymbolNameDefined(symbolName)) {-    free(symbolName);-    return NULL;-  }--  symbol = NSLookupAndBindSymbol(symbolName);-  free(symbolName);-  if (!symbol) {-    return NULL;-  }--  return NSAddressOfSymbol(symbol);-}--/* ToDo: This should really be based on a feature test. */-#elif defined(__sgi) || defined (__sun)-#include <dlfcn.h>--static const char* gpaNames[] = {-  "glXGetProcAddress", "glXGetProcAddressARB", "glXGetProcAddressEXT",-  "_glXGetProcAddress", "_glXGetProcAddressARB", "_glXGetProcAddressEXT"-};--static void*-hs_OpenGL_gpa(const char *name)-{-  static int firstTime = 1;-  static void *handle = NULL;-  static void *gpa = NULL;--  if (firstTime) {-    firstTime = 0;--    /* Get a handle for our executable. */-    handle = dlopen(NULL, RTLD_LAZY);-    /* If fail this early, there's not much we can do about it. */-    if (!handle) {-      return NULL;-    }--    {-      /* Let's see if our platform supports a glXGetProcAddress() variant. */-      int numNames = (int)(sizeof(gpaNames) / sizeof(gpaNames[0]));-      int i;-      for (i = 0;   (!gpa) && (i < numNames);   ++i) {-        gpa = dlsym(handle, gpaNames[i]);-      }-    }-  }--  if (gpa) {-    /* Fine, we seem to have some kind of glXGetProcAddress(), so use it. */-    return ((void *(*)(const GLubyte *))gpa)(name);-  } else if (handle) {-    /* Fallback to dlsym() if we have no glXGetProcAddress(), although we then-       ignore the fact that OpenGL entry points could be context dependent. */-    return dlsym(handle, name);-  } else {-    return NULL;-  }-}--#else-#define hs_OpenGL_gpa(x) glXGetProcAddressARB((const GLubyte*)(x))-#endif---/* procName is really a const char*, but currently we can't specify this in-   Haskell's FFI and consequently get a warning from the C compiler. */-void*-hs_OpenGL_getProcAddress(char *procName)-{-  void* addr = hs_OpenGL_gpa(procName);-  if (addr) {-    return addr;-  }-  /* There is no way to get GLU extensions at runtime so we fake this, being-     careful about GLU headers on WinDoze, which have a bad habit of lying-     about their actual version. */-#if defined(GLU_VERSION_1_3) && !defined(_WIN32)-  if (strcmp(procName, "gluUnProject4") == 0) {-    return gluUnProject4;-  }-  if (strcmp(procName, "gluBuild3DMipmapLevels") == 0) {-    return gluBuild3DMipmapLevels;-  }-#endif-  return NULL;-}
− config.guess 
@@ -1,1497 +0,0 @@-#! /bin/sh-# Attempt to guess a canonical system name.-#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,-#   2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.--timestamp='2006-02-23'--# This file is free software; you can redistribute it and/or modify it-# under the terms of the GNU General Public License as published by-# the Free Software Foundation; either version 2 of the License, or-# (at your option) any later version.-#-# This program is distributed in the hope that it will be useful, but-# WITHOUT ANY WARRANTY; without even the implied warranty of-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU-# General Public License for more details.-#-# You should have received a copy of the GNU General Public License-# along with this program; if not, write to the Free Software-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA-# 02110-1301, USA.-#-# As a special exception to the GNU General Public License, if you-# distribute this file as part of a program that contains a-# configuration script generated by Autoconf, you may include it under-# the same distribution terms that you use for the rest of that program.---# Originally written by Per Bothner <per@bothner.com>.-# Please send patches to <config-patches@gnu.org>.  Submit a context-# diff and a properly formatted ChangeLog entry.-#-# This script attempts to guess a canonical system name similar to-# config.sub.  If it succeeds, it prints the system name on stdout, and-# exits with 0.  Otherwise, it exits with 1.-#-# The plan is that this can be called by configure scripts if you-# don't specify an explicit build system type.--me=`echo "$0" | sed -e 's,.*/,,'`--usage="\-Usage: $0 [OPTION]--Output the configuration name of the system \`$me' is run on.--Operation modes:-  -h, --help         print this help, then exit-  -t, --time-stamp   print date of last modification, then exit-  -v, --version      print version number, then exit--Report bugs and patches to <config-patches@gnu.org>."--version="\-GNU config.guess ($timestamp)--Originally written by Per Bothner.-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005-Free Software Foundation, Inc.--This is free software; see the source for copying conditions.  There is NO-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."--help="-Try \`$me --help' for more information."--# Parse command line-while test $# -gt 0 ; do-  case $1 in-    --time-stamp | --time* | -t )-       echo "$timestamp" ; exit ;;-    --version | -v )-       echo "$version" ; exit ;;-    --help | --h* | -h )-       echo "$usage"; exit ;;-    -- )     # Stop option processing-       shift; break ;;-    - )	# Use stdin as input.-       break ;;-    -* )-       echo "$me: invalid option $1$help" >&2-       exit 1 ;;-    * )-       break ;;-  esac-done--if test $# != 0; then-  echo "$me: too many arguments$help" >&2-  exit 1-fi--trap 'exit 1' 1 2 15--# CC_FOR_BUILD -- compiler used by this script. Note that the use of a-# compiler to aid in system detection is discouraged as it requires-# temporary files to be created and, as you can see below, it is a-# headache to deal with in a portable fashion.--# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still-# use `HOST_CC' if defined, but it is deprecated.--# Portable tmp directory creation inspired by the Autoconf team.--set_cc_for_build='-trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;-trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;-: ${TMPDIR=/tmp} ;- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;-dummy=$tmp/dummy ;-tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;-case $CC_FOR_BUILD,$HOST_CC,$CC in- ,,)    echo "int x;" > $dummy.c ;-	for c in cc gcc c89 c99 ; do-	  if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then-	     CC_FOR_BUILD="$c"; break ;-	  fi ;-	done ;-	if test x"$CC_FOR_BUILD" = x ; then-	  CC_FOR_BUILD=no_compiler_found ;-	fi-	;;- ,,*)   CC_FOR_BUILD=$CC ;;- ,*,*)  CC_FOR_BUILD=$HOST_CC ;;-esac ; set_cc_for_build= ;'--# This is needed to find uname on a Pyramid OSx when run in the BSD universe.-# (ghazi@noc.rutgers.edu 1994-08-24)-if (test -f /.attbin/uname) >/dev/null 2>&1 ; then-	PATH=$PATH:/.attbin ; export PATH-fi--UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown-UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown-UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown-UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown--# Note: order is significant - the case branches are not exclusive.--case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in-    *:NetBSD:*:*)-	# NetBSD (nbsd) targets should (where applicable) match one or-	# more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,-	# *-*-netbsdecoff* and *-*-netbsd*.  For targets that recently-	# switched to ELF, *-*-netbsd* would select the old-	# object file format.  This provides both forward-	# compatibility and a consistent mechanism for selecting the-	# object file format.-	#-	# Note: NetBSD doesn't particularly care about the vendor-	# portion of the name.  We always set it to "unknown".-	sysctl="sysctl -n hw.machine_arch"-	UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \-	    /usr/sbin/$sysctl 2>/dev/null || echo unknown)`-	case "${UNAME_MACHINE_ARCH}" in-	    armeb) machine=armeb-unknown ;;-	    arm*) machine=arm-unknown ;;-	    sh3el) machine=shl-unknown ;;-	    sh3eb) machine=sh-unknown ;;-	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;-	esac-	# The Operating System including object format, if it has switched-	# to ELF recently, or will in the future.-	case "${UNAME_MACHINE_ARCH}" in-	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)-		eval $set_cc_for_build-		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \-			| grep __ELF__ >/dev/null-		then-		    # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).-		    # Return netbsd for either.  FIX?-		    os=netbsd-		else-		    os=netbsdelf-		fi-		;;-	    *)-	        os=netbsd-		;;-	esac-	# The OS release-	# Debian GNU/NetBSD machines have a different userland, and-	# thus, need a distinct triplet. However, they do not need-	# kernel version information, so it can be replaced with a-	# suitable tag, in the style of linux-gnu.-	case "${UNAME_VERSION}" in-	    Debian*)-		release='-gnu'-		;;-	    *)-		release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`-		;;-	esac-	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:-	# contains redundant information, the shorter form:-	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.-	echo "${machine}-${os}${release}"-	exit ;;-    *:OpenBSD:*:*)-	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`-	echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}-	exit ;;-    *:ekkoBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}-	exit ;;-    *:SolidBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}-	exit ;;-    macppc:MirBSD:*:*)-	echo powerppc-unknown-mirbsd${UNAME_RELEASE}-	exit ;;-    *:MirBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}-	exit ;;-    alpha:OSF1:*:*)-	case $UNAME_RELEASE in-	*4.0)-		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`-		;;-	*5.*)-	        UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`-		;;-	esac-	# According to Compaq, /usr/sbin/psrinfo has been available on-	# OSF/1 and Tru64 systems produced since 1995.  I hope that-	# covers most systems running today.  This code pipes the CPU-	# types through head -n 1, so we only detect the type of CPU 0.-	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^  The alpha \(.*\) processor.*$/\1/p' | head -n 1`-	case "$ALPHA_CPU_TYPE" in-	    "EV4 (21064)")-		UNAME_MACHINE="alpha" ;;-	    "EV4.5 (21064)")-		UNAME_MACHINE="alpha" ;;-	    "LCA4 (21066/21068)")-		UNAME_MACHINE="alpha" ;;-	    "EV5 (21164)")-		UNAME_MACHINE="alphaev5" ;;-	    "EV5.6 (21164A)")-		UNAME_MACHINE="alphaev56" ;;-	    "EV5.6 (21164PC)")-		UNAME_MACHINE="alphapca56" ;;-	    "EV5.7 (21164PC)")-		UNAME_MACHINE="alphapca57" ;;-	    "EV6 (21264)")-		UNAME_MACHINE="alphaev6" ;;-	    "EV6.7 (21264A)")-		UNAME_MACHINE="alphaev67" ;;-	    "EV6.8CB (21264C)")-		UNAME_MACHINE="alphaev68" ;;-	    "EV6.8AL (21264B)")-		UNAME_MACHINE="alphaev68" ;;-	    "EV6.8CX (21264D)")-		UNAME_MACHINE="alphaev68" ;;-	    "EV6.9A (21264/EV69A)")-		UNAME_MACHINE="alphaev69" ;;-	    "EV7 (21364)")-		UNAME_MACHINE="alphaev7" ;;-	    "EV7.9 (21364A)")-		UNAME_MACHINE="alphaev79" ;;-	esac-	# A Pn.n version is a patched version.-	# A Vn.n version is a released version.-	# A Tn.n version is a released field test version.-	# A Xn.n version is an unreleased experimental baselevel.-	# 1.2 uses "1.2" for uname -r.-	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`-	exit ;;-    Alpha\ *:Windows_NT*:*)-	# How do we know it's Interix rather than the generic POSIX subsystem?-	# Should we change UNAME_MACHINE based on the output of uname instead-	# of the specific Alpha model?-	echo alpha-pc-interix-	exit ;;-    21064:Windows_NT:50:3)-	echo alpha-dec-winnt3.5-	exit ;;-    Amiga*:UNIX_System_V:4.0:*)-	echo m68k-unknown-sysv4-	exit ;;-    *:[Aa]miga[Oo][Ss]:*:*)-	echo ${UNAME_MACHINE}-unknown-amigaos-	exit ;;-    *:[Mm]orph[Oo][Ss]:*:*)-	echo ${UNAME_MACHINE}-unknown-morphos-	exit ;;-    *:OS/390:*:*)-	echo i370-ibm-openedition-	exit ;;-    *:z/VM:*:*)-	echo s390-ibm-zvmoe-	exit ;;-    *:OS400:*:*)-        echo powerpc-ibm-os400-	exit ;;-    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)-	echo arm-acorn-riscix${UNAME_RELEASE}-	exit ;;-    arm:riscos:*:*|arm:RISCOS:*:*)-	echo arm-unknown-riscos-	exit ;;-    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)-	echo hppa1.1-hitachi-hiuxmpp-	exit ;;-    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)-	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.-	if test "`(/bin/universe) 2>/dev/null`" = att ; then-		echo pyramid-pyramid-sysv3-	else-		echo pyramid-pyramid-bsd-	fi-	exit ;;-    NILE*:*:*:dcosx)-	echo pyramid-pyramid-svr4-	exit ;;-    DRS?6000:unix:4.0:6*)-	echo sparc-icl-nx6-	exit ;;-    DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)-	case `/usr/bin/uname -p` in-	    sparc) echo sparc-icl-nx7; exit ;;-	esac ;;-    sun4H:SunOS:5.*:*)-	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)-	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    i86pc:SunOS:5.*:*)-	echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    sun4*:SunOS:6*:*)-	# According to config.sub, this is the proper way to canonicalize-	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but-	# it's likely to be more like Solaris than SunOS4.-	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    sun4*:SunOS:*:*)-	case "`/usr/bin/arch -k`" in-	    Series*|S4*)-		UNAME_RELEASE=`uname -v`-		;;-	esac-	# Japanese Language versions have a version number like `4.1.3-JL'.-	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`-	exit ;;-    sun3*:SunOS:*:*)-	echo m68k-sun-sunos${UNAME_RELEASE}-	exit ;;-    sun*:*:4.2BSD:*)-	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`-	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3-	case "`/bin/arch`" in-	    sun3)-		echo m68k-sun-sunos${UNAME_RELEASE}-		;;-	    sun4)-		echo sparc-sun-sunos${UNAME_RELEASE}-		;;-	esac-	exit ;;-    aushp:SunOS:*:*)-	echo sparc-auspex-sunos${UNAME_RELEASE}-	exit ;;-    # The situation for MiNT is a little confusing.  The machine name-    # can be virtually everything (everything which is not-    # "atarist" or "atariste" at least should have a processor-    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"-    # to the lowercase version "mint" (or "freemint").  Finally-    # the system name "TOS" denotes a system which is actually not-    # MiNT.  But MiNT is downward compatible to TOS, so this should-    # be no problem.-    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)-        echo m68k-atari-mint${UNAME_RELEASE}-	exit ;;-    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)-	echo m68k-atari-mint${UNAME_RELEASE}-        exit ;;-    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)-        echo m68k-atari-mint${UNAME_RELEASE}-	exit ;;-    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)-        echo m68k-milan-mint${UNAME_RELEASE}-        exit ;;-    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)-        echo m68k-hades-mint${UNAME_RELEASE}-        exit ;;-    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)-        echo m68k-unknown-mint${UNAME_RELEASE}-        exit ;;-    m68k:machten:*:*)-	echo m68k-apple-machten${UNAME_RELEASE}-	exit ;;-    powerpc:machten:*:*)-	echo powerpc-apple-machten${UNAME_RELEASE}-	exit ;;-    RISC*:Mach:*:*)-	echo mips-dec-mach_bsd4.3-	exit ;;-    RISC*:ULTRIX:*:*)-	echo mips-dec-ultrix${UNAME_RELEASE}-	exit ;;-    VAX*:ULTRIX*:*:*)-	echo vax-dec-ultrix${UNAME_RELEASE}-	exit ;;-    2020:CLIX:*:* | 2430:CLIX:*:*)-	echo clipper-intergraph-clix${UNAME_RELEASE}-	exit ;;-    mips:*:*:UMIPS | mips:*:*:RISCos)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-#ifdef __cplusplus-#include <stdio.h>  /* for printf() prototype */-	int main (int argc, char *argv[]) {-#else-	int main (argc, argv) int argc; char *argv[]; {-#endif-	#if defined (host_mips) && defined (MIPSEB)-	#if defined (SYSTYPE_SYSV)-	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);-	#endif-	#if defined (SYSTYPE_SVR4)-	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);-	#endif-	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)-	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);-	#endif-	#endif-	  exit (-1);-	}-EOF-	$CC_FOR_BUILD -o $dummy $dummy.c &&-	  dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&-	  SYSTEM_NAME=`$dummy $dummyarg` &&-	    { echo "$SYSTEM_NAME"; exit; }-	echo mips-mips-riscos${UNAME_RELEASE}-	exit ;;-    Motorola:PowerMAX_OS:*:*)-	echo powerpc-motorola-powermax-	exit ;;-    Motorola:*:4.3:PL8-*)-	echo powerpc-harris-powermax-	exit ;;-    Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)-	echo powerpc-harris-powermax-	exit ;;-    Night_Hawk:Power_UNIX:*:*)-	echo powerpc-harris-powerunix-	exit ;;-    m88k:CX/UX:7*:*)-	echo m88k-harris-cxux7-	exit ;;-    m88k:*:4*:R4*)-	echo m88k-motorola-sysv4-	exit ;;-    m88k:*:3*:R3*)-	echo m88k-motorola-sysv3-	exit ;;-    AViiON:dgux:*:*)-        # DG/UX returns AViiON for all architectures-        UNAME_PROCESSOR=`/usr/bin/uname -p`-	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]-	then-	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \-	       [ ${TARGET_BINARY_INTERFACE}x = x ]-	    then-		echo m88k-dg-dgux${UNAME_RELEASE}-	    else-		echo m88k-dg-dguxbcs${UNAME_RELEASE}-	    fi-	else-	    echo i586-dg-dgux${UNAME_RELEASE}-	fi- 	exit ;;-    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)-	echo m88k-dolphin-sysv3-	exit ;;-    M88*:*:R3*:*)-	# Delta 88k system running SVR3-	echo m88k-motorola-sysv3-	exit ;;-    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)-	echo m88k-tektronix-sysv3-	exit ;;-    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)-	echo m68k-tektronix-bsd-	exit ;;-    *:IRIX*:*:*)-	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`-	exit ;;-    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.-	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id-	exit ;;               # Note that: echo "'`uname -s`'" gives 'AIX '-    i*86:AIX:*:*)-	echo i386-ibm-aix-	exit ;;-    ia64:AIX:*:*)-	if [ -x /usr/bin/oslevel ] ; then-		IBM_REV=`/usr/bin/oslevel`-	else-		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}-	fi-	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}-	exit ;;-    *:AIX:2:3)-	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then-		eval $set_cc_for_build-		sed 's/^		//' << EOF >$dummy.c-		#include <sys/systemcfg.h>--		main()-			{-			if (!__power_pc())-				exit(1);-			puts("powerpc-ibm-aix3.2.5");-			exit(0);-			}-EOF-		if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`-		then-			echo "$SYSTEM_NAME"-		else-			echo rs6000-ibm-aix3.2.5-		fi-	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then-		echo rs6000-ibm-aix3.2.4-	else-		echo rs6000-ibm-aix3.2-	fi-	exit ;;-    *:AIX:*:[45])-	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`-	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then-		IBM_ARCH=rs6000-	else-		IBM_ARCH=powerpc-	fi-	if [ -x /usr/bin/oslevel ] ; then-		IBM_REV=`/usr/bin/oslevel`-	else-		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}-	fi-	echo ${IBM_ARCH}-ibm-aix${IBM_REV}-	exit ;;-    *:AIX:*:*)-	echo rs6000-ibm-aix-	exit ;;-    ibmrt:4.4BSD:*|romp-ibm:BSD:*)-	echo romp-ibm-bsd4.4-	exit ;;-    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and-	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to-	exit ;;                             # report: romp-ibm BSD 4.3-    *:BOSX:*:*)-	echo rs6000-bull-bosx-	exit ;;-    DPX/2?00:B.O.S.:*:*)-	echo m68k-bull-sysv3-	exit ;;-    9000/[34]??:4.3bsd:1.*:*)-	echo m68k-hp-bsd-	exit ;;-    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)-	echo m68k-hp-bsd4.4-	exit ;;-    9000/[34678]??:HP-UX:*:*)-	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`-	case "${UNAME_MACHINE}" in-	    9000/31? )            HP_ARCH=m68000 ;;-	    9000/[34]?? )         HP_ARCH=m68k ;;-	    9000/[678][0-9][0-9])-		if [ -x /usr/bin/getconf ]; then-		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`-                    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`-                    case "${sc_cpu_version}" in-                      523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0-                      528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1-                      532)                      # CPU_PA_RISC2_0-                        case "${sc_kernel_bits}" in-                          32) HP_ARCH="hppa2.0n" ;;-                          64) HP_ARCH="hppa2.0w" ;;-			  '') HP_ARCH="hppa2.0" ;;   # HP-UX 10.20-                        esac ;;-                    esac-		fi-		if [ "${HP_ARCH}" = "" ]; then-		    eval $set_cc_for_build-		    sed 's/^              //' << EOF >$dummy.c--              #define _HPUX_SOURCE-              #include <stdlib.h>-              #include <unistd.h>--              int main ()-              {-              #if defined(_SC_KERNEL_BITS)-                  long bits = sysconf(_SC_KERNEL_BITS);-              #endif-                  long cpu  = sysconf (_SC_CPU_VERSION);--                  switch (cpu)-              	{-              	case CPU_PA_RISC1_0: puts ("hppa1.0"); break;-              	case CPU_PA_RISC1_1: puts ("hppa1.1"); break;-              	case CPU_PA_RISC2_0:-              #if defined(_SC_KERNEL_BITS)-              	    switch (bits)-              		{-              		case 64: puts ("hppa2.0w"); break;-              		case 32: puts ("hppa2.0n"); break;-              		default: puts ("hppa2.0"); break;-              		} break;-              #else  /* !defined(_SC_KERNEL_BITS) */-              	    puts ("hppa2.0"); break;-              #endif-              	default: puts ("hppa1.0"); break;-              	}-                  exit (0);-              }-EOF-		    (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`-		    test -z "$HP_ARCH" && HP_ARCH=hppa-		fi ;;-	esac-	if [ ${HP_ARCH} = "hppa2.0w" ]-	then-	    eval $set_cc_for_build--	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating-	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler-	    # generating 64-bit code.  GNU and HP use different nomenclature:-	    #-	    # $ CC_FOR_BUILD=cc ./config.guess-	    # => hppa2.0w-hp-hpux11.23-	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess-	    # => hppa64-hp-hpux11.23--	    if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |-		grep __LP64__ >/dev/null-	    then-		HP_ARCH="hppa2.0w"-	    else-		HP_ARCH="hppa64"-	    fi-	fi-	echo ${HP_ARCH}-hp-hpux${HPUX_REV}-	exit ;;-    ia64:HP-UX:*:*)-	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`-	echo ia64-hp-hpux${HPUX_REV}-	exit ;;-    3050*:HI-UX:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#include <unistd.h>-	int-	main ()-	{-	  long cpu = sysconf (_SC_CPU_VERSION);-	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns-	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct-	     results, however.  */-	  if (CPU_IS_PA_RISC (cpu))-	    {-	      switch (cpu)-		{-		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;-		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;-		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;-		  default: puts ("hppa-hitachi-hiuxwe2"); break;-		}-	    }-	  else if (CPU_IS_HP_MC68K (cpu))-	    puts ("m68k-hitachi-hiuxwe2");-	  else puts ("unknown-hitachi-hiuxwe2");-	  exit (0);-	}-EOF-	$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&-		{ echo "$SYSTEM_NAME"; exit; }-	echo unknown-hitachi-hiuxwe2-	exit ;;-    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )-	echo hppa1.1-hp-bsd-	exit ;;-    9000/8??:4.3bsd:*:*)-	echo hppa1.0-hp-bsd-	exit ;;-    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)-	echo hppa1.0-hp-mpeix-	exit ;;-    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )-	echo hppa1.1-hp-osf-	exit ;;-    hp8??:OSF1:*:*)-	echo hppa1.0-hp-osf-	exit ;;-    i*86:OSF1:*:*)-	if [ -x /usr/sbin/sysversion ] ; then-	    echo ${UNAME_MACHINE}-unknown-osf1mk-	else-	    echo ${UNAME_MACHINE}-unknown-osf1-	fi-	exit ;;-    parisc*:Lites*:*:*)-	echo hppa1.1-hp-lites-	exit ;;-    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)-	echo c1-convex-bsd-        exit ;;-    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)-	if getsysinfo -f scalar_acc-	then echo c32-convex-bsd-	else echo c2-convex-bsd-	fi-        exit ;;-    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)-	echo c34-convex-bsd-        exit ;;-    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)-	echo c38-convex-bsd-        exit ;;-    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)-	echo c4-convex-bsd-        exit ;;-    CRAY*Y-MP:*:*:*)-	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*[A-Z]90:*:*:*)-	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \-	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \-	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \-	      -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*TS:*:*:*)-	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*T3E:*:*:*)-	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*SV1:*:*:*)-	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    *:UNICOS/mp:*:*)-	echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)-	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`-        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`-        FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`-        echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"-        exit ;;-    5000:UNIX_System_V:4.*:*)-        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`-        FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`-        echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"-	exit ;;-    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)-	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}-	exit ;;-    sparc*:BSD/OS:*:*)-	echo sparc-unknown-bsdi${UNAME_RELEASE}-	exit ;;-    *:BSD/OS:*:*)-	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}-	exit ;;-    *:FreeBSD:*:*)-	case ${UNAME_MACHINE} in-	    pc98)-		echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;-	    *)-		echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;-	esac-	exit ;;-    i*:CYGWIN*:*)-	echo ${UNAME_MACHINE}-pc-cygwin-	exit ;;-    i*:MINGW*:*)-	echo ${UNAME_MACHINE}-pc-mingw32-	exit ;;-    i*:MSYS_NT-*:*:*)-	echo ${UNAME_MACHINE}-pc-mingw32-	exit ;;-    i*:windows32*:*)-    	# uname -m includes "-pc" on this system.-    	echo ${UNAME_MACHINE}-mingw32-	exit ;;-    i*:PW*:*)-	echo ${UNAME_MACHINE}-pc-pw32-	exit ;;-    x86:Interix*:[345]*)-	echo i586-pc-interix${UNAME_RELEASE}-	exit ;;-    EM64T:Interix*:[345]*)-	echo x86_64-unknown-interix${UNAME_RELEASE}-	exit ;;-    [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)-	echo i${UNAME_MACHINE}-pc-mks-	exit ;;-    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)-	# How do we know it's Interix rather than the generic POSIX subsystem?-	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we-	# UNAME_MACHINE based on the output of uname instead of i386?-	echo i586-pc-interix-	exit ;;-    i*:UWIN*:*)-	echo ${UNAME_MACHINE}-pc-uwin-	exit ;;-    amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)-	echo x86_64-unknown-cygwin-	exit ;;-    p*:CYGWIN*:*)-	echo powerpcle-unknown-cygwin-	exit ;;-    prep*:SunOS:5.*:*)-	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    *:GNU:*:*)-	# the GNU system-	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`-	exit ;;-    *:GNU/*:*:*)-	# other systems with GNU libc and userland-	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu-	exit ;;-    i*86:Minix:*:*)-	echo ${UNAME_MACHINE}-pc-minix-	exit ;;-    arm*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    cris:Linux:*:*)-	echo cris-axis-linux-gnu-	exit ;;-    crisv32:Linux:*:*)-	echo crisv32-axis-linux-gnu-	exit ;;-    frv:Linux:*:*)-    	echo frv-unknown-linux-gnu-	exit ;;-    ia64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    m32r*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    m68*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    mips:Linux:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#undef CPU-	#undef mips-	#undef mipsel-	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)-	CPU=mipsel-	#else-	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)-	CPU=mips-	#else-	CPU=-	#endif-	#endif-EOF-	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '-	    /^CPU/{-		s: ::g-		p-	    }'`"-	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }-	;;-    mips64:Linux:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#undef CPU-	#undef mips64-	#undef mips64el-	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)-	CPU=mips64el-	#else-	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)-	CPU=mips64-	#else-	CPU=-	#endif-	#endif-EOF-	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '-	    /^CPU/{-		s: ::g-		p-	    }'`"-	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }-	;;-    or32:Linux:*:*)-	echo or32-unknown-linux-gnu-	exit ;;-    ppc:Linux:*:*)-	echo powerpc-unknown-linux-gnu-	exit ;;-    ppc64:Linux:*:*)-	echo powerpc64-unknown-linux-gnu-	exit ;;-    alpha:Linux:*:*)-	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in-	  EV5)   UNAME_MACHINE=alphaev5 ;;-	  EV56)  UNAME_MACHINE=alphaev56 ;;-	  PCA56) UNAME_MACHINE=alphapca56 ;;-	  PCA57) UNAME_MACHINE=alphapca56 ;;-	  EV6)   UNAME_MACHINE=alphaev6 ;;-	  EV67)  UNAME_MACHINE=alphaev67 ;;-	  EV68*) UNAME_MACHINE=alphaev68 ;;-        esac-	objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null-	if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi-	echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}-	exit ;;-    parisc:Linux:*:* | hppa:Linux:*:*)-	# Look for CPU level-	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in-	  PA7*) echo hppa1.1-unknown-linux-gnu ;;-	  PA8*) echo hppa2.0-unknown-linux-gnu ;;-	  *)    echo hppa-unknown-linux-gnu ;;-	esac-	exit ;;-    parisc64:Linux:*:* | hppa64:Linux:*:*)-	echo hppa64-unknown-linux-gnu-	exit ;;-    s390:Linux:*:* | s390x:Linux:*:*)-	echo ${UNAME_MACHINE}-ibm-linux-	exit ;;-    sh64*:Linux:*:*)-    	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    sh*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    sparc:Linux:*:* | sparc64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    vax:Linux:*:*)-	echo ${UNAME_MACHINE}-dec-linux-gnu-	exit ;;-    x86_64:Linux:*:*)-	echo x86_64-unknown-linux-gnu-	exit ;;-    i*86:Linux:*:*)-	# The BFD linker knows what the default object file format is, so-	# first see if it will tell us. cd to the root directory to prevent-	# problems with other programs or directories called `ld' in the path.-	# Set LC_ALL=C to ensure ld outputs messages in English.-	ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \-			 | sed -ne '/supported targets:/!d-				    s/[ 	][ 	]*/ /g-				    s/.*supported targets: *//-				    s/ .*//-				    p'`-        case "$ld_supported_targets" in-	  elf32-i386)-		TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"-		;;-	  a.out-i386-linux)-		echo "${UNAME_MACHINE}-pc-linux-gnuaout"-		exit ;;-	  coff-i386)-		echo "${UNAME_MACHINE}-pc-linux-gnucoff"-		exit ;;-	  "")-		# Either a pre-BFD a.out linker (linux-gnuoldld) or-		# one that does not give us useful --help.-		echo "${UNAME_MACHINE}-pc-linux-gnuoldld"-		exit ;;-	esac-	# Determine whether the default compiler is a.out or elf-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#include <features.h>-	#ifdef __ELF__-	# ifdef __GLIBC__-	#  if __GLIBC__ >= 2-	LIBC=gnu-	#  else-	LIBC=gnulibc1-	#  endif-	# else-	LIBC=gnulibc1-	# endif-	#else-	#if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__sun)-	LIBC=gnu-	#else-	LIBC=gnuaout-	#endif-	#endif-	#ifdef __dietlibc__-	LIBC=dietlibc-	#endif-EOF-	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '-	    /^LIBC/{-		s: ::g-		p-	    }'`"-	test x"${LIBC}" != x && {-		echo "${UNAME_MACHINE}-pc-linux-${LIBC}"-		exit-	}-	test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }-	;;-    i*86:DYNIX/ptx:4*:*)-	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.-	# earlier versions are messed up and put the nodename in both-	# sysname and nodename.-	echo i386-sequent-sysv4-	exit ;;-    i*86:UNIX_SV:4.2MP:2.*)-        # Unixware is an offshoot of SVR4, but it has its own version-        # number series starting with 2...-        # I am not positive that other SVR4 systems won't match this,-	# I just have to hope.  -- rms.-        # Use sysv4.2uw... so that sysv4* matches it.-	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}-	exit ;;-    i*86:OS/2:*:*)-	# If we were able to find `uname', then EMX Unix compatibility-	# is probably installed.-	echo ${UNAME_MACHINE}-pc-os2-emx-	exit ;;-    i*86:XTS-300:*:STOP)-	echo ${UNAME_MACHINE}-unknown-stop-	exit ;;-    i*86:atheos:*:*)-	echo ${UNAME_MACHINE}-unknown-atheos-	exit ;;-    i*86:syllable:*:*)-	echo ${UNAME_MACHINE}-pc-syllable-	exit ;;-    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)-	echo i386-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    i*86:*DOS:*:*)-	echo ${UNAME_MACHINE}-pc-msdosdjgpp-	exit ;;-    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)-	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`-	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then-		echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}-	else-		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}-	fi-	exit ;;-    i*86:*:5:[678]*)-    	# UnixWare 7.x, OpenUNIX and OpenServer 6.-	case `/bin/uname -X | grep "^Machine"` in-	    *486*)	     UNAME_MACHINE=i486 ;;-	    *Pentium)	     UNAME_MACHINE=i586 ;;-	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;-	esac-	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}-	exit ;;-    i*86:*:3.2:*)-	if test -f /usr/options/cb.name; then-		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`-		echo ${UNAME_MACHINE}-pc-isc$UNAME_REL-	elif /bin/uname -X 2>/dev/null >/dev/null ; then-		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`-		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486-		(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \-			&& UNAME_MACHINE=i586-		(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \-			&& UNAME_MACHINE=i686-		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \-			&& UNAME_MACHINE=i686-		echo ${UNAME_MACHINE}-pc-sco$UNAME_REL-	else-		echo ${UNAME_MACHINE}-pc-sysv32-	fi-	exit ;;-    pc:*:*:*)-	# Left here for compatibility:-        # uname -m prints for DJGPP always 'pc', but it prints nothing about-        # the processor, so we play safe by assuming i386.-	echo i386-pc-msdosdjgpp-        exit ;;-    Intel:Mach:3*:*)-	echo i386-pc-mach3-	exit ;;-    paragon:*:*:*)-	echo i860-intel-osf1-	exit ;;-    i860:*:4.*:*) # i860-SVR4-	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then-	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4-	else # Add other i860-SVR4 vendors below as they are discovered.-	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4-	fi-	exit ;;-    mini*:CTIX:SYS*5:*)-	# "miniframe"-	echo m68010-convergent-sysv-	exit ;;-    mc68k:UNIX:SYSTEM5:3.51m)-	echo m68k-convergent-sysv-	exit ;;-    M680?0:D-NIX:5.3:*)-	echo m68k-diab-dnix-	exit ;;-    M68*:*:R3V[5678]*:*)-	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;-    3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)-	OS_REL=''-	test -r /etc/.relid \-	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`-	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \-	  && { echo i486-ncr-sysv4.3${OS_REL}; exit; }-	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \-	  && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;-    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)-        /bin/uname -p 2>/dev/null | grep 86 >/dev/null \-          && { echo i486-ncr-sysv4; exit; } ;;-    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)-	echo m68k-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    mc68030:UNIX_System_V:4.*:*)-	echo m68k-atari-sysv4-	exit ;;-    TSUNAMI:LynxOS:2.*:*)-	echo sparc-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    rs6000:LynxOS:2.*:*)-	echo rs6000-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)-	echo powerpc-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    SM[BE]S:UNIX_SV:*:*)-	echo mips-dde-sysv${UNAME_RELEASE}-	exit ;;-    RM*:ReliantUNIX-*:*:*)-	echo mips-sni-sysv4-	exit ;;-    RM*:SINIX-*:*:*)-	echo mips-sni-sysv4-	exit ;;-    *:SINIX-*:*:*)-	if uname -p 2>/dev/null >/dev/null ; then-		UNAME_MACHINE=`(uname -p) 2>/dev/null`-		echo ${UNAME_MACHINE}-sni-sysv4-	else-		echo ns32k-sni-sysv-	fi-	exit ;;-    PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort-                      # says <Richard.M.Bartel@ccMail.Census.GOV>-        echo i586-unisys-sysv4-        exit ;;-    *:UNIX_System_V:4*:FTX*)-	# From Gerald Hewes <hewes@openmarket.com>.-	# How about differentiating between stratus architectures? -djm-	echo hppa1.1-stratus-sysv4-	exit ;;-    *:*:*:FTX*)-	# From seanf@swdc.stratus.com.-	echo i860-stratus-sysv4-	exit ;;-    i*86:VOS:*:*)-	# From Paul.Green@stratus.com.-	echo ${UNAME_MACHINE}-stratus-vos-	exit ;;-    *:VOS:*:*)-	# From Paul.Green@stratus.com.-	echo hppa1.1-stratus-vos-	exit ;;-    mc68*:A/UX:*:*)-	echo m68k-apple-aux${UNAME_RELEASE}-	exit ;;-    news*:NEWS-OS:6*:*)-	echo mips-sony-newsos6-	exit ;;-    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)-	if [ -d /usr/nec ]; then-	        echo mips-nec-sysv${UNAME_RELEASE}-	else-	        echo mips-unknown-sysv${UNAME_RELEASE}-	fi-        exit ;;-    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.-	echo powerpc-be-beos-	exit ;;-    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.-	echo powerpc-apple-beos-	exit ;;-    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.-	echo i586-pc-beos-	exit ;;-    SX-4:SUPER-UX:*:*)-	echo sx4-nec-superux${UNAME_RELEASE}-	exit ;;-    SX-5:SUPER-UX:*:*)-	echo sx5-nec-superux${UNAME_RELEASE}-	exit ;;-    SX-6:SUPER-UX:*:*)-	echo sx6-nec-superux${UNAME_RELEASE}-	exit ;;-    Power*:Rhapsody:*:*)-	echo powerpc-apple-rhapsody${UNAME_RELEASE}-	exit ;;-    *:Rhapsody:*:*)-	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}-	exit ;;-    *:Darwin:*:*)-	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown-	case $UNAME_PROCESSOR in-	    unknown) UNAME_PROCESSOR=powerpc ;;-	esac-	echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}-	exit ;;-    *:procnto*:*:* | *:QNX:[0123456789]*:*)-	UNAME_PROCESSOR=`uname -p`-	if test "$UNAME_PROCESSOR" = "x86"; then-		UNAME_PROCESSOR=i386-		UNAME_MACHINE=pc-	fi-	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}-	exit ;;-    *:QNX:*:4*)-	echo i386-pc-qnx-	exit ;;-    NSE-?:NONSTOP_KERNEL:*:*)-	echo nse-tandem-nsk${UNAME_RELEASE}-	exit ;;-    NSR-?:NONSTOP_KERNEL:*:*)-	echo nsr-tandem-nsk${UNAME_RELEASE}-	exit ;;-    *:NonStop-UX:*:*)-	echo mips-compaq-nonstopux-	exit ;;-    BS2000:POSIX*:*:*)-	echo bs2000-siemens-sysv-	exit ;;-    DS/*:UNIX_System_V:*:*)-	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}-	exit ;;-    *:Plan9:*:*)-	# "uname -m" is not consistent, so use $cputype instead. 386-	# is converted to i386 for consistency with other x86-	# operating systems.-	if test "$cputype" = "386"; then-	    UNAME_MACHINE=i386-	else-	    UNAME_MACHINE="$cputype"-	fi-	echo ${UNAME_MACHINE}-unknown-plan9-	exit ;;-    *:TOPS-10:*:*)-	echo pdp10-unknown-tops10-	exit ;;-    *:TENEX:*:*)-	echo pdp10-unknown-tenex-	exit ;;-    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)-	echo pdp10-dec-tops20-	exit ;;-    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)-	echo pdp10-xkl-tops20-	exit ;;-    *:TOPS-20:*:*)-	echo pdp10-unknown-tops20-	exit ;;-    *:ITS:*:*)-	echo pdp10-unknown-its-	exit ;;-    SEI:*:*:SEIUX)-        echo mips-sei-seiux${UNAME_RELEASE}-	exit ;;-    *:DragonFly:*:*)-	echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-	exit ;;-    *:*VMS:*:*)-    	UNAME_MACHINE=`(uname -p) 2>/dev/null`-	case "${UNAME_MACHINE}" in-	    A*) echo alpha-dec-vms ; exit ;;-	    I*) echo ia64-dec-vms ; exit ;;-	    V*) echo vax-dec-vms ; exit ;;-	esac ;;-    *:XENIX:*:SysV)-	echo i386-pc-xenix-	exit ;;-    i*86:skyos:*:*)-	echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'-	exit ;;-    i*86:rdos:*:*)-	echo ${UNAME_MACHINE}-pc-rdos-	exit ;;-esac--#echo '(No uname command or uname output not recognized.)' 1>&2-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2--eval $set_cc_for_build-cat >$dummy.c <<EOF-#ifdef _SEQUENT_-# include <sys/types.h>-# include <sys/utsname.h>-#endif-main ()-{-#if defined (sony)-#if defined (MIPSEB)-  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,-     I don't know....  */-  printf ("mips-sony-bsd\n"); exit (0);-#else-#include <sys/param.h>-  printf ("m68k-sony-newsos%s\n",-#ifdef NEWSOS4-          "4"-#else-	  ""-#endif-         ); exit (0);-#endif-#endif--#if defined (__arm) && defined (__acorn) && defined (__unix)-  printf ("arm-acorn-riscix\n"); exit (0);-#endif--#if defined (hp300) && !defined (hpux)-  printf ("m68k-hp-bsd\n"); exit (0);-#endif--#if defined (NeXT)-#if !defined (__ARCHITECTURE__)-#define __ARCHITECTURE__ "m68k"-#endif-  int version;-  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;-  if (version < 4)-    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);-  else-    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);-  exit (0);-#endif--#if defined (MULTIMAX) || defined (n16)-#if defined (UMAXV)-  printf ("ns32k-encore-sysv\n"); exit (0);-#else-#if defined (CMU)-  printf ("ns32k-encore-mach\n"); exit (0);-#else-  printf ("ns32k-encore-bsd\n"); exit (0);-#endif-#endif-#endif--#if defined (__386BSD__)-  printf ("i386-pc-bsd\n"); exit (0);-#endif--#if defined (sequent)-#if defined (i386)-  printf ("i386-sequent-dynix\n"); exit (0);-#endif-#if defined (ns32000)-  printf ("ns32k-sequent-dynix\n"); exit (0);-#endif-#endif--#if defined (_SEQUENT_)-    struct utsname un;--    uname(&un);--    if (strncmp(un.version, "V2", 2) == 0) {-	printf ("i386-sequent-ptx2\n"); exit (0);-    }-    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */-	printf ("i386-sequent-ptx1\n"); exit (0);-    }-    printf ("i386-sequent-ptx\n"); exit (0);--#endif--#if defined (vax)-# if !defined (ultrix)-#  include <sys/param.h>-#  if defined (BSD)-#   if BSD == 43-      printf ("vax-dec-bsd4.3\n"); exit (0);-#   else-#    if BSD == 199006-      printf ("vax-dec-bsd4.3reno\n"); exit (0);-#    else-      printf ("vax-dec-bsd\n"); exit (0);-#    endif-#   endif-#  else-    printf ("vax-dec-bsd\n"); exit (0);-#  endif-# else-    printf ("vax-dec-ultrix\n"); exit (0);-# endif-#endif--#if defined (alliant) && defined (i860)-  printf ("i860-alliant-bsd\n"); exit (0);-#endif--  exit (1);-}-EOF--$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&-	{ echo "$SYSTEM_NAME"; exit; }--# Apollos put the system type in the environment.--test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }--# Convex versions that predate uname can use getsysinfo(1)--if [ -x /usr/convex/getsysinfo ]-then-    case `getsysinfo -f cpu_type` in-    c1*)-	echo c1-convex-bsd-	exit ;;-    c2*)-	if getsysinfo -f scalar_acc-	then echo c32-convex-bsd-	else echo c2-convex-bsd-	fi-	exit ;;-    c34*)-	echo c34-convex-bsd-	exit ;;-    c38*)-	echo c38-convex-bsd-	exit ;;-    c4*)-	echo c4-convex-bsd-	exit ;;-    esac-fi--cat >&2 <<EOF-$0: unable to guess system type--This script, last modified $timestamp, has failed to recognize-the operating system you are using. It is advised that you-download the most up to date version of the config scripts from--  http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess-and-  http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub--If the version you run ($0) is already up to date, please-send the following data and any information you think might be-pertinent to <config-patches@gnu.org> in order to provide the needed-information to handle your system.--config.guess timestamp = $timestamp--uname -m = `(uname -m) 2>/dev/null || echo unknown`-uname -r = `(uname -r) 2>/dev/null || echo unknown`-uname -s = `(uname -s) 2>/dev/null || echo unknown`-uname -v = `(uname -v) 2>/dev/null || echo unknown`--/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`-/bin/uname -X     = `(/bin/uname -X) 2>/dev/null`--hostinfo               = `(hostinfo) 2>/dev/null`-/bin/universe          = `(/bin/universe) 2>/dev/null`-/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null`-/bin/arch              = `(/bin/arch) 2>/dev/null`-/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null`-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`--UNAME_MACHINE = ${UNAME_MACHINE}-UNAME_RELEASE = ${UNAME_RELEASE}-UNAME_SYSTEM  = ${UNAME_SYSTEM}-UNAME_VERSION = ${UNAME_VERSION}-EOF--exit 1--# Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)-# time-stamp-start: "timestamp='"-# time-stamp-format: "%:y-%02m-%02d"-# time-stamp-end: "'"-# End:
− config.sub 
@@ -1,1608 +0,0 @@-#! /bin/sh-# Configuration validation subroutine script.-#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,-#   2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.--timestamp='2006-02-23'--# This file is (in principle) common to ALL GNU software.-# The presence of a machine in this file suggests that SOME GNU software-# can handle that machine.  It does not imply ALL GNU software can.-#-# This file is free software; you can redistribute it and/or modify-# it under the terms of the GNU General Public License as published by-# the Free Software Foundation; either version 2 of the License, or-# (at your option) any later version.-#-# This program is distributed in the hope that it will be useful,-# but WITHOUT ANY WARRANTY; without even the implied warranty of-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the-# GNU General Public License for more details.-#-# You should have received a copy of the GNU General Public License-# along with this program; if not, write to the Free Software-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA-# 02110-1301, USA.-#-# As a special exception to the GNU General Public License, if you-# distribute this file as part of a program that contains a-# configuration script generated by Autoconf, you may include it under-# the same distribution terms that you use for the rest of that program.---# Please send patches to <config-patches@gnu.org>.  Submit a context-# diff and a properly formatted ChangeLog entry.-#-# Configuration subroutine to validate and canonicalize a configuration type.-# Supply the specified configuration type as an argument.-# If it is invalid, we print an error message on stderr and exit with code 1.-# Otherwise, we print the canonical config type on stdout and succeed.--# This file is supposed to be the same for all GNU packages-# and recognize all the CPU types, system types and aliases-# that are meaningful with *any* GNU software.-# Each package is responsible for reporting which valid configurations-# it does not support.  The user should be able to distinguish-# a failure to support a valid configuration from a meaningless-# configuration.--# The goal of this file is to map all the various variations of a given-# machine specification into a single specification in the form:-#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM-# or in some cases, the newer four-part form:-#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM-# It is wrong to echo any other type of specification.--me=`echo "$0" | sed -e 's,.*/,,'`--usage="\-Usage: $0 [OPTION] CPU-MFR-OPSYS-       $0 [OPTION] ALIAS--Canonicalize a configuration name.--Operation modes:-  -h, --help         print this help, then exit-  -t, --time-stamp   print date of last modification, then exit-  -v, --version      print version number, then exit--Report bugs and patches to <config-patches@gnu.org>."--version="\-GNU config.sub ($timestamp)--Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005-Free Software Foundation, Inc.--This is free software; see the source for copying conditions.  There is NO-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."--help="-Try \`$me --help' for more information."--# Parse command line-while test $# -gt 0 ; do-  case $1 in-    --time-stamp | --time* | -t )-       echo "$timestamp" ; exit ;;-    --version | -v )-       echo "$version" ; exit ;;-    --help | --h* | -h )-       echo "$usage"; exit ;;-    -- )     # Stop option processing-       shift; break ;;-    - )	# Use stdin as input.-       break ;;-    -* )-       echo "$me: invalid option $1$help"-       exit 1 ;;--    *local*)-       # First pass through any local machine types.-       echo $1-       exit ;;--    * )-       break ;;-  esac-done--case $# in- 0) echo "$me: missing argument$help" >&2-    exit 1;;- 1) ;;- *) echo "$me: too many arguments$help" >&2-    exit 1;;-esac--# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).-# Here we must recognize all the valid KERNEL-OS combinations.-maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`-case $maybe_os in-  nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \-  uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \-  storm-chaos* | os2-emx* | rtmk-nova*)-    os=-$maybe_os-    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-    ;;-  *)-    basic_machine=`echo $1 | sed 's/-[^-]*$//'`-    if [ $basic_machine != $1 ]-    then os=`echo $1 | sed 's/.*-/-/'`-    else os=; fi-    ;;-esac--### Let's recognize common machines as not being operating systems so-### that things like config.sub decstation-3100 work.  We also-### recognize some manufacturers as not being operating systems, so we-### can provide default operating systems below.-case $os in-	-sun*os*)-		# Prevent following clause from handling this invalid input.-		;;-	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \-	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \-	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \-	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\-	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \-	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \-	-apple | -axis | -knuth | -cray)-		os=-		basic_machine=$1-		;;-	-sim | -cisco | -oki | -wec | -winbond)-		os=-		basic_machine=$1-		;;-	-scout)-		;;-	-wrs)-		os=-vxworks-		basic_machine=$1-		;;-	-chorusos*)-		os=-chorusos-		basic_machine=$1-		;;- 	-chorusrdb)- 		os=-chorusrdb-		basic_machine=$1- 		;;-	-hiux*)-		os=-hiuxwe2-		;;-	-sco6)-		os=-sco5v6-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco5)-		os=-sco3.2v5-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco4)-		os=-sco3.2v4-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco3.2.[4-9]*)-		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco3.2v[4-9]*)-		# Don't forget version if it is 3.2v4 or newer.-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco5v6*)-		# Don't forget version if it is 3.2v4 or newer.-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco*)-		os=-sco3.2v2-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-udk*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-isc)-		os=-isc2.2-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-clix*)-		basic_machine=clipper-intergraph-		;;-	-isc*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-lynx*)-		os=-lynxos-		;;-	-ptx*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`-		;;-	-windowsnt*)-		os=`echo $os | sed -e 's/windowsnt/winnt/'`-		;;-	-psos*)-		os=-psos-		;;-	-mint | -mint[0-9]*)-		basic_machine=m68k-atari-		os=-mint-		;;-esac--# Decode aliases for certain CPU-COMPANY combinations.-case $basic_machine in-	# Recognize the basic CPU types without company name.-	# Some are omitted here because they have special meanings below.-	1750a | 580 \-	| a29k \-	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \-	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \-	| am33_2.0 \-	| arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \-	| bfin \-	| c4x | clipper \-	| d10v | d30v | dlx | dsp16xx \-	| fr30 | frv \-	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \-	| i370 | i860 | i960 | ia64 \-	| ip2k | iq2000 \-	| m32r | m32rle | m68000 | m68k | m88k | maxq | mb | microblaze | mcore \-	| mips | mipsbe | mipseb | mipsel | mipsle \-	| mips16 \-	| mips64 | mips64el \-	| mips64vr | mips64vrel \-	| mips64orion | mips64orionel \-	| mips64vr4100 | mips64vr4100el \-	| mips64vr4300 | mips64vr4300el \-	| mips64vr5000 | mips64vr5000el \-	| mips64vr5900 | mips64vr5900el \-	| mipsisa32 | mipsisa32el \-	| mipsisa32r2 | mipsisa32r2el \-	| mipsisa64 | mipsisa64el \-	| mipsisa64r2 | mipsisa64r2el \-	| mipsisa64sb1 | mipsisa64sb1el \-	| mipsisa64sr71k | mipsisa64sr71kel \-	| mipstx39 | mipstx39el \-	| mn10200 | mn10300 \-	| mt \-	| msp430 \-	| nios | nios2 \-	| ns16k | ns32k \-	| or32 \-	| pdp10 | pdp11 | pj | pjl \-	| powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \-	| pyramid \-	| sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \-	| sh64 | sh64le \-	| sparc | sparc64 | sparc64b | sparc86x | sparclet | sparclite \-	| sparcv8 | sparcv9 | sparcv9b \-	| strongarm \-	| tahoe | thumb | tic4x | tic80 | tron \-	| v850 | v850e \-	| we32k \-	| x86 | xscale | xscalee[bl] | xstormy16 | xtensa \-	| z8k)-		basic_machine=$basic_machine-unknown-		;;-	m32c)-		basic_machine=$basic_machine-unknown-		;;-	m6811 | m68hc11 | m6812 | m68hc12)-		# Motorola 68HC11/12.-		basic_machine=$basic_machine-unknown-		os=-none-		;;-	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)-		;;-	ms1)-		basic_machine=mt-unknown-		;;--	# We use `pc' rather than `unknown'-	# because (1) that's what they normally are, and-	# (2) the word "unknown" tends to confuse beginning users.-	i*86 | x86_64)-	  basic_machine=$basic_machine-pc-	  ;;-	# Object if more than one company name word.-	*-*-*)-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2-		exit 1-		;;-	# Recognize the basic CPU types with company name.-	580-* \-	| a29k-* \-	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \-	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \-	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \-	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \-	| avr-* \-	| bfin-* | bs2000-* \-	| c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \-	| clipper-* | craynv-* | cydra-* \-	| d10v-* | d30v-* | dlx-* \-	| elxsi-* \-	| f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \-	| h8300-* | h8500-* \-	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \-	| i*86-* | i860-* | i960-* | ia64-* \-	| ip2k-* | iq2000-* \-	| m32r-* | m32rle-* \-	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \-	| m88110-* | m88k-* | maxq-* | mcore-* \-	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \-	| mips16-* \-	| mips64-* | mips64el-* \-	| mips64vr-* | mips64vrel-* \-	| mips64orion-* | mips64orionel-* \-	| mips64vr4100-* | mips64vr4100el-* \-	| mips64vr4300-* | mips64vr4300el-* \-	| mips64vr5000-* | mips64vr5000el-* \-	| mips64vr5900-* | mips64vr5900el-* \-	| mipsisa32-* | mipsisa32el-* \-	| mipsisa32r2-* | mipsisa32r2el-* \-	| mipsisa64-* | mipsisa64el-* \-	| mipsisa64r2-* | mipsisa64r2el-* \-	| mipsisa64sb1-* | mipsisa64sb1el-* \-	| mipsisa64sr71k-* | mipsisa64sr71kel-* \-	| mipstx39-* | mipstx39el-* \-	| mmix-* \-	| mt-* \-	| msp430-* \-	| nios-* | nios2-* \-	| none-* | np1-* | ns16k-* | ns32k-* \-	| orion-* \-	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \-	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \-	| pyramid-* \-	| romp-* | rs6000-* \-	| sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | shbe-* \-	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \-	| sparc-* | sparc64-* | sparc64b-* | sparc86x-* | sparclet-* \-	| sparclite-* \-	| sparcv8-* | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \-	| tahoe-* | thumb-* \-	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \-	| tron-* \-	| v850-* | v850e-* | vax-* \-	| we32k-* \-	| x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \-	| xstormy16-* | xtensa-* \-	| ymp-* \-	| z8k-*)-		;;-	m32c-*)-		;;-	# Recognize the various machine names and aliases which stand-	# for a CPU type and a company and sometimes even an OS.-	386bsd)-		basic_machine=i386-unknown-		os=-bsd-		;;-	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)-		basic_machine=m68000-att-		;;-	3b*)-		basic_machine=we32k-att-		;;-	a29khif)-		basic_machine=a29k-amd-		os=-udi-		;;-    	abacus)-		basic_machine=abacus-unknown-		;;-	adobe68k)-		basic_machine=m68010-adobe-		os=-scout-		;;-	alliant | fx80)-		basic_machine=fx80-alliant-		;;-	altos | altos3068)-		basic_machine=m68k-altos-		;;-	am29k)-		basic_machine=a29k-none-		os=-bsd-		;;-	amd64)-		basic_machine=x86_64-pc-		;;-	amd64-*)-		basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	amdahl)-		basic_machine=580-amdahl-		os=-sysv-		;;-	amiga | amiga-*)-		basic_machine=m68k-unknown-		;;-	amigaos | amigados)-		basic_machine=m68k-unknown-		os=-amigaos-		;;-	amigaunix | amix)-		basic_machine=m68k-unknown-		os=-sysv4-		;;-	apollo68)-		basic_machine=m68k-apollo-		os=-sysv-		;;-	apollo68bsd)-		basic_machine=m68k-apollo-		os=-bsd-		;;-	aux)-		basic_machine=m68k-apple-		os=-aux-		;;-	balance)-		basic_machine=ns32k-sequent-		os=-dynix-		;;-	c90)-		basic_machine=c90-cray-		os=-unicos-		;;-	convex-c1)-		basic_machine=c1-convex-		os=-bsd-		;;-	convex-c2)-		basic_machine=c2-convex-		os=-bsd-		;;-	convex-c32)-		basic_machine=c32-convex-		os=-bsd-		;;-	convex-c34)-		basic_machine=c34-convex-		os=-bsd-		;;-	convex-c38)-		basic_machine=c38-convex-		os=-bsd-		;;-	cray | j90)-		basic_machine=j90-cray-		os=-unicos-		;;-	craynv)-		basic_machine=craynv-cray-		os=-unicosmp-		;;-	cr16c)-		basic_machine=cr16c-unknown-		os=-elf-		;;-	crds | unos)-		basic_machine=m68k-crds-		;;-	crisv32 | crisv32-* | etraxfs*)-		basic_machine=crisv32-axis-		;;-	cris | cris-* | etrax*)-		basic_machine=cris-axis-		;;-	crx)-		basic_machine=crx-unknown-		os=-elf-		;;-	da30 | da30-*)-		basic_machine=m68k-da30-		;;-	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)-		basic_machine=mips-dec-		;;-	decsystem10* | dec10*)-		basic_machine=pdp10-dec-		os=-tops10-		;;-	decsystem20* | dec20*)-		basic_machine=pdp10-dec-		os=-tops20-		;;-	delta | 3300 | motorola-3300 | motorola-delta \-	      | 3300-motorola | delta-motorola)-		basic_machine=m68k-motorola-		;;-	delta88)-		basic_machine=m88k-motorola-		os=-sysv3-		;;-	djgpp)-		basic_machine=i586-pc-		os=-msdosdjgpp-		;;-	dpx20 | dpx20-*)-		basic_machine=rs6000-bull-		os=-bosx-		;;-	dpx2* | dpx2*-bull)-		basic_machine=m68k-bull-		os=-sysv3-		;;-	ebmon29k)-		basic_machine=a29k-amd-		os=-ebmon-		;;-	elxsi)-		basic_machine=elxsi-elxsi-		os=-bsd-		;;-	encore | umax | mmax)-		basic_machine=ns32k-encore-		;;-	es1800 | OSE68k | ose68k | ose | OSE)-		basic_machine=m68k-ericsson-		os=-ose-		;;-	fx2800)-		basic_machine=i860-alliant-		;;-	genix)-		basic_machine=ns32k-ns-		;;-	gmicro)-		basic_machine=tron-gmicro-		os=-sysv-		;;-	go32)-		basic_machine=i386-pc-		os=-go32-		;;-	h3050r* | hiux*)-		basic_machine=hppa1.1-hitachi-		os=-hiuxwe2-		;;-	h8300hms)-		basic_machine=h8300-hitachi-		os=-hms-		;;-	h8300xray)-		basic_machine=h8300-hitachi-		os=-xray-		;;-	h8500hms)-		basic_machine=h8500-hitachi-		os=-hms-		;;-	harris)-		basic_machine=m88k-harris-		os=-sysv3-		;;-	hp300-*)-		basic_machine=m68k-hp-		;;-	hp300bsd)-		basic_machine=m68k-hp-		os=-bsd-		;;-	hp300hpux)-		basic_machine=m68k-hp-		os=-hpux-		;;-	hp3k9[0-9][0-9] | hp9[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hp9k2[0-9][0-9] | hp9k31[0-9])-		basic_machine=m68000-hp-		;;-	hp9k3[2-9][0-9])-		basic_machine=m68k-hp-		;;-	hp9k6[0-9][0-9] | hp6[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hp9k7[0-79][0-9] | hp7[0-79][0-9])-		basic_machine=hppa1.1-hp-		;;-	hp9k78[0-9] | hp78[0-9])-		# FIXME: really hppa2.0-hp-		basic_machine=hppa1.1-hp-		;;-	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)-		# FIXME: really hppa2.0-hp-		basic_machine=hppa1.1-hp-		;;-	hp9k8[0-9][13679] | hp8[0-9][13679])-		basic_machine=hppa1.1-hp-		;;-	hp9k8[0-9][0-9] | hp8[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hppa-next)-		os=-nextstep3-		;;-	hppaosf)-		basic_machine=hppa1.1-hp-		os=-osf-		;;-	hppro)-		basic_machine=hppa1.1-hp-		os=-proelf-		;;-	i370-ibm* | ibm*)-		basic_machine=i370-ibm-		;;-# I'm not sure what "Sysv32" means.  Should this be sysv3.2?-	i*86v32)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv32-		;;-	i*86v4*)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv4-		;;-	i*86v)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv-		;;-	i*86sol2)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-solaris2-		;;-	i386mach)-		basic_machine=i386-mach-		os=-mach-		;;-	i386-vsta | vsta)-		basic_machine=i386-unknown-		os=-vsta-		;;-	iris | iris4d)-		basic_machine=mips-sgi-		case $os in-		    -irix*)-			;;-		    *)-			os=-irix4-			;;-		esac-		;;-	isi68 | isi)-		basic_machine=m68k-isi-		os=-sysv-		;;-	m88k-omron*)-		basic_machine=m88k-omron-		;;-	magnum | m3230)-		basic_machine=mips-mips-		os=-sysv-		;;-	merlin)-		basic_machine=ns32k-utek-		os=-sysv-		;;-	mingw32)-		basic_machine=i386-pc-		os=-mingw32-		;;-	miniframe)-		basic_machine=m68000-convergent-		;;-	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)-		basic_machine=m68k-atari-		os=-mint-		;;-	mips3*-*)-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-		;;-	mips3*)-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown-		;;-	monitor)-		basic_machine=m68k-rom68k-		os=-coff-		;;-	morphos)-		basic_machine=powerpc-unknown-		os=-morphos-		;;-	msdos)-		basic_machine=i386-pc-		os=-msdos-		;;-	ms1-*)-		basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`-		;;-	mvs)-		basic_machine=i370-ibm-		os=-mvs-		;;-	ncr3000)-		basic_machine=i486-ncr-		os=-sysv4-		;;-	netbsd386)-		basic_machine=i386-unknown-		os=-netbsd-		;;-	netwinder)-		basic_machine=armv4l-rebel-		os=-linux-		;;-	news | news700 | news800 | news900)-		basic_machine=m68k-sony-		os=-newsos-		;;-	news1000)-		basic_machine=m68030-sony-		os=-newsos-		;;-	news-3600 | risc-news)-		basic_machine=mips-sony-		os=-newsos-		;;-	necv70)-		basic_machine=v70-nec-		os=-sysv-		;;-	next | m*-next )-		basic_machine=m68k-next-		case $os in-		    -nextstep* )-			;;-		    -ns2*)-		      os=-nextstep2-			;;-		    *)-		      os=-nextstep3-			;;-		esac-		;;-	nh3000)-		basic_machine=m68k-harris-		os=-cxux-		;;-	nh[45]000)-		basic_machine=m88k-harris-		os=-cxux-		;;-	nindy960)-		basic_machine=i960-intel-		os=-nindy-		;;-	mon960)-		basic_machine=i960-intel-		os=-mon960-		;;-	nonstopux)-		basic_machine=mips-compaq-		os=-nonstopux-		;;-	np1)-		basic_machine=np1-gould-		;;-	nsr-tandem)-		basic_machine=nsr-tandem-		;;-	op50n-* | op60c-*)-		basic_machine=hppa1.1-oki-		os=-proelf-		;;-	openrisc | openrisc-*)-		basic_machine=or32-unknown-		;;-	os400)-		basic_machine=powerpc-ibm-		os=-os400-		;;-	OSE68000 | ose68000)-		basic_machine=m68000-ericsson-		os=-ose-		;;-	os68k)-		basic_machine=m68k-none-		os=-os68k-		;;-	pa-hitachi)-		basic_machine=hppa1.1-hitachi-		os=-hiuxwe2-		;;-	paragon)-		basic_machine=i860-intel-		os=-osf-		;;-	pbd)-		basic_machine=sparc-tti-		;;-	pbb)-		basic_machine=m68k-tti-		;;-	pc532 | pc532-*)-		basic_machine=ns32k-pc532-		;;-	pc98)-		basic_machine=i386-pc-		;;-	pc98-*)-		basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentium | p5 | k5 | k6 | nexgen | viac3)-		basic_machine=i586-pc-		;;-	pentiumpro | p6 | 6x86 | athlon | athlon_*)-		basic_machine=i686-pc-		;;-	pentiumii | pentium2 | pentiumiii | pentium3)-		basic_machine=i686-pc-		;;-	pentium4)-		basic_machine=i786-pc-		;;-	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)-		basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentiumpro-* | p6-* | 6x86-* | athlon-*)-		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)-		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentium4-*)-		basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pn)-		basic_machine=pn-gould-		;;-	power)	basic_machine=power-ibm-		;;-	ppc)	basic_machine=powerpc-unknown-		;;-	ppc-*)	basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppcle | powerpclittle | ppc-le | powerpc-little)-		basic_machine=powerpcle-unknown-		;;-	ppcle-* | powerpclittle-*)-		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppc64)	basic_machine=powerpc64-unknown-		;;-	ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppc64le | powerpc64little | ppc64-le | powerpc64-little)-		basic_machine=powerpc64le-unknown-		;;-	ppc64le-* | powerpc64little-*)-		basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ps2)-		basic_machine=i386-ibm-		;;-	pw32)-		basic_machine=i586-unknown-		os=-pw32-		;;-	rdos)-		basic_machine=i386-pc-		os=-rdos-		;;-	rom68k)-		basic_machine=m68k-rom68k-		os=-coff-		;;-	rm[46]00)-		basic_machine=mips-siemens-		;;-	rtpc | rtpc-*)-		basic_machine=romp-ibm-		;;-	s390 | s390-*)-		basic_machine=s390-ibm-		;;-	s390x | s390x-*)-		basic_machine=s390x-ibm-		;;-	sa29200)-		basic_machine=a29k-amd-		os=-udi-		;;-	sb1)-		basic_machine=mipsisa64sb1-unknown-		;;-	sb1el)-		basic_machine=mipsisa64sb1el-unknown-		;;-	sei)-		basic_machine=mips-sei-		os=-seiux-		;;-	sequent)-		basic_machine=i386-sequent-		;;-	sh)-		basic_machine=sh-hitachi-		os=-hms-		;;-	sh64)-		basic_machine=sh64-unknown-		;;-	sparclite-wrs | simso-wrs)-		basic_machine=sparclite-wrs-		os=-vxworks-		;;-	sps7)-		basic_machine=m68k-bull-		os=-sysv2-		;;-	spur)-		basic_machine=spur-unknown-		;;-	st2000)-		basic_machine=m68k-tandem-		;;-	stratus)-		basic_machine=i860-stratus-		os=-sysv4-		;;-	sun2)-		basic_machine=m68000-sun-		;;-	sun2os3)-		basic_machine=m68000-sun-		os=-sunos3-		;;-	sun2os4)-		basic_machine=m68000-sun-		os=-sunos4-		;;-	sun3os3)-		basic_machine=m68k-sun-		os=-sunos3-		;;-	sun3os4)-		basic_machine=m68k-sun-		os=-sunos4-		;;-	sun4os3)-		basic_machine=sparc-sun-		os=-sunos3-		;;-	sun4os4)-		basic_machine=sparc-sun-		os=-sunos4-		;;-	sun4sol2)-		basic_machine=sparc-sun-		os=-solaris2-		;;-	sun3 | sun3-*)-		basic_machine=m68k-sun-		;;-	sun4)-		basic_machine=sparc-sun-		;;-	sun386 | sun386i | roadrunner)-		basic_machine=i386-sun-		;;-	sv1)-		basic_machine=sv1-cray-		os=-unicos-		;;-	symmetry)-		basic_machine=i386-sequent-		os=-dynix-		;;-	t3e)-		basic_machine=alphaev5-cray-		os=-unicos-		;;-	t90)-		basic_machine=t90-cray-		os=-unicos-		;;-	tic54x | c54x*)-		basic_machine=tic54x-unknown-		os=-coff-		;;-	tic55x | c55x*)-		basic_machine=tic55x-unknown-		os=-coff-		;;-	tic6x | c6x*)-		basic_machine=tic6x-unknown-		os=-coff-		;;-	tx39)-		basic_machine=mipstx39-unknown-		;;-	tx39el)-		basic_machine=mipstx39el-unknown-		;;-	toad1)-		basic_machine=pdp10-xkl-		os=-tops20-		;;-	tower | tower-32)-		basic_machine=m68k-ncr-		;;-	tpf)-		basic_machine=s390x-ibm-		os=-tpf-		;;-	udi29k)-		basic_machine=a29k-amd-		os=-udi-		;;-	ultra3)-		basic_machine=a29k-nyu-		os=-sym1-		;;-	v810 | necv810)-		basic_machine=v810-nec-		os=-none-		;;-	vaxv)-		basic_machine=vax-dec-		os=-sysv-		;;-	vms)-		basic_machine=vax-dec-		os=-vms-		;;-	vpp*|vx|vx-*)-		basic_machine=f301-fujitsu-		;;-	vxworks960)-		basic_machine=i960-wrs-		os=-vxworks-		;;-	vxworks68)-		basic_machine=m68k-wrs-		os=-vxworks-		;;-	vxworks29k)-		basic_machine=a29k-wrs-		os=-vxworks-		;;-	w65*)-		basic_machine=w65-wdc-		os=-none-		;;-	w89k-*)-		basic_machine=hppa1.1-winbond-		os=-proelf-		;;-	xbox)-		basic_machine=i686-pc-		os=-mingw32-		;;-	xps | xps100)-		basic_machine=xps100-honeywell-		;;-	ymp)-		basic_machine=ymp-cray-		os=-unicos-		;;-	z8k-*-coff)-		basic_machine=z8k-unknown-		os=-sim-		;;-	none)-		basic_machine=none-none-		os=-none-		;;--# Here we handle the default manufacturer of certain CPU types.  It is in-# some cases the only manufacturer, in others, it is the most popular.-	w89k)-		basic_machine=hppa1.1-winbond-		;;-	op50n)-		basic_machine=hppa1.1-oki-		;;-	op60c)-		basic_machine=hppa1.1-oki-		;;-	romp)-		basic_machine=romp-ibm-		;;-	mmix)-		basic_machine=mmix-knuth-		;;-	rs6000)-		basic_machine=rs6000-ibm-		;;-	vax)-		basic_machine=vax-dec-		;;-	pdp10)-		# there are many clones, so DEC is not a safe bet-		basic_machine=pdp10-unknown-		;;-	pdp11)-		basic_machine=pdp11-dec-		;;-	we32k)-		basic_machine=we32k-att-		;;-	sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele)-		basic_machine=sh-unknown-		;;-	sparc | sparcv8 | sparcv9 | sparcv9b)-		basic_machine=sparc-sun-		;;-	cydra)-		basic_machine=cydra-cydrome-		;;-	orion)-		basic_machine=orion-highlevel-		;;-	orion105)-		basic_machine=clipper-highlevel-		;;-	mac | mpw | mac-mpw)-		basic_machine=m68k-apple-		;;-	pmac | pmac-mpw)-		basic_machine=powerpc-apple-		;;-	*-unknown)-		# Make sure to match an already-canonicalized machine name.-		;;-	*)-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2-		exit 1-		;;-esac--# Here we canonicalize certain aliases for manufacturers.-case $basic_machine in-	*-digital*)-		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`-		;;-	*-commodore*)-		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`-		;;-	*)-		;;-esac--# Decode manufacturer-specific aliases for certain operating systems.--if [ x"$os" != x"" ]-then-case $os in-        # First match some system type aliases-        # that might get confused with valid system types.-	# -solaris* is a basic system type, with this one exception.-	-solaris1 | -solaris1.*)-		os=`echo $os | sed -e 's|solaris1|sunos4|'`-		;;-	-solaris)-		os=-solaris2-		;;-	-svr4*)-		os=-sysv4-		;;-	-unixware*)-		os=-sysv4.2uw-		;;-	-gnu/linux*)-		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`-		;;-	# First accept the basic system types.-	# The portable systems comes first.-	# Each alternative MUST END IN A *, to match a version number.-	# -sysv* is not here because it comes later, after sysvr4.-	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \-	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\-	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \-	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \-	      | -aos* \-	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \-	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \-	      | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \-	      | -openbsd* | -solidbsd* \-	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \-	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \-	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \-	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \-	      | -chorusos* | -chorusrdb* \-	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \-	      | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \-	      | -uxpv* | -beos* | -mpeix* | -udk* \-	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \-	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \-	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \-	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \-	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \-	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \-	      | -skyos* | -haiku* | -rdos*)-	# Remember, each alternative MUST END IN *, to match a version number.-		;;-	-qnx*)-		case $basic_machine in-		    x86-* | i*86-*)-			;;-		    *)-			os=-nto$os-			;;-		esac-		;;-	-nto-qnx*)-		;;-	-nto*)-		os=`echo $os | sed -e 's|nto|nto-qnx|'`-		;;-	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \-	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \-	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)-		;;-	-mac*)-		os=`echo $os | sed -e 's|mac|macos|'`-		;;-	-linux-dietlibc)-		os=-linux-dietlibc-		;;-	-linux*)-		os=`echo $os | sed -e 's|linux|linux-gnu|'`-		;;-	-sunos5*)-		os=`echo $os | sed -e 's|sunos5|solaris2|'`-		;;-	-sunos6*)-		os=`echo $os | sed -e 's|sunos6|solaris3|'`-		;;-	-opened*)-		os=-openedition-		;;-        -os400*)-		os=-os400-		;;-	-wince*)-		os=-wince-		;;-	-osfrose*)-		os=-osfrose-		;;-	-osf*)-		os=-osf-		;;-	-utek*)-		os=-bsd-		;;-	-dynix*)-		os=-bsd-		;;-	-acis*)-		os=-aos-		;;-	-atheos*)-		os=-atheos-		;;-	-syllable*)-		os=-syllable-		;;-	-386bsd)-		os=-bsd-		;;-	-ctix* | -uts*)-		os=-sysv-		;;-	-nova*)-		os=-rtmk-nova-		;;-	-ns2 )-		os=-nextstep2-		;;-	-nsk*)-		os=-nsk-		;;-	# Preserve the version number of sinix5.-	-sinix5.*)-		os=`echo $os | sed -e 's|sinix|sysv|'`-		;;-	-sinix*)-		os=-sysv4-		;;-        -tpf*)-		os=-tpf-		;;-	-triton*)-		os=-sysv3-		;;-	-oss*)-		os=-sysv3-		;;-	-svr4)-		os=-sysv4-		;;-	-svr3)-		os=-sysv3-		;;-	-sysvr4)-		os=-sysv4-		;;-	# This must come after -sysvr4.-	-sysv*)-		;;-	-ose*)-		os=-ose-		;;-	-es1800*)-		os=-ose-		;;-	-xenix)-		os=-xenix-		;;-	-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)-		os=-mint-		;;-	-aros*)-		os=-aros-		;;-	-kaos*)-		os=-kaos-		;;-	-zvmoe)-		os=-zvmoe-		;;-	-none)-		;;-	*)-		# Get rid of the `-' at the beginning of $os.-		os=`echo $os | sed 's/[^-]*-//'`-		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2-		exit 1-		;;-esac-else--# Here we handle the default operating systems that come with various machines.-# The value should be what the vendor currently ships out the door with their-# machine or put another way, the most popular os provided with the machine.--# Note that if you're going to try to match "-MANUFACTURER" here (say,-# "-sun"), then you have to tell the case statement up towards the top-# that MANUFACTURER isn't an operating system.  Otherwise, code above-# will signal an error saying that MANUFACTURER isn't an operating-# system, and we'll never get to this point.--case $basic_machine in-	*-acorn)-		os=-riscix1.2-		;;-	arm*-rebel)-		os=-linux-		;;-	arm*-semi)-		os=-aout-		;;-    c4x-* | tic4x-*)-        os=-coff-        ;;-	# This must come before the *-dec entry.-	pdp10-*)-		os=-tops20-		;;-	pdp11-*)-		os=-none-		;;-	*-dec | vax-*)-		os=-ultrix4.2-		;;-	m68*-apollo)-		os=-domain-		;;-	i386-sun)-		os=-sunos4.0.2-		;;-	m68000-sun)-		os=-sunos3-		# This also exists in the configure program, but was not the-		# default.-		# os=-sunos4-		;;-	m68*-cisco)-		os=-aout-		;;-	mips*-cisco)-		os=-elf-		;;-	mips*-*)-		os=-elf-		;;-	or32-*)-		os=-coff-		;;-	*-tti)	# must be before sparc entry or we get the wrong os.-		os=-sysv3-		;;-	sparc-* | *-sun)-		os=-sunos4.1.1-		;;-	*-be)-		os=-beos-		;;-	*-haiku)-		os=-haiku-		;;-	*-ibm)-		os=-aix-		;;-    	*-knuth)-		os=-mmixware-		;;-	*-wec)-		os=-proelf-		;;-	*-winbond)-		os=-proelf-		;;-	*-oki)-		os=-proelf-		;;-	*-hp)-		os=-hpux-		;;-	*-hitachi)-		os=-hiux-		;;-	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)-		os=-sysv-		;;-	*-cbm)-		os=-amigaos-		;;-	*-dg)-		os=-dgux-		;;-	*-dolphin)-		os=-sysv3-		;;-	m68k-ccur)-		os=-rtu-		;;-	m88k-omron*)-		os=-luna-		;;-	*-next )-		os=-nextstep-		;;-	*-sequent)-		os=-ptx-		;;-	*-crds)-		os=-unos-		;;-	*-ns)-		os=-genix-		;;-	i370-*)-		os=-mvs-		;;-	*-next)-		os=-nextstep3-		;;-	*-gould)-		os=-sysv-		;;-	*-highlevel)-		os=-bsd-		;;-	*-encore)-		os=-bsd-		;;-	*-sgi)-		os=-irix-		;;-	*-siemens)-		os=-sysv4-		;;-	*-masscomp)-		os=-rtu-		;;-	f30[01]-fujitsu | f700-fujitsu)-		os=-uxpv-		;;-	*-rom68k)-		os=-coff-		;;-	*-*bug)-		os=-coff-		;;-	*-apple)-		os=-macos-		;;-	*-atari*)-		os=-mint-		;;-	*)-		os=-none-		;;-esac-fi--# Here we handle the case where we know the os, and the CPU type, but not the-# manufacturer.  We pick the logical manufacturer.-vendor=unknown-case $basic_machine in-	*-unknown)-		case $os in-			-riscix*)-				vendor=acorn-				;;-			-sunos*)-				vendor=sun-				;;-			-aix*)-				vendor=ibm-				;;-			-beos*)-				vendor=be-				;;-			-hpux*)-				vendor=hp-				;;-			-mpeix*)-				vendor=hp-				;;-			-hiux*)-				vendor=hitachi-				;;-			-unos*)-				vendor=crds-				;;-			-dgux*)-				vendor=dg-				;;-			-luna*)-				vendor=omron-				;;-			-genix*)-				vendor=ns-				;;-			-mvs* | -opened*)-				vendor=ibm-				;;-			-os400*)-				vendor=ibm-				;;-			-ptx*)-				vendor=sequent-				;;-			-tpf*)-				vendor=ibm-				;;-			-vxsim* | -vxworks* | -windiss*)-				vendor=wrs-				;;-			-aux*)-				vendor=apple-				;;-			-hms*)-				vendor=hitachi-				;;-			-mpw* | -macos*)-				vendor=apple-				;;-			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)-				vendor=atari-				;;-			-vos*)-				vendor=stratus-				;;-		esac-		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`-		;;-esac--echo $basic_machine$os-exit--# Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)-# time-stamp-start: "timestamp='"-# time-stamp-format: "%:y-%02m-%02d"-# time-stamp-end: "'"-# End:
− configure 
@@ -1,8007 +0,0 @@-#! /bin/sh-# Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.68 for Haskell OpenGL package 2.2.3.0.-#-# Report bugs to <sven.panne@aedion.de>.-#-#-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software-# Foundation, Inc.-#-#-# This configure script is free software; the Free Software Foundation-# gives unlimited permission to copy, distribute and modify it.-## -------------------- ##-## M4sh Initialization. ##-## -------------------- ##--# Be more Bourne compatible-DUALCASE=1; export DUALCASE # for MKS sh-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :-  emulate sh-  NULLCMD=:-  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which-  # is contrary to our usage.  Disable this feature.-  alias -g '${1+"$@"}'='"$@"'-  setopt NO_GLOB_SUBST-else-  case `(set -o) 2>/dev/null` in #(-  *posix*) :-    set -o posix ;; #(-  *) :-     ;;-esac-fi---as_nl='-'-export as_nl-# Printing a long string crashes Solaris 7 /usr/bin/printf.-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo-# Prefer a ksh shell builtin over an external printf program on Solaris,-# but without wasting forks for bash or zsh.-if test -z "$BASH_VERSION$ZSH_VERSION" \-    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then-  as_echo='print -r --'-  as_echo_n='print -rn --'-elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then-  as_echo='printf %s\n'-  as_echo_n='printf %s'-else-  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then-    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'-    as_echo_n='/usr/ucb/echo -n'-  else-    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'-    as_echo_n_body='eval-      arg=$1;-      case $arg in #(-      *"$as_nl"*)-	expr "X$arg" : "X\\(.*\\)$as_nl";-	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;-      esac;-      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"-    '-    export as_echo_n_body-    as_echo_n='sh -c $as_echo_n_body as_echo'-  fi-  export as_echo_body-  as_echo='sh -c $as_echo_body as_echo'-fi--# The user is always right.-if test "${PATH_SEPARATOR+set}" != set; then-  PATH_SEPARATOR=:-  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {-    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||-      PATH_SEPARATOR=';'-  }-fi---# IFS-# We need space, tab and new line, in precisely that order.  Quoting is-# there to prevent editors from complaining about space-tab.-# (If _AS_PATH_WALK were called with IFS unset, it would disable word-# splitting by setting IFS to empty value.)-IFS=" ""	$as_nl"--# Find who we are.  Look in the path if we contain no directory separator.-as_myself=-case $0 in #((-  *[\\/]* ) as_myself=$0 ;;-  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break-  done-IFS=$as_save_IFS--     ;;-esac-# We did not find ourselves, most probably we were run as `sh COMMAND'-# in which case we are not to be found in the path.-if test "x$as_myself" = x; then-  as_myself=$0-fi-if test ! -f "$as_myself"; then-  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2-  exit 1-fi--# Unset variables that we do not need and which cause bugs (e.g. in-# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"-# suppresses any "Segmentation fault" message there.  '((' could-# trigger a bug in pdksh 5.2.14.-for as_var in BASH_ENV ENV MAIL MAILPATH-do eval test x\${$as_var+set} = xset \-  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :-done-PS1='$ '-PS2='> '-PS4='+ '--# NLS nuisances.-LC_ALL=C-export LC_ALL-LANGUAGE=C-export LANGUAGE--# CDPATH.-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH--if test "x$CONFIG_SHELL" = x; then-  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :-  emulate sh-  NULLCMD=:-  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which-  # is contrary to our usage.  Disable this feature.-  alias -g '\${1+\"\$@\"}'='\"\$@\"'-  setopt NO_GLOB_SUBST-else-  case \`(set -o) 2>/dev/null\` in #(-  *posix*) :-    set -o posix ;; #(-  *) :-     ;;-esac-fi-"-  as_required="as_fn_return () { (exit \$1); }-as_fn_success () { as_fn_return 0; }-as_fn_failure () { as_fn_return 1; }-as_fn_ret_success () { return 0; }-as_fn_ret_failure () { return 1; }--exitcode=0-as_fn_success || { exitcode=1; echo as_fn_success failed.; }-as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }-as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }-as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }-if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :--else-  exitcode=1; echo positional parameters were not saved.-fi-test x\$exitcode = x0 || exit 1"-  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO-  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO-  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&-  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1-test \$(( 1 + 1 )) = 2 || exit 1"-  if (eval "$as_required") 2>/dev/null; then :-  as_have_required=yes-else-  as_have_required=no-fi-  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :--else-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-as_found=false-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  as_found=:-  case $as_dir in #(-	 /*)-	   for as_base in sh bash ksh sh5; do-	     # Try only shells that exist, to save several forks.-	     as_shell=$as_dir/$as_base-	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&-		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :-  CONFIG_SHELL=$as_shell as_have_required=yes-		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :-  break 2-fi-fi-	   done;;-       esac-  as_found=false-done-$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&-	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :-  CONFIG_SHELL=$SHELL as_have_required=yes-fi; }-IFS=$as_save_IFS---      if test "x$CONFIG_SHELL" != x; then :-  # We cannot yet assume a decent shell, so we have to provide a-	# neutralization value for shells without unset; and this also-	# works around shells that cannot unset nonexistent variables.-	# Preserve -v and -x to the replacement shell.-	BASH_ENV=/dev/null-	ENV=/dev/null-	(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV-	export CONFIG_SHELL-	case $- in # ((((-	  *v*x* | *x*v* ) as_opts=-vx ;;-	  *v* ) as_opts=-v ;;-	  *x* ) as_opts=-x ;;-	  * ) as_opts= ;;-	esac-	exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"}-fi--    if test x$as_have_required = xno; then :-  $as_echo "$0: This script requires a shell more modern than all"-  $as_echo "$0: the shells that I found on your system."-  if test x${ZSH_VERSION+set} = xset ; then-    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"-    $as_echo "$0: be upgraded to zsh 4.3.4 or later."-  else-    $as_echo "$0: Please tell bug-autoconf@gnu.org and-$0: sven.panne@aedion.de about your system, including any-$0: error possibly output before this message. Then install-$0: a modern shell, or manually run the script under such a-$0: shell if you do have one."-  fi-  exit 1-fi-fi-fi-SHELL=${CONFIG_SHELL-/bin/sh}-export SHELL-# Unset more variables known to interfere with behavior of common tools.-CLICOLOR_FORCE= GREP_OPTIONS=-unset CLICOLOR_FORCE GREP_OPTIONS--## --------------------- ##-## M4sh Shell Functions. ##-## --------------------- ##-# as_fn_unset VAR-# ----------------# Portably unset VAR.-as_fn_unset ()-{-  { eval $1=; unset $1;}-}-as_unset=as_fn_unset--# as_fn_set_status STATUS-# ------------------------# Set $? to STATUS, without forking.-as_fn_set_status ()-{-  return $1-} # as_fn_set_status--# as_fn_exit STATUS-# ------------------# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.-as_fn_exit ()-{-  set +e-  as_fn_set_status $1-  exit $1-} # as_fn_exit--# as_fn_mkdir_p-# --------------# Create "$as_dir" as a directory, including parents if necessary.-as_fn_mkdir_p ()-{--  case $as_dir in #(-  -*) as_dir=./$as_dir;;-  esac-  test -d "$as_dir" || eval $as_mkdir_p || {-    as_dirs=-    while :; do-      case $as_dir in #(-      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(-      *) as_qdir=$as_dir;;-      esac-      as_dirs="'$as_qdir' $as_dirs"-      as_dir=`$as_dirname -- "$as_dir" ||-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \-	 X"$as_dir" : 'X\(//\)[^/]' \| \-	 X"$as_dir" : 'X\(//\)$' \| \-	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_dir" |-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)[^/].*/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`-      test -d "$as_dir" && break-    done-    test -z "$as_dirs" || eval "mkdir $as_dirs"-  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"---} # as_fn_mkdir_p-# as_fn_append VAR VALUE-# -----------------------# Append the text in VALUE to the end of the definition contained in VAR. Take-# advantage of any shell optimizations that allow amortized linear growth over-# repeated appends, instead of the typical quadratic growth present in naive-# implementations.-if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :-  eval 'as_fn_append ()-  {-    eval $1+=\$2-  }'-else-  as_fn_append ()-  {-    eval $1=\$$1\$2-  }-fi # as_fn_append--# as_fn_arith ARG...-# -------------------# Perform arithmetic evaluation on the ARGs, and store the result in the-# global $as_val. Take advantage of shells that can avoid forks. The arguments-# must be portable across $(()) and expr.-if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :-  eval 'as_fn_arith ()-  {-    as_val=$(( $* ))-  }'-else-  as_fn_arith ()-  {-    as_val=`expr "$@" || test $? -eq 1`-  }-fi # as_fn_arith---# as_fn_error STATUS ERROR [LINENO LOG_FD]-# -----------------------------------------# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are-# provided, also output the error to LOG_FD, referencing LINENO. Then exit the-# script with STATUS, using 1 if that was 0.-as_fn_error ()-{-  as_status=$1; test $as_status -eq 0 && as_status=1-  if test "$4"; then-    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4-  fi-  $as_echo "$as_me: error: $2" >&2-  as_fn_exit $as_status-} # as_fn_error--if expr a : '\(a\)' >/dev/null 2>&1 &&-   test "X`expr 00001 : '.*\(...\)'`" = X001; then-  as_expr=expr-else-  as_expr=false-fi--if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then-  as_basename=basename-else-  as_basename=false-fi--if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then-  as_dirname=dirname-else-  as_dirname=false-fi--as_me=`$as_basename -- "$0" ||-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \-	 X"$0" : 'X\(//\)$' \| \-	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X/"$0" |-    sed '/^.*\/\([^/][^/]*\)\/*$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`--# Avoid depending upon Character Ranges.-as_cr_letters='abcdefghijklmnopqrstuvwxyz'-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'-as_cr_Letters=$as_cr_letters$as_cr_LETTERS-as_cr_digits='0123456789'-as_cr_alnum=$as_cr_Letters$as_cr_digits---  as_lineno_1=$LINENO as_lineno_1a=$LINENO-  as_lineno_2=$LINENO as_lineno_2a=$LINENO-  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&-  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {-  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)-  sed -n '-    p-    /[$]LINENO/=-  ' <$as_myself |-    sed '-      s/[$]LINENO.*/&-/-      t lineno-      b-      :lineno-      N-      :loop-      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/-      t loop-      s/-\n.*//-    ' >$as_me.lineno &&-  chmod +x "$as_me.lineno" ||-    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }--  # Don't try to exec as it changes $[0], causing all sort of problems-  # (the dirname of $[0] is not the place where we might find the-  # original and so on.  Autoconf is especially sensitive to this).-  . "./$as_me.lineno"-  # Exit status is that of the last command.-  exit-}--ECHO_C= ECHO_N= ECHO_T=-case `echo -n x` in #(((((--n*)-  case `echo 'xy\c'` in-  *c*) ECHO_T='	';;	# ECHO_T is single tab character.-  xy)  ECHO_C='\c';;-  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null-       ECHO_T='	';;-  esac;;-*)-  ECHO_N='-n';;-esac--rm -f conf$$ conf$$.exe conf$$.file-if test -d conf$$.dir; then-  rm -f conf$$.dir/conf$$.file-else-  rm -f conf$$.dir-  mkdir conf$$.dir 2>/dev/null-fi-if (echo >conf$$.file) 2>/dev/null; then-  if ln -s conf$$.file conf$$ 2>/dev/null; then-    as_ln_s='ln -s'-    # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -p'.-    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||-      as_ln_s='cp -p'-  elif ln conf$$.file conf$$ 2>/dev/null; then-    as_ln_s=ln-  else-    as_ln_s='cp -p'-  fi-else-  as_ln_s='cp -p'-fi-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file-rmdir conf$$.dir 2>/dev/null--if mkdir -p . 2>/dev/null; then-  as_mkdir_p='mkdir -p "$as_dir"'-else-  test -d ./-p && rmdir ./-p-  as_mkdir_p=false-fi--if test -x / >/dev/null 2>&1; then-  as_test_x='test -x'-else-  if ls -dL / >/dev/null 2>&1; then-    as_ls_L_option=L-  else-    as_ls_L_option=-  fi-  as_test_x='-    eval sh -c '\''-      if test -d "$1"; then-	test -d "$1/.";-      else-	case $1 in #(-	-*)set "./$1";;-	esac;-	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((-	???[sx]*):;;*)false;;esac;fi-    '\'' sh-  '-fi-as_executable_p=$as_test_x--# Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"--# Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"---test -n "$DJDIR" || exec 7<&0 </dev/null-exec 6>&1--# Name of the host.-# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,-# so uname gets run too.-ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`--#-# Initializations.-#-ac_default_prefix=/usr/local-ac_clean_files=-ac_config_libobj_dir=.-LIBOBJS=-cross_compiling=no-subdirs=-MFLAGS=-MAKEFLAGS=--# Identity of this package.-PACKAGE_NAME='Haskell OpenGL package'-PACKAGE_TARNAME='OpenGL'-PACKAGE_VERSION='2.2.3.0'-PACKAGE_STRING='Haskell OpenGL package 2.2.3.0'-PACKAGE_BUGREPORT='sven.panne@aedion.de'-PACKAGE_URL=''--ac_unique_file="include/HsOpenGL.h.in"-# Factoring default headers for most tests.-ac_includes_default="\-#include <stdio.h>-#ifdef HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif-#ifdef HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif-#ifdef STDC_HEADERS-# include <stdlib.h>-# include <stddef.h>-#else-# ifdef HAVE_STDLIB_H-#  include <stdlib.h>-# endif-#endif-#ifdef HAVE_STRING_H-# if !defined STDC_HEADERS && defined HAVE_MEMORY_H-#  include <memory.h>-# endif-# include <string.h>-#endif-#ifdef HAVE_STRINGS_H-# include <strings.h>-#endif-#ifdef HAVE_INTTYPES_H-# include <inttypes.h>-#endif-#ifdef HAVE_STDINT_H-# include <stdint.h>-#endif-#ifdef HAVE_UNISTD_H-# include <unistd.h>-#endif"--ac_subst_vars='LTLIBOBJS-LIBOBJS-CALLCONV-BUILD_PACKAGE_BOOL-EGREP-GREP-GLU_LIBS-GLU_CFLAGS-GL_LIBS-GL_CFLAGS-GLUT_FRAMEWORKS-GLU_FRAMEWORKS-target_os-target_vendor-target_cpu-target-host_os-host_vendor-host_cpu-host-build_os-build_vendor-build_cpu-build-X_EXTRA_LIBS-X_LIBS-X_PRE_LIBS-X_CFLAGS-CPP-XMKMF-OBJEXT-EXEEXT-ac_ct_CC-CPPFLAGS-LDFLAGS-CFLAGS-CC-target_alias-host_alias-build_alias-LIBS-ECHO_T-ECHO_N-ECHO_C-DEFS-mandir-localedir-libdir-psdir-pdfdir-dvidir-htmldir-infodir-docdir-oldincludedir-includedir-localstatedir-sharedstatedir-sysconfdir-datadir-datarootdir-libexecdir-sbindir-bindir-program_transform_name-prefix-exec_prefix-PACKAGE_URL-PACKAGE_BUGREPORT-PACKAGE_STRING-PACKAGE_VERSION-PACKAGE_TARNAME-PACKAGE_NAME-PATH_SEPARATOR-SHELL'-ac_subst_files=''-ac_user_opts='-enable_option_checking-with_compiler-enable_opengl-with_x-'-      ac_precious_vars='build_alias-host_alias-target_alias-CC-CFLAGS-LDFLAGS-LIBS-CPPFLAGS-XMKMF-CPP-CPPFLAGS'---# Initialize some variables set by options.-ac_init_help=-ac_init_version=false-ac_unrecognized_opts=-ac_unrecognized_sep=-# The variables have the same names as the options, with-# dashes changed to underlines.-cache_file=/dev/null-exec_prefix=NONE-no_create=-no_recursion=-prefix=NONE-program_prefix=NONE-program_suffix=NONE-program_transform_name=s,x,x,-silent=-site=-srcdir=-verbose=-x_includes=NONE-x_libraries=NONE--# Installation directory options.-# These are left unexpanded so users can "make install exec_prefix=/foo"-# and all the variables that are supposed to be based on exec_prefix-# by default will actually change.-# Use braces instead of parens because sh, perl, etc. also accept them.-# (The list follows the same order as the GNU Coding Standards.)-bindir='${exec_prefix}/bin'-sbindir='${exec_prefix}/sbin'-libexecdir='${exec_prefix}/libexec'-datarootdir='${prefix}/share'-datadir='${datarootdir}'-sysconfdir='${prefix}/etc'-sharedstatedir='${prefix}/com'-localstatedir='${prefix}/var'-includedir='${prefix}/include'-oldincludedir='/usr/include'-docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'-infodir='${datarootdir}/info'-htmldir='${docdir}'-dvidir='${docdir}'-pdfdir='${docdir}'-psdir='${docdir}'-libdir='${exec_prefix}/lib'-localedir='${datarootdir}/locale'-mandir='${datarootdir}/man'--ac_prev=-ac_dashdash=-for ac_option-do-  # If the previous option needs an argument, assign it.-  if test -n "$ac_prev"; then-    eval $ac_prev=\$ac_option-    ac_prev=-    continue-  fi--  case $ac_option in-  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;-  *=)   ac_optarg= ;;-  *)    ac_optarg=yes ;;-  esac--  # Accept the important Cygnus configure options, so we can diagnose typos.--  case $ac_dashdash$ac_option in-  --)-    ac_dashdash=yes ;;--  -bindir | --bindir | --bindi | --bind | --bin | --bi)-    ac_prev=bindir ;;-  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)-    bindir=$ac_optarg ;;--  -build | --build | --buil | --bui | --bu)-    ac_prev=build_alias ;;-  -build=* | --build=* | --buil=* | --bui=* | --bu=*)-    build_alias=$ac_optarg ;;--  -cache-file | --cache-file | --cache-fil | --cache-fi \-  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)-    ac_prev=cache_file ;;-  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \-  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)-    cache_file=$ac_optarg ;;--  --config-cache | -C)-    cache_file=config.cache ;;--  -datadir | --datadir | --datadi | --datad)-    ac_prev=datadir ;;-  -datadir=* | --datadir=* | --datadi=* | --datad=*)-    datadir=$ac_optarg ;;--  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \-  | --dataroo | --dataro | --datar)-    ac_prev=datarootdir ;;-  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \-  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)-    datarootdir=$ac_optarg ;;--  -disable-* | --disable-*)-    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid feature name: $ac_useropt"-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"enable_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval enable_$ac_useropt=no ;;--  -docdir | --docdir | --docdi | --doc | --do)-    ac_prev=docdir ;;-  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)-    docdir=$ac_optarg ;;--  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)-    ac_prev=dvidir ;;-  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)-    dvidir=$ac_optarg ;;--  -enable-* | --enable-*)-    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid feature name: $ac_useropt"-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"enable_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval enable_$ac_useropt=\$ac_optarg ;;--  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \-  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \-  | --exec | --exe | --ex)-    ac_prev=exec_prefix ;;-  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \-  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \-  | --exec=* | --exe=* | --ex=*)-    exec_prefix=$ac_optarg ;;--  -gas | --gas | --ga | --g)-    # Obsolete; use --with-gas.-    with_gas=yes ;;--  -help | --help | --hel | --he | -h)-    ac_init_help=long ;;-  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)-    ac_init_help=recursive ;;-  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)-    ac_init_help=short ;;--  -host | --host | --hos | --ho)-    ac_prev=host_alias ;;-  -host=* | --host=* | --hos=* | --ho=*)-    host_alias=$ac_optarg ;;--  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)-    ac_prev=htmldir ;;-  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \-  | --ht=*)-    htmldir=$ac_optarg ;;--  -includedir | --includedir | --includedi | --included | --include \-  | --includ | --inclu | --incl | --inc)-    ac_prev=includedir ;;-  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \-  | --includ=* | --inclu=* | --incl=* | --inc=*)-    includedir=$ac_optarg ;;--  -infodir | --infodir | --infodi | --infod | --info | --inf)-    ac_prev=infodir ;;-  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)-    infodir=$ac_optarg ;;--  -libdir | --libdir | --libdi | --libd)-    ac_prev=libdir ;;-  -libdir=* | --libdir=* | --libdi=* | --libd=*)-    libdir=$ac_optarg ;;--  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \-  | --libexe | --libex | --libe)-    ac_prev=libexecdir ;;-  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \-  | --libexe=* | --libex=* | --libe=*)-    libexecdir=$ac_optarg ;;--  -localedir | --localedir | --localedi | --localed | --locale)-    ac_prev=localedir ;;-  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)-    localedir=$ac_optarg ;;--  -localstatedir | --localstatedir | --localstatedi | --localstated \-  | --localstate | --localstat | --localsta | --localst | --locals)-    ac_prev=localstatedir ;;-  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \-  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)-    localstatedir=$ac_optarg ;;--  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)-    ac_prev=mandir ;;-  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)-    mandir=$ac_optarg ;;--  -nfp | --nfp | --nf)-    # Obsolete; use --without-fp.-    with_fp=no ;;--  -no-create | --no-create | --no-creat | --no-crea | --no-cre \-  | --no-cr | --no-c | -n)-    no_create=yes ;;--  -no-recursion | --no-recursion | --no-recursio | --no-recursi \-  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)-    no_recursion=yes ;;--  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \-  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \-  | --oldin | --oldi | --old | --ol | --o)-    ac_prev=oldincludedir ;;-  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \-  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \-  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)-    oldincludedir=$ac_optarg ;;--  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)-    ac_prev=prefix ;;-  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)-    prefix=$ac_optarg ;;--  -program-prefix | --program-prefix | --program-prefi | --program-pref \-  | --program-pre | --program-pr | --program-p)-    ac_prev=program_prefix ;;-  -program-prefix=* | --program-prefix=* | --program-prefi=* \-  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)-    program_prefix=$ac_optarg ;;--  -program-suffix | --program-suffix | --program-suffi | --program-suff \-  | --program-suf | --program-su | --program-s)-    ac_prev=program_suffix ;;-  -program-suffix=* | --program-suffix=* | --program-suffi=* \-  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)-    program_suffix=$ac_optarg ;;--  -program-transform-name | --program-transform-name \-  | --program-transform-nam | --program-transform-na \-  | --program-transform-n | --program-transform- \-  | --program-transform | --program-transfor \-  | --program-transfo | --program-transf \-  | --program-trans | --program-tran \-  | --progr-tra | --program-tr | --program-t)-    ac_prev=program_transform_name ;;-  -program-transform-name=* | --program-transform-name=* \-  | --program-transform-nam=* | --program-transform-na=* \-  | --program-transform-n=* | --program-transform-=* \-  | --program-transform=* | --program-transfor=* \-  | --program-transfo=* | --program-transf=* \-  | --program-trans=* | --program-tran=* \-  | --progr-tra=* | --program-tr=* | --program-t=*)-    program_transform_name=$ac_optarg ;;--  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)-    ac_prev=pdfdir ;;-  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)-    pdfdir=$ac_optarg ;;--  -psdir | --psdir | --psdi | --psd | --ps)-    ac_prev=psdir ;;-  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)-    psdir=$ac_optarg ;;--  -q | -quiet | --quiet | --quie | --qui | --qu | --q \-  | -silent | --silent | --silen | --sile | --sil)-    silent=yes ;;--  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)-    ac_prev=sbindir ;;-  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \-  | --sbi=* | --sb=*)-    sbindir=$ac_optarg ;;--  -sharedstatedir | --sharedstatedir | --sharedstatedi \-  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \-  | --sharedst | --shareds | --shared | --share | --shar \-  | --sha | --sh)-    ac_prev=sharedstatedir ;;-  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \-  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \-  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \-  | --sha=* | --sh=*)-    sharedstatedir=$ac_optarg ;;--  -site | --site | --sit)-    ac_prev=site ;;-  -site=* | --site=* | --sit=*)-    site=$ac_optarg ;;--  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)-    ac_prev=srcdir ;;-  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)-    srcdir=$ac_optarg ;;--  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \-  | --syscon | --sysco | --sysc | --sys | --sy)-    ac_prev=sysconfdir ;;-  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \-  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)-    sysconfdir=$ac_optarg ;;--  -target | --target | --targe | --targ | --tar | --ta | --t)-    ac_prev=target_alias ;;-  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)-    target_alias=$ac_optarg ;;--  -v | -verbose | --verbose | --verbos | --verbo | --verb)-    verbose=yes ;;--  -version | --version | --versio | --versi | --vers | -V)-    ac_init_version=: ;;--  -with-* | --with-*)-    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid package name: $ac_useropt"-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"with_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval with_$ac_useropt=\$ac_optarg ;;--  -without-* | --without-*)-    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid package name: $ac_useropt"-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"with_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval with_$ac_useropt=no ;;--  --x)-    # Obsolete; use --with-x.-    with_x=yes ;;--  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \-  | --x-incl | --x-inc | --x-in | --x-i)-    ac_prev=x_includes ;;-  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \-  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)-    x_includes=$ac_optarg ;;--  -x-libraries | --x-libraries | --x-librarie | --x-librari \-  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)-    ac_prev=x_libraries ;;-  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \-  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)-    x_libraries=$ac_optarg ;;--  -*) as_fn_error $? "unrecognized option: \`$ac_option'-Try \`$0 --help' for more information"-    ;;--  *=*)-    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`-    # Reject names that are not valid shell variable names.-    case $ac_envvar in #(-      '' | [0-9]* | *[!_$as_cr_alnum]* )-      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;-    esac-    eval $ac_envvar=\$ac_optarg-    export $ac_envvar ;;--  *)-    # FIXME: should be removed in autoconf 3.0.-    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2-    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&-      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2-    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"-    ;;--  esac-done--if test -n "$ac_prev"; then-  ac_option=--`echo $ac_prev | sed 's/_/-/g'`-  as_fn_error $? "missing argument to $ac_option"-fi--if test -n "$ac_unrecognized_opts"; then-  case $enable_option_checking in-    no) ;;-    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;-    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;-  esac-fi--# Check all directory arguments for consistency.-for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \-		datadir sysconfdir sharedstatedir localstatedir includedir \-		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \-		libdir localedir mandir-do-  eval ac_val=\$$ac_var-  # Remove trailing slashes.-  case $ac_val in-    */ )-      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`-      eval $ac_var=\$ac_val;;-  esac-  # Be sure to have absolute directory names.-  case $ac_val in-    [\\/$]* | ?:[\\/]* )  continue;;-    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;-  esac-  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"-done--# There might be people who depend on the old broken behavior: `$host'-# used to hold the argument of --host etc.-# FIXME: To remove some day.-build=$build_alias-host=$host_alias-target=$target_alias--# FIXME: To remove some day.-if test "x$host_alias" != x; then-  if test "x$build_alias" = x; then-    cross_compiling=maybe-    $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.-    If a cross compiler is detected then cross compile mode will be used" >&2-  elif test "x$build_alias" != "x$host_alias"; then-    cross_compiling=yes-  fi-fi--ac_tool_prefix=-test -n "$host_alias" && ac_tool_prefix=$host_alias---test "$silent" = yes && exec 6>/dev/null---ac_pwd=`pwd` && test -n "$ac_pwd" &&-ac_ls_di=`ls -di .` &&-ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||-  as_fn_error $? "working directory cannot be determined"-test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||-  as_fn_error $? "pwd does not report name of working directory"---# Find the source files, if location was not specified.-if test -z "$srcdir"; then-  ac_srcdir_defaulted=yes-  # Try the directory containing this script, then the parent directory.-  ac_confdir=`$as_dirname -- "$as_myself" ||-$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \-	 X"$as_myself" : 'X\(//\)[^/]' \| \-	 X"$as_myself" : 'X\(//\)$' \| \-	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_myself" |-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)[^/].*/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`-  srcdir=$ac_confdir-  if test ! -r "$srcdir/$ac_unique_file"; then-    srcdir=..-  fi-else-  ac_srcdir_defaulted=no-fi-if test ! -r "$srcdir/$ac_unique_file"; then-  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."-  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"-fi-ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"-ac_abs_confdir=`(-	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"-	pwd)`-# When building in place, set srcdir=.-if test "$ac_abs_confdir" = "$ac_pwd"; then-  srcdir=.-fi-# Remove unnecessary trailing slashes from srcdir.-# Double slashes in file names in object file debugging info-# mess up M-x gdb in Emacs.-case $srcdir in-*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;-esac-for ac_var in $ac_precious_vars; do-  eval ac_env_${ac_var}_set=\${${ac_var}+set}-  eval ac_env_${ac_var}_value=\$${ac_var}-  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}-  eval ac_cv_env_${ac_var}_value=\$${ac_var}-done--#-# Report the --help message.-#-if test "$ac_init_help" = "long"; then-  # Omit some internal or obsolete options to make the list less imposing.-  # This message is too long to be a string in the A/UX 3.1 sh.-  cat <<_ACEOF-\`configure' configures Haskell OpenGL package 2.2.3.0 to adapt to many kinds of systems.--Usage: $0 [OPTION]... [VAR=VALUE]...--To assign environment variables (e.g., CC, CFLAGS...), specify them as-VAR=VALUE.  See below for descriptions of some of the useful variables.--Defaults for the options are specified in brackets.--Configuration:-  -h, --help              display this help and exit-      --help=short        display options specific to this package-      --help=recursive    display the short help of all the included packages-  -V, --version           display version information and exit-  -q, --quiet, --silent   do not print \`checking ...' messages-      --cache-file=FILE   cache test results in FILE [disabled]-  -C, --config-cache      alias for \`--cache-file=config.cache'-  -n, --no-create         do not create output files-      --srcdir=DIR        find the sources in DIR [configure dir or \`..']--Installation directories:-  --prefix=PREFIX         install architecture-independent files in PREFIX-                          [$ac_default_prefix]-  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX-                          [PREFIX]--By default, \`make install' will install all the files in-\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify-an installation prefix other than \`$ac_default_prefix' using \`--prefix',-for instance \`--prefix=\$HOME'.--For better control, use the options below.--Fine tuning of the installation directories:-  --bindir=DIR            user executables [EPREFIX/bin]-  --sbindir=DIR           system admin executables [EPREFIX/sbin]-  --libexecdir=DIR        program executables [EPREFIX/libexec]-  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]-  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]-  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]-  --libdir=DIR            object code libraries [EPREFIX/lib]-  --includedir=DIR        C header files [PREFIX/include]-  --oldincludedir=DIR     C header files for non-gcc [/usr/include]-  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]-  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]-  --infodir=DIR           info documentation [DATAROOTDIR/info]-  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]-  --mandir=DIR            man documentation [DATAROOTDIR/man]-  --docdir=DIR            documentation root [DATAROOTDIR/doc/OpenGL]-  --htmldir=DIR           html documentation [DOCDIR]-  --dvidir=DIR            dvi documentation [DOCDIR]-  --pdfdir=DIR            pdf documentation [DOCDIR]-  --psdir=DIR             ps documentation [DOCDIR]-_ACEOF--  cat <<\_ACEOF--X features:-  --x-includes=DIR    X include files are in DIR-  --x-libraries=DIR   X library files are in DIR--System types:-  --build=BUILD     configure for building on BUILD [guessed]-  --host=HOST       cross-compile to build programs to run on HOST [BUILD]-  --target=TARGET   configure for building compilers for TARGET [HOST]-_ACEOF-fi--if test -n "$ac_init_help"; then-  case $ac_init_help in-     short | recursive ) echo "Configuration of Haskell OpenGL package 2.2.3.0:";;-   esac-  cat <<\_ACEOF--Optional Features:-  --disable-option-checking  ignore unrecognized --enable/--with options-  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)-  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]-  --enable-opengl         build a Haskell binding for OpenGL (GL/GLU). On Mac-                          OS X, use --enable-opengl=x11 to use X11 instead of-                          the "native" libraries. (default=autodetect)--Optional Packages:-  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]-  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)-  --with-compiler[=HC]    use the given Haskell compiler (default=ghc)-  --with-x                use the X Window System--Some influential environment variables:-  CC          C compiler command-  CFLAGS      C compiler flags-  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a-              nonstandard directory <lib dir>-  LIBS        libraries to pass to the linker, e.g. -l<library>-  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if-              you have headers in a nonstandard directory <include dir>-  XMKMF       Path to xmkmf, Makefile generator for X Window System-  CPP         C preprocessor--Use these variables to override the choices made by `configure' or to help-it to find libraries and programs with nonstandard names/locations.--Report bugs to <sven.panne@aedion.de>.-_ACEOF-ac_status=$?-fi--if test "$ac_init_help" = "recursive"; then-  # If there are subdirs, report their specific --help.-  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue-    test -d "$ac_dir" ||-      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||-      continue-    ac_builddir=.--case "$ac_dir" in-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;-*)-  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`-  # A ".." for each directory in $ac_dir_suffix.-  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`-  case $ac_top_builddir_sub in-  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;-  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;-  esac ;;-esac-ac_abs_top_builddir=$ac_pwd-ac_abs_builddir=$ac_pwd$ac_dir_suffix-# for backward compatibility:-ac_top_builddir=$ac_top_build_prefix--case $srcdir in-  .)  # We are building in place.-    ac_srcdir=.-    ac_top_srcdir=$ac_top_builddir_sub-    ac_abs_top_srcdir=$ac_pwd ;;-  [\\/]* | ?:[\\/]* )  # Absolute name.-    ac_srcdir=$srcdir$ac_dir_suffix;-    ac_top_srcdir=$srcdir-    ac_abs_top_srcdir=$srcdir ;;-  *) # Relative name.-    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix-    ac_top_srcdir=$ac_top_build_prefix$srcdir-    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;-esac-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix--    cd "$ac_dir" || { ac_status=$?; continue; }-    # Check for guested configure.-    if test -f "$ac_srcdir/configure.gnu"; then-      echo &&-      $SHELL "$ac_srcdir/configure.gnu" --help=recursive-    elif test -f "$ac_srcdir/configure"; then-      echo &&-      $SHELL "$ac_srcdir/configure" --help=recursive-    else-      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2-    fi || ac_status=$?-    cd "$ac_pwd" || { ac_status=$?; break; }-  done-fi--test -n "$ac_init_help" && exit $ac_status-if $ac_init_version; then-  cat <<\_ACEOF-Haskell OpenGL package configure 2.2.3.0-generated by GNU Autoconf 2.68--Copyright (C) 2010 Free Software Foundation, Inc.-This configure script is free software; the Free Software Foundation-gives unlimited permission to copy, distribute and modify it.-_ACEOF-  exit-fi--## ------------------------ ##-## Autoconf initialization. ##-## ------------------------ ##--# ac_fn_c_try_compile LINENO-# ---------------------------# Try to compile conftest.$ac_ext, and return whether this succeeded.-ac_fn_c_try_compile ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  rm -f conftest.$ac_objext-  if { { ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_compile") 2>conftest.err-  ac_status=$?-  if test -s conftest.err; then-    grep -v '^ *+' conftest.err >conftest.er1-    cat conftest.er1 >&5-    mv -f conftest.er1 conftest.err-  fi-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then :-  ac_retval=0-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_retval=1-fi-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno-  as_fn_set_status $ac_retval--} # ac_fn_c_try_compile--# ac_fn_c_try_cpp LINENO-# -----------------------# Try to preprocess conftest.$ac_ext, and return whether this succeeded.-ac_fn_c_try_cpp ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  if { { ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err-  ac_status=$?-  if test -s conftest.err; then-    grep -v '^ *+' conftest.err >conftest.er1-    cat conftest.er1 >&5-    mv -f conftest.er1 conftest.err-  fi-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; } > conftest.i && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then :-  ac_retval=0-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--    ac_retval=1-fi-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno-  as_fn_set_status $ac_retval--} # ac_fn_c_try_cpp--# ac_fn_c_try_link LINENO-# ------------------------# Try to link conftest.$ac_ext, and return whether this succeeded.-ac_fn_c_try_link ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  rm -f conftest.$ac_objext conftest$ac_exeext-  if { { ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_link") 2>conftest.err-  ac_status=$?-  if test -s conftest.err; then-    grep -v '^ *+' conftest.err >conftest.er1-    cat conftest.er1 >&5-    mv -f conftest.er1 conftest.err-  fi-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then :-  ac_retval=0-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_retval=1-fi-  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information-  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would-  # interfere with the next link command; also delete a directory that is-  # left behind by Apple's compiler.  We do this before executing the actions.-  rm -rf conftest.dSYM conftest_ipa8_conftest.oo-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno-  as_fn_set_status $ac_retval--} # ac_fn_c_try_link--# ac_fn_c_check_func LINENO FUNC VAR-# -----------------------------------# Tests whether FUNC exists, setting the cache variable VAR accordingly-ac_fn_c_check_func ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5-$as_echo_n "checking for $2... " >&6; }-if eval \${$3+:} false; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-/* Define $2 to an innocuous variant, in case <limits.h> declares $2.-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */-#define $2 innocuous_$2--/* System header to define __stub macros and hopefully few prototypes,-    which can conflict with char $2 (); below.-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-    <limits.h> exists even on freestanding compilers.  */--#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif--#undef $2--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char $2 ();-/* The GNU C library defines this for functions which it implements-    to always fail with ENOSYS.  Some functions are actually named-    something starting with __ and the normal name is an alias.  */-#if defined __stub_$2 || defined __stub___$2-choke me-#endif--int-main ()-{-return $2 ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  eval "$3=yes"-else-  eval "$3=no"-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-fi-eval ac_res=\$$3-	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno--} # ac_fn_c_check_func--# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES-# --------------------------------------------------------# Tests whether HEADER exists, giving a warning if it cannot be compiled using-# the include files in INCLUDES and setting the cache variable VAR-# accordingly.-ac_fn_c_check_header_mongrel ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  if eval \${$3+:} false; then :-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5-$as_echo_n "checking for $2... " >&6; }-if eval \${$3+:} false; then :-  $as_echo_n "(cached) " >&6-fi-eval ac_res=\$$3-	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-else-  # Is the header compilable?-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5-$as_echo_n "checking $2 usability... " >&6; }-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-$4-#include <$2>-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_header_compiler=yes-else-  ac_header_compiler=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5-$as_echo "$ac_header_compiler" >&6; }--# Is the header present?-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5-$as_echo_n "checking $2 presence... " >&6; }-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <$2>-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :-  ac_header_preproc=yes-else-  ac_header_preproc=no-fi-rm -f conftest.err conftest.i conftest.$ac_ext-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5-$as_echo "$ac_header_preproc" >&6; }--# So?  What about this header?-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((-  yes:no: )-    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5-$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}-    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5-$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}-    ;;-  no:yes:* )-    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5-$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}-    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5-$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}-    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5-$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}-    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5-$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}-    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5-$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}-( $as_echo "## ----------------------------------- ##-## Report this to sven.panne@aedion.de ##-## ----------------------------------- ##"-     ) | sed "s/^/$as_me: WARNING:     /" >&2-    ;;-esac-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5-$as_echo_n "checking for $2... " >&6; }-if eval \${$3+:} false; then :-  $as_echo_n "(cached) " >&6-else-  eval "$3=\$ac_header_compiler"-fi-eval ac_res=\$$3-	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-fi-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno--} # ac_fn_c_check_header_mongrel--# ac_fn_c_try_run LINENO-# -----------------------# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes-# that executables *can* be run.-ac_fn_c_try_run ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  if { { ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_link") 2>&5-  ac_status=$?-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'-  { { case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_try") 2>&5-  ac_status=$?-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; }; }; then :-  ac_retval=0-else-  $as_echo "$as_me: program exited with status $ac_status" >&5-       $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--       ac_retval=$ac_status-fi-  rm -rf conftest.dSYM conftest_ipa8_conftest.oo-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno-  as_fn_set_status $ac_retval--} # ac_fn_c_try_run--# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES-# --------------------------------------------------------# Tests whether HEADER exists and can be compiled using the include files in-# INCLUDES, setting the cache variable VAR accordingly.-ac_fn_c_check_header_compile ()-{-  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5-$as_echo_n "checking for $2... " >&6; }-if eval \${$3+:} false; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-$4-#include <$2>-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  eval "$3=yes"-else-  eval "$3=no"-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-eval ac_res=\$$3-	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno--} # ac_fn_c_check_header_compile-cat >config.log <<_ACEOF-This file contains any messages produced by compilers while-running configure, to aid debugging if configure makes a mistake.--It was created by Haskell OpenGL package $as_me 2.2.3.0, which was-generated by GNU Autoconf 2.68.  Invocation command line was--  $ $0 $@--_ACEOF-exec 5>>config.log-{-cat <<_ASUNAME-## --------- ##-## Platform. ##-## --------- ##--hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`-uname -m = `(uname -m) 2>/dev/null || echo unknown`-uname -r = `(uname -r) 2>/dev/null || echo unknown`-uname -s = `(uname -s) 2>/dev/null || echo unknown`-uname -v = `(uname -v) 2>/dev/null || echo unknown`--/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`-/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`--/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`-/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`-/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`-/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`-/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`-/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`--_ASUNAME--as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    $as_echo "PATH: $as_dir"-  done-IFS=$as_save_IFS--} >&5--cat >&5 <<_ACEOF---## ----------- ##-## Core tests. ##-## ----------- ##--_ACEOF---# Keep a trace of the command line.-# Strip out --no-create and --no-recursion so they do not pile up.-# Strip out --silent because we don't want to record it for future runs.-# Also quote any args containing shell meta-characters.-# Make two passes to allow for proper duplicate-argument suppression.-ac_configure_args=-ac_configure_args0=-ac_configure_args1=-ac_must_keep_next=false-for ac_pass in 1 2-do-  for ac_arg-  do-    case $ac_arg in-    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;-    -q | -quiet | --quiet | --quie | --qui | --qu | --q \-    | -silent | --silent | --silen | --sile | --sil)-      continue ;;-    *\'*)-      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;-    esac-    case $ac_pass in-    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;-    2)-      as_fn_append ac_configure_args1 " '$ac_arg'"-      if test $ac_must_keep_next = true; then-	ac_must_keep_next=false # Got value, back to normal.-      else-	case $ac_arg in-	  *=* | --config-cache | -C | -disable-* | --disable-* \-	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \-	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \-	  | -with-* | --with-* | -without-* | --without-* | --x)-	    case "$ac_configure_args0 " in-	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;-	    esac-	    ;;-	  -* ) ac_must_keep_next=true ;;-	esac-      fi-      as_fn_append ac_configure_args " '$ac_arg'"-      ;;-    esac-  done-done-{ ac_configure_args0=; unset ac_configure_args0;}-{ ac_configure_args1=; unset ac_configure_args1;}--# When interrupted or exit'd, cleanup temporary files, and complete-# config.log.  We remove comments because anyway the quotes in there-# would cause problems or look ugly.-# WARNING: Use '\'' to represent an apostrophe within the trap.-# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.-trap 'exit_status=$?-  # Save into config.log some information that might help in debugging.-  {-    echo--    $as_echo "## ---------------- ##-## Cache variables. ##-## ---------------- ##"-    echo-    # The following way of writing the cache mishandles newlines in values,-(-  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do-    eval ac_val=\$$ac_var-    case $ac_val in #(-    *${as_nl}*)-      case $ac_var in #(-      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;-      esac-      case $ac_var in #(-      _ | IFS | as_nl) ;; #(-      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(-      *) { eval $ac_var=; unset $ac_var;} ;;-      esac ;;-    esac-  done-  (set) 2>&1 |-    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(-    *${as_nl}ac_space=\ *)-      sed -n \-	"s/'\''/'\''\\\\'\'''\''/g;-	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"-      ;; #(-    *)-      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"-      ;;-    esac |-    sort-)-    echo--    $as_echo "## ----------------- ##-## Output variables. ##-## ----------------- ##"-    echo-    for ac_var in $ac_subst_vars-    do-      eval ac_val=\$$ac_var-      case $ac_val in-      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;-      esac-      $as_echo "$ac_var='\''$ac_val'\''"-    done | sort-    echo--    if test -n "$ac_subst_files"; then-      $as_echo "## ------------------- ##-## File substitutions. ##-## ------------------- ##"-      echo-      for ac_var in $ac_subst_files-      do-	eval ac_val=\$$ac_var-	case $ac_val in-	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;-	esac-	$as_echo "$ac_var='\''$ac_val'\''"-      done | sort-      echo-    fi--    if test -s confdefs.h; then-      $as_echo "## ----------- ##-## confdefs.h. ##-## ----------- ##"-      echo-      cat confdefs.h-      echo-    fi-    test "$ac_signal" != 0 &&-      $as_echo "$as_me: caught signal $ac_signal"-    $as_echo "$as_me: exit $exit_status"-  } >&5-  rm -f core *.core core.conftest.* &&-    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&-    exit $exit_status-' 0-for ac_signal in 1 2 13 15; do-  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal-done-ac_signal=0--# confdefs.h avoids OS command line length limits that DEFS can exceed.-rm -f -r conftest* confdefs.h--$as_echo "/* confdefs.h */" > confdefs.h--# Predefined preprocessor variables.--cat >>confdefs.h <<_ACEOF-#define PACKAGE_NAME "$PACKAGE_NAME"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_TARNAME "$PACKAGE_TARNAME"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_VERSION "$PACKAGE_VERSION"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_STRING "$PACKAGE_STRING"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_URL "$PACKAGE_URL"-_ACEOF---# Let the site file select an alternate cache file if it wants to.-# Prefer an explicitly selected file to automatically selected ones.-ac_site_file1=NONE-ac_site_file2=NONE-if test -n "$CONFIG_SITE"; then-  # We do not want a PATH search for config.site.-  case $CONFIG_SITE in #((-    -*)  ac_site_file1=./$CONFIG_SITE;;-    */*) ac_site_file1=$CONFIG_SITE;;-    *)   ac_site_file1=./$CONFIG_SITE;;-  esac-elif test "x$prefix" != xNONE; then-  ac_site_file1=$prefix/share/config.site-  ac_site_file2=$prefix/etc/config.site-else-  ac_site_file1=$ac_default_prefix/share/config.site-  ac_site_file2=$ac_default_prefix/etc/config.site-fi-for ac_site_file in "$ac_site_file1" "$ac_site_file2"-do-  test "x$ac_site_file" = xNONE && continue-  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then-    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5-$as_echo "$as_me: loading site script $ac_site_file" >&6;}-    sed 's/^/| /' "$ac_site_file" >&5-    . "$ac_site_file" \-      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "failed to load site script $ac_site_file-See \`config.log' for more details" "$LINENO" 5; }-  fi-done--if test -r "$cache_file"; then-  # Some versions of bash will fail to source /dev/null (special files-  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.-  if test /dev/null != "$cache_file" && test -f "$cache_file"; then-    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5-$as_echo "$as_me: loading cache $cache_file" >&6;}-    case $cache_file in-      [\\/]* | ?:[\\/]* ) . "$cache_file";;-      *)                      . "./$cache_file";;-    esac-  fi-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5-$as_echo "$as_me: creating cache $cache_file" >&6;}-  >$cache_file-fi--# Check that the precious variables saved in the cache have kept the same-# value.-ac_cache_corrupted=false-for ac_var in $ac_precious_vars; do-  eval ac_old_set=\$ac_cv_env_${ac_var}_set-  eval ac_new_set=\$ac_env_${ac_var}_set-  eval ac_old_val=\$ac_cv_env_${ac_var}_value-  eval ac_new_val=\$ac_env_${ac_var}_value-  case $ac_old_set,$ac_new_set in-    set,)-      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5-$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}-      ac_cache_corrupted=: ;;-    ,set)-      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5-$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}-      ac_cache_corrupted=: ;;-    ,);;-    *)-      if test "x$ac_old_val" != "x$ac_new_val"; then-	# differences in whitespace do not lead to failure.-	ac_old_val_w=`echo x $ac_old_val`-	ac_new_val_w=`echo x $ac_new_val`-	if test "$ac_old_val_w" != "$ac_new_val_w"; then-	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5-$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}-	  ac_cache_corrupted=:-	else-	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5-$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}-	  eval $ac_var=\$ac_old_val-	fi-	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5-$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}-	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5-$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}-      fi;;-  esac-  # Pass precious variables to config.status.-  if test "$ac_new_set" = set; then-    case $ac_new_val in-    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;-    *) ac_arg=$ac_var=$ac_new_val ;;-    esac-    case " $ac_configure_args " in-      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.-      *) as_fn_append ac_configure_args " '$ac_arg'" ;;-    esac-  fi-done-if $ac_cache_corrupted; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5-$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}-  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5-fi-## -------------------- ##-## Main body of script. ##-## -------------------- ##--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu----# Safety check: Ensure that we are in the correct source directory.---# The first file mentioned below will be generated by autoheader and contains-# defines which are needed during package build time only. The second header-# contains all kinds of stuff which is needed for using this package.-ac_config_headers="$ac_config_headers include/HsOpenGLConfig.h include/HsOpenGL.h"---# we do not really care about this here, but this avoids a warning about an-# unknown option--# Check whether --with-compiler was given.-if test "${with_compiler+set}" = set; then :-  withval=$with_compiler; with_compiler=$withval-else-  with_compiler=ghc-fi----# We set this to "yes" later when we have found OpenGL libs and headers.-GL_BUILD_PACKAGE=no--# Shall we build this package at all?-# Check whether --enable-opengl was given.-if test "${enable_opengl+set}" = set; then :-  enableval=$enable_opengl; enable_opengl=$enableval-else-  enable_opengl=yes-fi----if test x"$enable_opengl" != xno; then--# Check for OpenGL include paths and libraries-ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu-if test -n "$ac_tool_prefix"; then-  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.-set dummy ${ac_tool_prefix}gcc; ac_word=$2-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if ${ac_cv_prog_CC+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_CC="${ac_tool_prefix}gcc"-    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-  done-IFS=$as_save_IFS--fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi---fi-if test -z "$ac_cv_prog_CC"; then-  ac_ct_CC=$CC-  # Extract the first word of "gcc", so it can be a program name with args.-set dummy gcc; ac_word=$2-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if ${ac_cv_prog_ac_ct_CC+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test -n "$ac_ct_CC"; then-  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_ac_ct_CC="gcc"-    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-  done-IFS=$as_save_IFS--fi-fi-ac_ct_CC=$ac_cv_prog_ac_ct_CC-if test -n "$ac_ct_CC"; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5-$as_echo "$ac_ct_CC" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi--  if test "x$ac_ct_CC" = x; then-    CC=""-  else-    case $cross_compiling:$ac_tool_warned in-yes:)-{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5-$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}-ac_tool_warned=yes ;;-esac-    CC=$ac_ct_CC-  fi-else-  CC="$ac_cv_prog_CC"-fi--if test -z "$CC"; then-          if test -n "$ac_tool_prefix"; then-    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.-set dummy ${ac_tool_prefix}cc; ac_word=$2-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if ${ac_cv_prog_CC+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_CC="${ac_tool_prefix}cc"-    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-  done-IFS=$as_save_IFS--fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi---  fi-fi-if test -z "$CC"; then-  # Extract the first word of "cc", so it can be a program name with args.-set dummy cc; ac_word=$2-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if ${ac_cv_prog_CC+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-  ac_prog_rejected=no-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then-       ac_prog_rejected=yes-       continue-     fi-    ac_cv_prog_CC="cc"-    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-  done-IFS=$as_save_IFS--if test $ac_prog_rejected = yes; then-  # We found a bogon in the path, so make sure we never use it.-  set dummy $ac_cv_prog_CC-  shift-  if test $# != 0; then-    # We chose a different compiler from the bogus one.-    # However, it has the same basename, so the bogon will be chosen-    # first if we set CC to just the basename; use the full file name.-    shift-    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"-  fi-fi-fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi---fi-if test -z "$CC"; then-  if test -n "$ac_tool_prefix"; then-  for ac_prog in cl.exe-  do-    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.-set dummy $ac_tool_prefix$ac_prog; ac_word=$2-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if ${ac_cv_prog_CC+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"-    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-  done-IFS=$as_save_IFS--fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi---    test -n "$CC" && break-  done-fi-if test -z "$CC"; then-  ac_ct_CC=$CC-  for ac_prog in cl.exe-do-  # Extract the first word of "$ac_prog", so it can be a program name with args.-set dummy $ac_prog; ac_word=$2-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if ${ac_cv_prog_ac_ct_CC+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test -n "$ac_ct_CC"; then-  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_ac_ct_CC="$ac_prog"-    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-  done-IFS=$as_save_IFS--fi-fi-ac_ct_CC=$ac_cv_prog_ac_ct_CC-if test -n "$ac_ct_CC"; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5-$as_echo "$ac_ct_CC" >&6; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi---  test -n "$ac_ct_CC" && break-done--  if test "x$ac_ct_CC" = x; then-    CC=""-  else-    case $cross_compiling:$ac_tool_warned in-yes:)-{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5-$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}-ac_tool_warned=yes ;;-esac-    CC=$ac_ct_CC-  fi-fi--fi---test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "no acceptable C compiler found in \$PATH-See \`config.log' for more details" "$LINENO" 5; }--# Provide some information about the compiler.-$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5-set X $ac_compile-ac_compiler=$2-for ac_option in --version -v -V -qversion; do-  { { ac_try="$ac_compiler $ac_option >&5"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_compiler $ac_option >&5") 2>conftest.err-  ac_status=$?-  if test -s conftest.err; then-    sed '10a\-... rest of stderr output deleted ...-         10q' conftest.err >conftest.er1-    cat conftest.er1 >&5-  fi-  rm -f conftest.er1 conftest.err-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; }-done--cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-ac_clean_files_save=$ac_clean_files-ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"-# Try to create an executable without -o first, disregard a.out.-# It will help us diagnose broken compilers, and finding out an intuition-# of exeext.-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5-$as_echo_n "checking whether the C compiler works... " >&6; }-ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`--# The possible output files:-ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"--ac_rmfiles=-for ac_file in $ac_files-do-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;-    * ) ac_rmfiles="$ac_rmfiles $ac_file";;-  esac-done-rm -f $ac_rmfiles--if { { ac_try="$ac_link_default"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_link_default") 2>&5-  ac_status=$?-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; }; then :-  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.-# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'-# in a Makefile.  We should not override ac_cv_exeext if it was cached,-# so that the user can short-circuit this test for compilers unknown to-# Autoconf.-for ac_file in $ac_files ''-do-  test -f "$ac_file" || continue-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )-	;;-    [ab].out )-	# We found the default executable, but exeext='' is most-	# certainly right.-	break;;-    *.* )-	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;-	then :; else-	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`-	fi-	# We set ac_cv_exeext here because the later test for it is not-	# safe: cross compilers may not add the suffix if given an `-o'-	# argument, so we may need to know it at that point already.-	# Even if this section looks crufty: it has the advantage of-	# actually working.-	break;;-    * )-	break;;-  esac-done-test "$ac_cv_exeext" = no && ac_cv_exeext=--else-  ac_file=''-fi-if test -z "$ac_file"; then :-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-$as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error 77 "C compiler cannot create executables-See \`config.log' for more details" "$LINENO" 5; }-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5-$as_echo_n "checking for C compiler default output file name... " >&6; }-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5-$as_echo "$ac_file" >&6; }-ac_exeext=$ac_cv_exeext--rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out-ac_clean_files=$ac_clean_files_save-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5-$as_echo_n "checking for suffix of executables... " >&6; }-if { { ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_link") 2>&5-  ac_status=$?-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; }; then :-  # If both `conftest.exe' and `conftest' are `present' (well, observable)-# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will-# work properly (i.e., refer to `conftest.exe'), while it won't with-# `rm'.-for ac_file in conftest.exe conftest conftest.*; do-  test -f "$ac_file" || continue-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;-    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`-	  break;;-    * ) break;;-  esac-done-else-  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "cannot compute suffix of executables: cannot compile and link-See \`config.log' for more details" "$LINENO" 5; }-fi-rm -f conftest conftest$ac_cv_exeext-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5-$as_echo "$ac_cv_exeext" >&6; }--rm -f conftest.$ac_ext-EXEEXT=$ac_cv_exeext-ac_exeext=$EXEEXT-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-int-main ()-{-FILE *f = fopen ("conftest.out", "w");- return ferror (f) || fclose (f) != 0;--  ;-  return 0;-}-_ACEOF-ac_clean_files="$ac_clean_files conftest.out"-# Check that the compiler produces executables we can run.  If not, either-# the compiler is broken, or we cross compile.-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5-$as_echo_n "checking whether we are cross compiling... " >&6; }-if test "$cross_compiling" != yes; then-  { { ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_link") 2>&5-  ac_status=$?-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; }-  if { ac_try='./conftest$ac_cv_exeext'-  { { case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_try") 2>&5-  ac_status=$?-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; }; }; then-    cross_compiling=no-  else-    if test "$cross_compiling" = maybe; then-	cross_compiling=yes-    else-	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "cannot run C compiled programs.-If you meant to cross compile, use \`--host'.-See \`config.log' for more details" "$LINENO" 5; }-    fi-  fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5-$as_echo "$cross_compiling" >&6; }--rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out-ac_clean_files=$ac_clean_files_save-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5-$as_echo_n "checking for suffix of object files... " >&6; }-if ${ac_cv_objext+:} false; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.o conftest.obj-if { { ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""-$as_echo "$ac_try_echo"; } >&5-  (eval "$ac_compile") 2>&5-  ac_status=$?-  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5-  test $ac_status = 0; }; then :-  for ac_file in conftest.o conftest.obj conftest.*; do-  test -f "$ac_file" || continue;-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;-    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`-       break;;-  esac-done-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "cannot compute suffix of object files: cannot compile-See \`config.log' for more details" "$LINENO" 5; }-fi-rm -f conftest.$ac_cv_objext conftest.$ac_ext-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5-$as_echo "$ac_cv_objext" >&6; }-OBJEXT=$ac_cv_objext-ac_objext=$OBJEXT-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5-$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }-if ${ac_cv_c_compiler_gnu+:} false; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{-#ifndef __GNUC__-       choke me-#endif--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_compiler_gnu=yes-else-  ac_compiler_gnu=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-ac_cv_c_compiler_gnu=$ac_compiler_gnu--fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5-$as_echo "$ac_cv_c_compiler_gnu" >&6; }-if test $ac_compiler_gnu = yes; then-  GCC=yes-else-  GCC=-fi-ac_test_CFLAGS=${CFLAGS+set}-ac_save_CFLAGS=$CFLAGS-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5-$as_echo_n "checking whether $CC accepts -g... " >&6; }-if ${ac_cv_prog_cc_g+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_save_c_werror_flag=$ac_c_werror_flag-   ac_c_werror_flag=yes-   ac_cv_prog_cc_g=no-   CFLAGS="-g"-   cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_prog_cc_g=yes-else-  CFLAGS=""-      cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :--else-  ac_c_werror_flag=$ac_save_c_werror_flag-	 CFLAGS="-g"-	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_prog_cc_g=yes-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-   ac_c_werror_flag=$ac_save_c_werror_flag-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5-$as_echo "$ac_cv_prog_cc_g" >&6; }-if test "$ac_test_CFLAGS" = set; then-  CFLAGS=$ac_save_CFLAGS-elif test $ac_cv_prog_cc_g = yes; then-  if test "$GCC" = yes; then-    CFLAGS="-g -O2"-  else-    CFLAGS="-g"-  fi-else-  if test "$GCC" = yes; then-    CFLAGS="-O2"-  else-    CFLAGS=-  fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5-$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }-if ${ac_cv_prog_cc_c89+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_cv_prog_cc_c89=no-ac_save_CC=$CC-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdarg.h>-#include <stdio.h>-#include <sys/types.h>-#include <sys/stat.h>-/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */-struct buf { int x; };-FILE * (*rcsopen) (struct buf *, struct stat *, int);-static char *e (p, i)-     char **p;-     int i;-{-  return p[i];-}-static char *f (char * (*g) (char **, int), char **p, ...)-{-  char *s;-  va_list v;-  va_start (v,p);-  s = g (p, va_arg (v,int));-  va_end (v);-  return s;-}--/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has-   function prototypes and stuff, but not '\xHH' hex character constants.-   These don't provoke an error unfortunately, instead are silently treated-   as 'x'.  The following induces an error, until -std is added to get-   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an-   array size at least.  It's necessary to write '\x00'==0 to get something-   that's true only with -std.  */-int osf4_cc_array ['\x00' == 0 ? 1 : -1];--/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters-   inside strings and character constants.  */-#define FOO(x) 'x'-int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];--int test (int i, double x);-struct s1 {int (*f) (int a);};-struct s2 {int (*f) (double a);};-int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);-int argc;-char **argv;-int-main ()-{-return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];-  ;-  return 0;-}-_ACEOF-for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \-	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"-do-  CC="$ac_save_CC $ac_arg"-  if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_prog_cc_c89=$ac_arg-fi-rm -f core conftest.err conftest.$ac_objext-  test "x$ac_cv_prog_cc_c89" != "xno" && break-done-rm -f conftest.$ac_ext-CC=$ac_save_CC--fi-# AC_CACHE_VAL-case "x$ac_cv_prog_cc_c89" in-  x)-    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5-$as_echo "none needed" >&6; } ;;-  xno)-    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5-$as_echo "unsupported" >&6; } ;;-  *)-    CC="$CC $ac_cv_prog_cc_c89"-    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5-$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;-esac-if test "x$ac_cv_prog_cc_c89" != xno; then :--fi--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows environment" >&5-$as_echo_n "checking for Windows environment... " >&6; }-if ${fp_cv_is_win32+:} false; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--#if !_WIN32-   syntax error;-#endif--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  fp_cv_is_win32=yes-else-  fp_cv_is_win32=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $fp_cv_is_win32" >&5-$as_echo "$fp_cv_is_win32" >&6; }-fp_is_win32="$fp_cv_is_win32"-ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5-$as_echo_n "checking how to run the C preprocessor... " >&6; }-# On Suns, sometimes $CPP names a directory.-if test -n "$CPP" && test -d "$CPP"; then-  CPP=-fi-if test -z "$CPP"; then-  if ${ac_cv_prog_CPP+:} false; then :-  $as_echo_n "(cached) " >&6-else-      # Double quotes because CPP needs to be expanded-    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"-    do-      ac_preproc_ok=false-for ac_c_preproc_warn_flag in '' yes-do-  # Use a header file that comes with gcc, so configuring glibc-  # with a fresh cross-compiler works.-  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-  # <limits.h> exists even on freestanding compilers.-  # On the NeXT, cc -E runs the code through the compiler's parser,-  # not just through cpp. "Syntax error" is here to catch this case.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif-		     Syntax error-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :--else-  # Broken: fails on valid input.-continue-fi-rm -f conftest.err conftest.i conftest.$ac_ext--  # OK, works on sane cases.  Now check whether nonexistent headers-  # can be detected and how.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <ac_nonexistent.h>-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :-  # Broken: success on invalid input.-continue-else-  # Passes both tests.-ac_preproc_ok=:-break-fi-rm -f conftest.err conftest.i conftest.$ac_ext--done-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.i conftest.err conftest.$ac_ext-if $ac_preproc_ok; then :-  break-fi--    done-    ac_cv_prog_CPP=$CPP--fi-  CPP=$ac_cv_prog_CPP-else-  ac_cv_prog_CPP=$CPP-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5-$as_echo "$CPP" >&6; }-ac_preproc_ok=false-for ac_c_preproc_warn_flag in '' yes-do-  # Use a header file that comes with gcc, so configuring glibc-  # with a fresh cross-compiler works.-  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-  # <limits.h> exists even on freestanding compilers.-  # On the NeXT, cc -E runs the code through the compiler's parser,-  # not just through cpp. "Syntax error" is here to catch this case.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif-		     Syntax error-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :--else-  # Broken: fails on valid input.-continue-fi-rm -f conftest.err conftest.i conftest.$ac_ext--  # OK, works on sane cases.  Now check whether nonexistent headers-  # can be detected and how.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <ac_nonexistent.h>-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :-  # Broken: success on invalid input.-continue-else-  # Passes both tests.-ac_preproc_ok=:-break-fi-rm -f conftest.err conftest.i conftest.$ac_ext--done-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.i conftest.err conftest.$ac_ext-if $ac_preproc_ok; then :--else-  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "C preprocessor \"$CPP\" fails sanity check-See \`config.log' for more details" "$LINENO" 5; }-fi--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5-$as_echo_n "checking for X... " >&6; }---# Check whether --with-x was given.-if test "${with_x+set}" = set; then :-  withval=$with_x;-fi--# $have_x is `yes', `no', `disabled', or empty when we do not yet know.-if test "x$with_x" = xno; then-  # The user explicitly disabled X.-  have_x=disabled-else-  case $x_includes,$x_libraries in #(-    *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #(-    *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then :-  $as_echo_n "(cached) " >&6-else-  # One or both of the vars are not set, and there is no cached value.-ac_x_includes=no ac_x_libraries=no-rm -f -r conftest.dir-if mkdir conftest.dir; then-  cd conftest.dir-  cat >Imakefile <<'_ACEOF'-incroot:-	@echo incroot='${INCROOT}'-usrlibdir:-	@echo usrlibdir='${USRLIBDIR}'-libdir:-	@echo libdir='${LIBDIR}'-_ACEOF-  if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then-    # GNU make sometimes prints "make[1]: Entering ...", which would confuse us.-    for ac_var in incroot usrlibdir libdir; do-      eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`"-    done-    # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.-    for ac_extension in a so sl dylib la dll; do-      if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" &&-	 test -f "$ac_im_libdir/libX11.$ac_extension"; then-	ac_im_usrlibdir=$ac_im_libdir; break-      fi-    done-    # Screen out bogus values from the imake configuration.  They are-    # bogus both because they are the default anyway, and because-    # using them would break gcc on systems where it needs fixed includes.-    case $ac_im_incroot in-	/usr/include) ac_x_includes= ;;-	*) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;;-    esac-    case $ac_im_usrlibdir in-	/usr/lib | /usr/lib64 | /lib | /lib64) ;;-	*) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;;-    esac-  fi-  cd ..-  rm -f -r conftest.dir-fi--# Standard set of common directories for X headers.-# Check X11 before X11Rn because it is often a symlink to the current release.-ac_x_header_dirs='-/usr/X11/include-/usr/X11R7/include-/usr/X11R6/include-/usr/X11R5/include-/usr/X11R4/include--/usr/include/X11-/usr/include/X11R7-/usr/include/X11R6-/usr/include/X11R5-/usr/include/X11R4--/usr/local/X11/include-/usr/local/X11R7/include-/usr/local/X11R6/include-/usr/local/X11R5/include-/usr/local/X11R4/include--/usr/local/include/X11-/usr/local/include/X11R7-/usr/local/include/X11R6-/usr/local/include/X11R5-/usr/local/include/X11R4--/usr/X386/include-/usr/x386/include-/usr/XFree86/include/X11--/usr/include-/usr/local/include-/usr/unsupported/include-/usr/athena/include-/usr/local/x11r5/include-/usr/lpp/Xamples/include--/usr/openwin/include-/usr/openwin/share/include'--if test "$ac_x_includes" = no; then-  # Guess where to find include files, by looking for Xlib.h.-  # First, try using that file with no special directory specified.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <X11/Xlib.h>-_ACEOF-if ac_fn_c_try_cpp "$LINENO"; then :-  # We can compile using X headers with no special include directory.-ac_x_includes=-else-  for ac_dir in $ac_x_header_dirs; do-  if test -r "$ac_dir/X11/Xlib.h"; then-    ac_x_includes=$ac_dir-    break-  fi-done-fi-rm -f conftest.err conftest.i conftest.$ac_ext-fi # $ac_x_includes = no--if test "$ac_x_libraries" = no; then-  # Check for the libraries.-  # See if we find them without any special options.-  # Don't add to $LIBS permanently.-  ac_save_LIBS=$LIBS-  LIBS="-lX11 $LIBS"-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <X11/Xlib.h>-int-main ()-{-XrmInitialize ()-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  LIBS=$ac_save_LIBS-# We can link X programs with no special library path.-ac_x_libraries=-else-  LIBS=$ac_save_LIBS-for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g`-do-  # Don't even attempt the hair of trying to link an X program!-  for ac_extension in a so sl dylib la dll; do-    if test -r "$ac_dir/libX11.$ac_extension"; then-      ac_x_libraries=$ac_dir-      break 2-    fi-  done-done-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-fi # $ac_x_libraries = no--case $ac_x_includes,$ac_x_libraries in #(-  no,* | *,no | *\'*)-    # Didn't find X, or a directory has "'" in its name.-    ac_cv_have_x="have_x=no";; #(-  *)-    # Record where we found X for the cache.-    ac_cv_have_x="have_x=yes\-	ac_x_includes='$ac_x_includes'\-	ac_x_libraries='$ac_x_libraries'"-esac-fi-;; #(-    *) have_x=yes;;-  esac-  eval "$ac_cv_have_x"-fi # $with_x != no--if test "$have_x" != yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5-$as_echo "$have_x" >&6; }-  no_x=yes-else-  # If each of the values was on the command line, it overrides each guess.-  test "x$x_includes" = xNONE && x_includes=$ac_x_includes-  test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries-  # Update the cache value to reflect the command line values.-  ac_cv_have_x="have_x=yes\-	ac_x_includes='$x_includes'\-	ac_x_libraries='$x_libraries'"-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5-$as_echo "libraries $x_libraries, headers $x_includes" >&6; }-fi---if test x"$fp_is_win32" = xyes; then-  no_x=yes-else-  if test "$no_x" = yes; then-  # Not all programs may use this symbol, but it does not hurt to define it.--$as_echo "#define X_DISPLAY_MISSING 1" >>confdefs.h--  X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=-else-  if test -n "$x_includes"; then-    X_CFLAGS="$X_CFLAGS -I$x_includes"-  fi--  # It would also be nice to do this for all -L options, not just this one.-  if test -n "$x_libraries"; then-    X_LIBS="$X_LIBS -L$x_libraries"-    # For Solaris; some versions of Sun CC require a space after -R and-    # others require no space.  Words are not sufficient . . . .-    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -R must be followed by a space" >&5-$as_echo_n "checking whether -R must be followed by a space... " >&6; }-    ac_xsave_LIBS=$LIBS; LIBS="$LIBS -R$x_libraries"-    ac_xsave_c_werror_flag=$ac_c_werror_flag-    ac_c_werror_flag=yes-    cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-       X_LIBS="$X_LIBS -R$x_libraries"-else-  LIBS="$ac_xsave_LIBS -R $x_libraries"-       cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5-$as_echo "yes" >&6; }-	  X_LIBS="$X_LIBS -R $x_libraries"-else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: neither works" >&5-$as_echo "neither works" >&6; }-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-    ac_c_werror_flag=$ac_xsave_c_werror_flag-    LIBS=$ac_xsave_LIBS-  fi--  # Check for system-dependent libraries X programs must link with.-  # Do this before checking for the system-independent R6 libraries-  # (-lICE), since we may need -lsocket or whatever for X linking.--  if test "$ISC" = yes; then-    X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"-  else-    # Martyn Johnson says this is needed for Ultrix, if the X-    # libraries were built with DECnet support.  And Karl Berry says-    # the Alpha needs dnet_stub (dnet does not exist).-    ac_xsave_LIBS="$LIBS"; LIBS="$LIBS $X_LIBS -lX11"-    cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char XOpenDisplay ();-int-main ()-{-return XOpenDisplay ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5-$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; }-if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-ldnet  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char dnet_ntoa ();-int-main ()-{-return dnet_ntoa ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_dnet_dnet_ntoa=yes-else-  ac_cv_lib_dnet_dnet_ntoa=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5-$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; }-if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then :-  X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"-fi--    if test $ac_cv_lib_dnet_dnet_ntoa = no; then-      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet_stub" >&5-$as_echo_n "checking for dnet_ntoa in -ldnet_stub... " >&6; }-if ${ac_cv_lib_dnet_stub_dnet_ntoa+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-ldnet_stub  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char dnet_ntoa ();-int-main ()-{-return dnet_ntoa ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_dnet_stub_dnet_ntoa=yes-else-  ac_cv_lib_dnet_stub_dnet_ntoa=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5-$as_echo "$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; }-if test "x$ac_cv_lib_dnet_stub_dnet_ntoa" = xyes; then :-  X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"-fi--    fi-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-    LIBS="$ac_xsave_LIBS"--    # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,-    # to get the SysV transport functions.-    # Chad R. Larson says the Pyramis MIS-ES running DC/OSx (SVR4)-    # needs -lnsl.-    # The nsl library prevents programs from opening the X display-    # on Irix 5.2, according to T.E. Dickey.-    # The functions gethostbyname, getservbyname, and inet_addr are-    # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking.-    ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname"-if test "x$ac_cv_func_gethostbyname" = xyes; then :--fi--    if test $ac_cv_func_gethostbyname = no; then-      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5-$as_echo_n "checking for gethostbyname in -lnsl... " >&6; }-if ${ac_cv_lib_nsl_gethostbyname+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lnsl  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char gethostbyname ();-int-main ()-{-return gethostbyname ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_nsl_gethostbyname=yes-else-  ac_cv_lib_nsl_gethostbyname=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5-$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; }-if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then :-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"-fi--      if test $ac_cv_lib_nsl_gethostbyname = no; then-	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lbsd" >&5-$as_echo_n "checking for gethostbyname in -lbsd... " >&6; }-if ${ac_cv_lib_bsd_gethostbyname+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lbsd  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char gethostbyname ();-int-main ()-{-return gethostbyname ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_bsd_gethostbyname=yes-else-  ac_cv_lib_bsd_gethostbyname=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bsd_gethostbyname" >&5-$as_echo "$ac_cv_lib_bsd_gethostbyname" >&6; }-if test "x$ac_cv_lib_bsd_gethostbyname" = xyes; then :-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd"-fi--      fi-    fi--    # lieder@skyler.mavd.honeywell.com says without -lsocket,-    # socket/setsockopt and other routines are undefined under SCO ODT-    # 2.0.  But -lsocket is broken on IRIX 5.2 (and is not necessary-    # on later versions), says Simon Leinen: it contains gethostby*-    # variants that don't use the name server (or something).  -lsocket-    # must be given before -lnsl if both are needed.  We assume that-    # if connect needs -lnsl, so does gethostbyname.-    ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect"-if test "x$ac_cv_func_connect" = xyes; then :--fi--    if test $ac_cv_func_connect = no; then-      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for connect in -lsocket" >&5-$as_echo_n "checking for connect in -lsocket... " >&6; }-if ${ac_cv_lib_socket_connect+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lsocket $X_EXTRA_LIBS $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char connect ();-int-main ()-{-return connect ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_socket_connect=yes-else-  ac_cv_lib_socket_connect=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_connect" >&5-$as_echo "$ac_cv_lib_socket_connect" >&6; }-if test "x$ac_cv_lib_socket_connect" = xyes; then :-  X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"-fi--    fi--    # Guillermo Gomez says -lposix is necessary on A/UX.-    ac_fn_c_check_func "$LINENO" "remove" "ac_cv_func_remove"-if test "x$ac_cv_func_remove" = xyes; then :--fi--    if test $ac_cv_func_remove = no; then-      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for remove in -lposix" >&5-$as_echo_n "checking for remove in -lposix... " >&6; }-if ${ac_cv_lib_posix_remove+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lposix  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char remove ();-int-main ()-{-return remove ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_posix_remove=yes-else-  ac_cv_lib_posix_remove=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_posix_remove" >&5-$as_echo "$ac_cv_lib_posix_remove" >&6; }-if test "x$ac_cv_lib_posix_remove" = xyes; then :-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"-fi--    fi--    # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.-    ac_fn_c_check_func "$LINENO" "shmat" "ac_cv_func_shmat"-if test "x$ac_cv_func_shmat" = xyes; then :--fi--    if test $ac_cv_func_shmat = no; then-      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shmat in -lipc" >&5-$as_echo_n "checking for shmat in -lipc... " >&6; }-if ${ac_cv_lib_ipc_shmat+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lipc  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char shmat ();-int-main ()-{-return shmat ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_ipc_shmat=yes-else-  ac_cv_lib_ipc_shmat=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ipc_shmat" >&5-$as_echo "$ac_cv_lib_ipc_shmat" >&6; }-if test "x$ac_cv_lib_ipc_shmat" = xyes; then :-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"-fi--    fi-  fi--  # Check for libraries that X11R6 Xt/Xaw programs need.-  ac_save_LDFLAGS=$LDFLAGS-  test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"-  # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to-  # check for ICE first), but we must link in the order -lSM -lICE or-  # we get undefined symbols.  So assume we have SM if we have ICE.-  # These have to be linked with before -lX11, unlike the other-  # libraries we check for below, so use a different variable.-  # John Interrante, Karl Berry-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for IceConnectionNumber in -lICE" >&5-$as_echo_n "checking for IceConnectionNumber in -lICE... " >&6; }-if ${ac_cv_lib_ICE_IceConnectionNumber+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lICE $X_EXTRA_LIBS $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char IceConnectionNumber ();-int-main ()-{-return IceConnectionNumber ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_ICE_IceConnectionNumber=yes-else-  ac_cv_lib_ICE_IceConnectionNumber=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5-$as_echo "$ac_cv_lib_ICE_IceConnectionNumber" >&6; }-if test "x$ac_cv_lib_ICE_IceConnectionNumber" = xyes; then :-  X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"-fi--  LDFLAGS=$ac_save_LDFLAGS--fi--fi--ac_aux_dir=-for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do-  if test -f "$ac_dir/install-sh"; then-    ac_aux_dir=$ac_dir-    ac_install_sh="$ac_aux_dir/install-sh -c"-    break-  elif test -f "$ac_dir/install.sh"; then-    ac_aux_dir=$ac_dir-    ac_install_sh="$ac_aux_dir/install.sh -c"-    break-  elif test -f "$ac_dir/shtool"; then-    ac_aux_dir=$ac_dir-    ac_install_sh="$ac_aux_dir/shtool install -c"-    break-  fi-done-if test -z "$ac_aux_dir"; then-  as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5-fi--# These three variables are undocumented and unsupported,-# and are intended to be withdrawn in a future Autoconf release.-# They can cause serious problems if a builder's source tree is in a directory-# whose full name contains unusual characters.-ac_config_guess="$SHELL $ac_aux_dir/config.guess"  # Please don't use this var.-ac_config_sub="$SHELL $ac_aux_dir/config.sub"  # Please don't use this var.-ac_configure="$SHELL $ac_aux_dir/configure"  # Please don't use this var.---# Make sure we can run config.sub.-$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 ||-  as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5-$as_echo_n "checking build system type... " >&6; }-if ${ac_cv_build+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_build_alias=$build_alias-test "x$ac_build_alias" = x &&-  ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"`-test "x$ac_build_alias" = x &&-  as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5-ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` ||-  as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5--fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5-$as_echo "$ac_cv_build" >&6; }-case $ac_cv_build in-*-*-*) ;;-*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;;-esac-build=$ac_cv_build-ac_save_IFS=$IFS; IFS='-'-set x $ac_cv_build-shift-build_cpu=$1-build_vendor=$2-shift; shift-# Remember, the first character of IFS is used to create $*,-# except with old shells:-build_os=$*-IFS=$ac_save_IFS-case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5-$as_echo_n "checking host system type... " >&6; }-if ${ac_cv_host+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test "x$host_alias" = x; then-  ac_cv_host=$ac_cv_build-else-  ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` ||-    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5-fi--fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5-$as_echo "$ac_cv_host" >&6; }-case $ac_cv_host in-*-*-*) ;;-*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;;-esac-host=$ac_cv_host-ac_save_IFS=$IFS; IFS='-'-set x $ac_cv_host-shift-host_cpu=$1-host_vendor=$2-shift; shift-# Remember, the first character of IFS is used to create $*,-# except with old shells:-host_os=$*-IFS=$ac_save_IFS-case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking target system type" >&5-$as_echo_n "checking target system type... " >&6; }-if ${ac_cv_target+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test "x$target_alias" = x; then-  ac_cv_target=$ac_cv_host-else-  ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` ||-    as_fn_error $? "$SHELL $ac_aux_dir/config.sub $target_alias failed" "$LINENO" 5-fi--fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_target" >&5-$as_echo "$ac_cv_target" >&6; }-case $ac_cv_target in-*-*-*) ;;-*) as_fn_error $? "invalid value of canonical target" "$LINENO" 5;;-esac-target=$ac_cv_target-ac_save_IFS=$IFS; IFS='-'-set x $ac_cv_target-shift-target_cpu=$1-target_vendor=$2-shift; shift-# Remember, the first character of IFS is used to create $*,-# except with old shells:-target_os=$*-IFS=$ac_save_IFS-case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac---# The aliases save the names the user supplied, while $host etc.-# will get canonicalized.-test -n "$target_alias" &&-  test "$program_prefix$program_suffix$program_transform_name" = \-    NONENONEs,x,x, &&-  program_prefix=${target_alias}-----use_quartz_opengl=no-if test x"$enable_opengl" = xyes; then-  case $target_os in-  darwin*)--$as_echo "#define USE_QUARTZ_OPENGL 1" >>confdefs.h--    use_quartz_opengl=yes-    ;;-  esac-fi--GLU_FRAMEWORKS=-GLUT_FRAMEWORKS=-if test x"$use_quartz_opengl" = xyes; then-  GLU_FRAMEWORKS=OpenGL-  GLUT_FRAMEWORKS=GLUT-fi--------if test x"$use_quartz_opengl" = xno; then-  ac_fn_c_check_func "$LINENO" "atan" "ac_cv_func_atan"-if test "x$ac_cv_func_atan" = xyes; then :-  fp_libm_not_needed=yes-else-  fp_libm_not_needed=dunno-fi--  if test x"$fp_libm_not_needed" = xdunno; then-     { $as_echo "$as_me:${as_lineno-$LINENO}: checking for atan in -lm" >&5-$as_echo_n "checking for atan in -lm... " >&6; }-if ${ac_cv_lib_m_atan+:} false; then :-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lm  $LIBS"-cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char atan ();-int-main ()-{-return atan ();-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  ac_cv_lib_m_atan=yes-else-  ac_cv_lib_m_atan=no-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_atan" >&5-$as_echo "$ac_cv_lib_m_atan" >&6; }-if test "x$ac_cv_lib_m_atan" = xyes; then :-  GL_LIBS="-lm $GL_LIBS"-fi--  fi--  if test x"$no_x" != xyes; then-    test -n "$x_includes" && GL_CFLAGS="-I$x_includes $GL_CFLAGS"-    test -n "$x_libraries" && GL_LIBS="-L$x_libraries -lX11 $GL_LIBS"-  fi--  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GL library" >&5-$as_echo_n "checking for GL library... " >&6; }-if ${fp_cv_check_GL_lib+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fp_cv_check_GL_lib="no"-  fp_save_CPPFLAGS="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS ${GL_CFLAGS}"-  fp_save_LIBS="$LIBS"-  for fp_try_lib in -lGL -lopengl32; do-    # transform "-lfoo" to "foo.lib" when using cl-    if test x"$CC" = xcl; then-      fp_try_lib=`echo $fp_try_lib | sed -e 's/^-l//' -e 's/$/.lib/'`-    fi-    LIBS="$fp_try_lib ${GL_LIBS} $fp_save_LIBS"-    cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <GL/gl.h>-int-main ()-{-glEnd()-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  fp_cv_check_GL_lib="$fp_try_lib ${GL_LIBS}"; break-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-  done-  LIBS="$fp_save_LIBS"-  CPPFLAGS="$fp_save_CPPFLAGS"-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $fp_cv_check_GL_lib" >&5-$as_echo "$fp_cv_check_GL_lib" >&6; }--  if test x"$fp_cv_check_GL_lib" = xno; then-    no_GL=yes-    GL_CFLAGS=-    GL_LIBS=-  else-    GL_CFLAGS0="${GL_CFLAGS}"-    GL_CFLAGS="$CPPFLAGS ${GL_CFLAGS0}"-    GL_LIBS0="$fp_cv_check_GL_lib"-    GL_LIBS="$LDFLAGS ${GL_LIBS0}"-  fi---  if test x"$fp_is_win32" = xyes; then-    # Ugly: To get wglGetProcAddress on Windows, we have to link with-    # opengl32.dll, too, even when we are using Cygwin with X11.-    case "$GL_LIBS" in-      *-lopengl32*|*opengl32.lib*) ;;-      *) fp_save_LIBS="$LIBS"-         LIBS="$LIBS -lopengl32"-         cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <GL/gl.h>-int-main ()-{-glEnd()-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  GL_LIBS="$GL_LIBS -lopengl32"; GL_LIBS0="$GL_LIBS0 -lopengl32"-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-         LIBS="$fp_save_LIBS"-         ;;-    esac-  fi-fi----GLU_CFLAGS="$GL_CFLAGS0"-GLU_LIBS="$GL_LIBS0"--if test x"$use_quartz_opengl" = xno; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GLU library" >&5-$as_echo_n "checking for GLU library... " >&6; }-if ${fp_cv_check_GLU_lib+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fp_cv_check_GLU_lib="no"-  fp_save_CPPFLAGS="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS ${GLU_CFLAGS}"-  fp_save_LIBS="$LIBS"-  for fp_try_lib in -lglu32 -lGLU; do-    # transform "-lfoo" to "foo.lib" when using cl-    if test x"$CC" = xcl; then-      fp_try_lib=`echo $fp_try_lib | sed -e 's/^-l//' -e 's/$/.lib/'`-    fi-    LIBS="$fp_try_lib ${GLU_LIBS} $fp_save_LIBS"-    cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <GL/glu.h>-int-main ()-{-gluNewQuadric()-  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_link "$LINENO"; then :-  fp_cv_check_GLU_lib="$fp_try_lib ${GLU_LIBS}"; break-fi-rm -f core conftest.err conftest.$ac_objext \-    conftest$ac_exeext conftest.$ac_ext-  done-  LIBS="$fp_save_LIBS"-  CPPFLAGS="$fp_save_CPPFLAGS"-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $fp_cv_check_GLU_lib" >&5-$as_echo "$fp_cv_check_GLU_lib" >&6; }--  if test x"$fp_cv_check_GLU_lib" = xno; then-    no_GLU=yes-    GLU_CFLAGS=-    GLU_LIBS=-  else-    GLU_CFLAGS0="${GLU_CFLAGS}"-    GLU_CFLAGS="$CPPFLAGS ${GLU_CFLAGS0}"-    GLU_LIBS0="$fp_cv_check_GLU_lib"-    GLU_LIBS="$LDFLAGS ${GLU_LIBS0}"-  fi--fi------if test x"$GLU_LIBS" = xno; then-  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "no OpenGL library found, so this package cannot be built-See \`config.log' for more details" "$LINENO" 5; }-fi--# check for OpenGL include files-gl_found_header=no-glu_found_header=no-fp_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5-$as_echo_n "checking for grep that handles long lines and -e... " >&6; }-if ${ac_cv_path_GREP+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if test -z "$GREP"; then-  ac_path_GREP_found=false-  # Loop through the user's path and test for each of PROGNAME-LIST-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_prog in grep ggrep; do-    for ac_exec_ext in '' $ac_executable_extensions; do-      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"-      { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue-# Check for GNU ac_path_GREP and select it if it is found.-  # Check for GNU $ac_path_GREP-case `"$ac_path_GREP" --version 2>&1` in-*GNU*)-  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;-*)-  ac_count=0-  $as_echo_n 0123456789 >"conftest.in"-  while :-  do-    cat "conftest.in" "conftest.in" >"conftest.tmp"-    mv "conftest.tmp" "conftest.in"-    cp "conftest.in" "conftest.nl"-    $as_echo 'GREP' >> "conftest.nl"-    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break-    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break-    as_fn_arith $ac_count + 1 && ac_count=$as_val-    if test $ac_count -gt ${ac_path_GREP_max-0}; then-      # Best one so far, save it but keep looking for a better one-      ac_cv_path_GREP="$ac_path_GREP"-      ac_path_GREP_max=$ac_count-    fi-    # 10*(2^10) chars as input seems more than enough-    test $ac_count -gt 10 && break-  done-  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;-esac--      $ac_path_GREP_found && break 3-    done-  done-  done-IFS=$as_save_IFS-  if test -z "$ac_cv_path_GREP"; then-    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5-  fi-else-  ac_cv_path_GREP=$GREP-fi--fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5-$as_echo "$ac_cv_path_GREP" >&6; }- GREP="$ac_cv_path_GREP"---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5-$as_echo_n "checking for egrep... " >&6; }-if ${ac_cv_path_EGREP+:} false; then :-  $as_echo_n "(cached) " >&6-else-  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1-   then ac_cv_path_EGREP="$GREP -E"-   else-     if test -z "$EGREP"; then-  ac_path_EGREP_found=false-  # Loop through the user's path and test for each of PROGNAME-LIST-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    for ac_prog in egrep; do-    for ac_exec_ext in '' $ac_executable_extensions; do-      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"-      { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue-# Check for GNU ac_path_EGREP and select it if it is found.-  # Check for GNU $ac_path_EGREP-case `"$ac_path_EGREP" --version 2>&1` in-*GNU*)-  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;-*)-  ac_count=0-  $as_echo_n 0123456789 >"conftest.in"-  while :-  do-    cat "conftest.in" "conftest.in" >"conftest.tmp"-    mv "conftest.tmp" "conftest.in"-    cp "conftest.in" "conftest.nl"-    $as_echo 'EGREP' >> "conftest.nl"-    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break-    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break-    as_fn_arith $ac_count + 1 && ac_count=$as_val-    if test $ac_count -gt ${ac_path_EGREP_max-0}; then-      # Best one so far, save it but keep looking for a better one-      ac_cv_path_EGREP="$ac_path_EGREP"-      ac_path_EGREP_max=$ac_count-    fi-    # 10*(2^10) chars as input seems more than enough-    test $ac_count -gt 10 && break-  done-  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;-esac--      $ac_path_EGREP_found && break 3-    done-  done-  done-IFS=$as_save_IFS-  if test -z "$ac_cv_path_EGREP"; then-    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5-  fi-else-  ac_cv_path_EGREP=$EGREP-fi--   fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5-$as_echo "$ac_cv_path_EGREP" >&6; }- EGREP="$ac_cv_path_EGREP"---{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5-$as_echo_n "checking for ANSI C header files... " >&6; }-if ${ac_cv_header_stdc+:} false; then :-  $as_echo_n "(cached) " >&6-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdlib.h>-#include <stdarg.h>-#include <string.h>-#include <float.h>--int-main ()-{--  ;-  return 0;-}-_ACEOF-if ac_fn_c_try_compile "$LINENO"; then :-  ac_cv_header_stdc=yes-else-  ac_cv_header_stdc=no-fi-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext--if test $ac_cv_header_stdc = yes; then-  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <string.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "memchr" >/dev/null 2>&1; then :--else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdlib.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "free" >/dev/null 2>&1; then :--else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.-  if test "$cross_compiling" = yes; then :-  :-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <ctype.h>-#include <stdlib.h>-#if ((' ' & 0x0FF) == 0x020)-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))-#else-# define ISLOWER(c) \-		   (('a' <= (c) && (c) <= 'i') \-		     || ('j' <= (c) && (c) <= 'r') \-		     || ('s' <= (c) && (c) <= 'z'))-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))-#endif--#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))-int-main ()-{-  int i;-  for (i = 0; i < 256; i++)-    if (XOR (islower (i), ISLOWER (i))-	|| toupper (i) != TOUPPER (i))-      return 2;-  return 0;-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :--else-  ac_cv_header_stdc=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--fi-fi-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5-$as_echo "$ac_cv_header_stdc" >&6; }-if test $ac_cv_header_stdc = yes; then--$as_echo "#define STDC_HEADERS 1" >>confdefs.h--fi--# On IRIX 5.3, sys/types and inttypes.h are conflicting.-for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \-		  inttypes.h stdint.h unistd.h-do :-  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default-"-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF--fi--done---for ac_header in GL/gl.h OpenGL/gl.h-do :-  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF- gl_found_header=yes-fi--done--for ac_header in GL/glu.h OpenGL/glu.h-do :-  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"-if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF- glu_found_header=yes-fi--done--CPPFLAGS="$fp_save_cppflags"--if test x"$gl_found_header" = xno || test x"$glu_found_header" = xno; then-  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "no OpenGL headers found, so this package cannot be built-See \`config.log' for more details" "$LINENO" 5; }-fi--GL_BUILD_PACKAGE=yes--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLboolean" >&5-$as_echo_n "checking Haskell type for GLboolean... " >&6; }-if ${fptools_cv_htype_GLboolean+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLboolean=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLboolean=NotReallyATypeCross; fptools_cv_htype_sup_GLboolean=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLboolean testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLboolean=`cat conftestval`-else-  fptools_cv_htype_GLboolean=NotReallyAType; fptools_cv_htype_sup_GLboolean=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLboolean" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLboolean" >&5-$as_echo "$fptools_cv_htype_GLboolean" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLBOOLEAN $fptools_cv_htype_GLboolean-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLbyte" >&5-$as_echo_n "checking Haskell type for GLbyte... " >&6; }-if ${fptools_cv_htype_GLbyte+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLbyte=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLbyte=NotReallyATypeCross; fptools_cv_htype_sup_GLbyte=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLbyte testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLbyte=`cat conftestval`-else-  fptools_cv_htype_GLbyte=NotReallyAType; fptools_cv_htype_sup_GLbyte=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLbyte" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLbyte" >&5-$as_echo "$fptools_cv_htype_GLbyte" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLBYTE $fptools_cv_htype_GLbyte-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLubyte" >&5-$as_echo_n "checking Haskell type for GLubyte... " >&6; }-if ${fptools_cv_htype_GLubyte+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLubyte=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLubyte=NotReallyATypeCross; fptools_cv_htype_sup_GLubyte=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLubyte testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLubyte=`cat conftestval`-else-  fptools_cv_htype_GLubyte=NotReallyAType; fptools_cv_htype_sup_GLubyte=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLubyte" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLubyte" >&5-$as_echo "$fptools_cv_htype_GLubyte" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLUBYTE $fptools_cv_htype_GLubyte-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLshort" >&5-$as_echo_n "checking Haskell type for GLshort... " >&6; }-if ${fptools_cv_htype_GLshort+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLshort=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLshort=NotReallyATypeCross; fptools_cv_htype_sup_GLshort=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLshort testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLshort=`cat conftestval`-else-  fptools_cv_htype_GLshort=NotReallyAType; fptools_cv_htype_sup_GLshort=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLshort" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLshort" >&5-$as_echo "$fptools_cv_htype_GLshort" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLSHORT $fptools_cv_htype_GLshort-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLushort" >&5-$as_echo_n "checking Haskell type for GLushort... " >&6; }-if ${fptools_cv_htype_GLushort+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLushort=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLushort=NotReallyATypeCross; fptools_cv_htype_sup_GLushort=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLushort testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLushort=`cat conftestval`-else-  fptools_cv_htype_GLushort=NotReallyAType; fptools_cv_htype_sup_GLushort=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLushort" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLushort" >&5-$as_echo "$fptools_cv_htype_GLushort" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLUSHORT $fptools_cv_htype_GLushort-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLint" >&5-$as_echo_n "checking Haskell type for GLint... " >&6; }-if ${fptools_cv_htype_GLint+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLint=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLint=NotReallyATypeCross; fptools_cv_htype_sup_GLint=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLint testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLint=`cat conftestval`-else-  fptools_cv_htype_GLint=NotReallyAType; fptools_cv_htype_sup_GLint=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLint" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLint" >&5-$as_echo "$fptools_cv_htype_GLint" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLINT $fptools_cv_htype_GLint-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLuint" >&5-$as_echo_n "checking Haskell type for GLuint... " >&6; }-if ${fptools_cv_htype_GLuint+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLuint=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLuint=NotReallyATypeCross; fptools_cv_htype_sup_GLuint=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLuint testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLuint=`cat conftestval`-else-  fptools_cv_htype_GLuint=NotReallyAType; fptools_cv_htype_sup_GLuint=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLuint" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLuint" >&5-$as_echo "$fptools_cv_htype_GLuint" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLUINT $fptools_cv_htype_GLuint-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLsizei" >&5-$as_echo_n "checking Haskell type for GLsizei... " >&6; }-if ${fptools_cv_htype_GLsizei+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLsizei=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLsizei=NotReallyATypeCross; fptools_cv_htype_sup_GLsizei=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLsizei testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLsizei=`cat conftestval`-else-  fptools_cv_htype_GLsizei=NotReallyAType; fptools_cv_htype_sup_GLsizei=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLsizei" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLsizei" >&5-$as_echo "$fptools_cv_htype_GLsizei" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLSIZEI $fptools_cv_htype_GLsizei-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLenum" >&5-$as_echo_n "checking Haskell type for GLenum... " >&6; }-if ${fptools_cv_htype_GLenum+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLenum=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLenum=NotReallyATypeCross; fptools_cv_htype_sup_GLenum=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLenum testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLenum=`cat conftestval`-else-  fptools_cv_htype_GLenum=NotReallyAType; fptools_cv_htype_sup_GLenum=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLenum" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLenum" >&5-$as_echo "$fptools_cv_htype_GLenum" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLENUM $fptools_cv_htype_GLenum-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLbitfield" >&5-$as_echo_n "checking Haskell type for GLbitfield... " >&6; }-if ${fptools_cv_htype_GLbitfield+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLbitfield=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLbitfield=NotReallyATypeCross; fptools_cv_htype_sup_GLbitfield=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLbitfield testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLbitfield=`cat conftestval`-else-  fptools_cv_htype_GLbitfield=NotReallyAType; fptools_cv_htype_sup_GLbitfield=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLbitfield" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLbitfield" >&5-$as_echo "$fptools_cv_htype_GLbitfield" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLBITFIELD $fptools_cv_htype_GLbitfield-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLfloat" >&5-$as_echo_n "checking Haskell type for GLfloat... " >&6; }-if ${fptools_cv_htype_GLfloat+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLfloat=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLfloat=NotReallyATypeCross; fptools_cv_htype_sup_GLfloat=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLfloat testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLfloat=`cat conftestval`-else-  fptools_cv_htype_GLfloat=NotReallyAType; fptools_cv_htype_sup_GLfloat=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLfloat" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLfloat" >&5-$as_echo "$fptools_cv_htype_GLfloat" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLFLOAT $fptools_cv_htype_GLfloat-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLclampf" >&5-$as_echo_n "checking Haskell type for GLclampf... " >&6; }-if ${fptools_cv_htype_GLclampf+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLclampf=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLclampf=NotReallyATypeCross; fptools_cv_htype_sup_GLclampf=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLclampf testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLclampf=`cat conftestval`-else-  fptools_cv_htype_GLclampf=NotReallyAType; fptools_cv_htype_sup_GLclampf=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLclampf" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLclampf" >&5-$as_echo "$fptools_cv_htype_GLclampf" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLCLAMPF $fptools_cv_htype_GLclampf-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLdouble" >&5-$as_echo_n "checking Haskell type for GLdouble... " >&6; }-if ${fptools_cv_htype_GLdouble+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLdouble=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLdouble=NotReallyATypeCross; fptools_cv_htype_sup_GLdouble=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLdouble testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLdouble=`cat conftestval`-else-  fptools_cv_htype_GLdouble=NotReallyAType; fptools_cv_htype_sup_GLdouble=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLdouble" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLdouble" >&5-$as_echo "$fptools_cv_htype_GLdouble" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLDOUBLE $fptools_cv_htype_GLdouble-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLclampd" >&5-$as_echo_n "checking Haskell type for GLclampd... " >&6; }-if ${fptools_cv_htype_GLclampd+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLclampd=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLclampd=NotReallyATypeCross; fptools_cv_htype_sup_GLclampd=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLclampd testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLclampd=`cat conftestval`-else-  fptools_cv_htype_GLclampd=NotReallyAType; fptools_cv_htype_sup_GLclampd=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLclampd" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLclampd" >&5-$as_echo "$fptools_cv_htype_GLclampd" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLCLAMPD $fptools_cv_htype_GLclampd-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi---# cruel hack for ancient Windows headers-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for char" >&5-$as_echo_n "checking Haskell type for char... " >&6; }-if ${fptools_cv_htype_char+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_char=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_char=NotReallyATypeCross; fptools_cv_htype_sup_char=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef char testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_char=`cat conftestval`-else-  fptools_cv_htype_char=NotReallyAType; fptools_cv_htype_sup_char=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_char" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_char" >&5-$as_echo "$fptools_cv_htype_char" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_CHAR $fptools_cv_htype_char-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLchar" >&5-$as_echo_n "checking Haskell type for GLchar... " >&6; }-if ${fptools_cv_htype_GLchar+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLchar=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLchar=NotReallyATypeCross; fptools_cv_htype_sup_GLchar=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLchar testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLchar=`cat conftestval`-else-  fptools_cv_htype_GLchar=$fptools_cv_htype_char-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLchar" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLchar" >&5-$as_echo "$fptools_cv_htype_GLchar" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLCHAR $fptools_cv_htype_GLchar-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi---# ... and a similar hack-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for ptrdiff_t" >&5-$as_echo_n "checking Haskell type for ptrdiff_t... " >&6; }-if ${fptools_cv_htype_ptrdiff_t+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_ptrdiff_t=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_ptrdiff_t=NotReallyATypeCross; fptools_cv_htype_sup_ptrdiff_t=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef ptrdiff_t testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_ptrdiff_t=`cat conftestval`-else-  fptools_cv_htype_ptrdiff_t=NotReallyAType; fptools_cv_htype_sup_ptrdiff_t=no-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_ptrdiff_t" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_ptrdiff_t" >&5-$as_echo "$fptools_cv_htype_ptrdiff_t" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_PTRDIFF_T $fptools_cv_htype_ptrdiff_t-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLintptr" >&5-$as_echo_n "checking Haskell type for GLintptr... " >&6; }-if ${fptools_cv_htype_GLintptr+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLintptr=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLintptr=NotReallyATypeCross; fptools_cv_htype_sup_GLintptr=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLintptr testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLintptr=`cat conftestval`-else-  fptools_cv_htype_GLintptr=$fptools_cv_htype_ptrdiff_t-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLintptr" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLintptr" >&5-$as_echo "$fptools_cv_htype_GLintptr" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLINTPTR $fptools_cv_htype_GLintptr-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi--{ $as_echo "$as_me:${as_lineno-$LINENO}: checking Haskell type for GLsizeiptr" >&5-$as_echo_n "checking Haskell type for GLsizeiptr... " >&6; }-if ${fptools_cv_htype_GLsizeiptr+:} false; then :-  $as_echo_n "(cached) " >&6-else-  fptools_cv_htype_sup_GLsizeiptr=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-if test "$cross_compiling" = yes; then :-  fptools_cv_htype_GLsizeiptr=NotReallyATypeCross; fptools_cv_htype_sup_GLsizeiptr=no-else-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext-/* end confdefs.h.  */-#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef GLsizeiptr testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}-_ACEOF-if ac_fn_c_try_run "$LINENO"; then :-  fptools_cv_htype_GLsizeiptr=`cat conftestval`-else-  fptools_cv_htype_GLsizeiptr=$fptools_cv_htype_ptrdiff_t-fi-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \-  conftest.$ac_objext conftest.beam conftest.$ac_ext-fi--CPPFLAGS="$fp_check_htype_save_cppflags"-fi- if test "$fptools_cv_htype_sup_GLsizeiptr" = yes; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $fptools_cv_htype_GLsizeiptr" >&5-$as_echo "$fptools_cv_htype_GLsizeiptr" >&6; }--cat >>confdefs.h <<_ACEOF-#define HTYPE_GLSIZEIPTR $fptools_cv_htype_GLsizeiptr-_ACEOF--else-  { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5-$as_echo "not supported" >&6; }-fi----cat >>confdefs.h <<_ACEOF-#define GLU_CFLAGS `echo '' $GLU_CFLAGS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'`-_ACEOF----cat >>confdefs.h <<_ACEOF-#define GLU_LIBS `echo '' $GLU_LIBS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'`-_ACEOF----cat >>confdefs.h <<_ACEOF-#define GLU_FRAMEWORKS `echo '' $GLU_FRAMEWORKS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'`-_ACEOF---fi--if test x"$GL_BUILD_PACKAGE" = xyes; then-  BUILD_PACKAGE_BOOL=True-else-  BUILD_PACKAGE_BOOL=False-fi---case "$host" in-*-mingw32) CALLCONV=stdcall ;;-*)	CALLCONV=ccall ;;-esac---ac_config_files="$ac_config_files OpenGL.buildinfo"--cat >confcache <<\_ACEOF-# This file is a shell script that caches the results of configure-# tests run on this system so they can be shared between configure-# scripts and configure runs, see configure's option --config-cache.-# It is not useful on other systems.  If it contains results you don't-# want to keep, you may remove or edit it.-#-# config.status only pays attention to the cache file if you give it-# the --recheck option to rerun configure.-#-# `ac_cv_env_foo' variables (set or unset) will be overridden when-# loading this file, other *unset* `ac_cv_foo' will be assigned the-# following values.--_ACEOF--# The following way of writing the cache mishandles newlines in values,-# but we know of no workaround that is simple, portable, and efficient.-# So, we kill variables containing newlines.-# Ultrix sh set writes to stderr and can't be redirected directly,-# and sets the high bit in the cache file unless we assign to the vars.-(-  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do-    eval ac_val=\$$ac_var-    case $ac_val in #(-    *${as_nl}*)-      case $ac_var in #(-      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;-      esac-      case $ac_var in #(-      _ | IFS | as_nl) ;; #(-      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(-      *) { eval $ac_var=; unset $ac_var;} ;;-      esac ;;-    esac-  done--  (set) 2>&1 |-    case $as_nl`(ac_space=' '; set) 2>&1` in #(-    *${as_nl}ac_space=\ *)-      # `set' does not quote correctly, so add quotes: double-quote-      # substitution turns \\\\ into \\, and sed turns \\ into \.-      sed -n \-	"s/'/'\\\\''/g;-	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"-      ;; #(-    *)-      # `set' quotes correctly as required by POSIX, so do not add quotes.-      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"-      ;;-    esac |-    sort-) |-  sed '-     /^ac_cv_env_/b end-     t clear-     :clear-     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/-     t end-     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/-     :end' >>confcache-if diff "$cache_file" confcache >/dev/null 2>&1; then :; else-  if test -w "$cache_file"; then-    if test "x$cache_file" != "x/dev/null"; then-      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5-$as_echo "$as_me: updating cache $cache_file" >&6;}-      if test ! -f "$cache_file" || test -h "$cache_file"; then-	cat confcache >"$cache_file"-      else-        case $cache_file in #(-        */* | ?:*)-	  mv -f confcache "$cache_file"$$ &&-	  mv -f "$cache_file"$$ "$cache_file" ;; #(-        *)-	  mv -f confcache "$cache_file" ;;-	esac-      fi-    fi-  else-    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5-$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}-  fi-fi-rm -f confcache--test "x$prefix" = xNONE && prefix=$ac_default_prefix-# Let make expand exec_prefix.-test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'--DEFS=-DHAVE_CONFIG_H--ac_libobjs=-ac_ltlibobjs=-U=-for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue-  # 1. Remove the extension, and $U if already installed.-  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'-  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`-  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR-  #    will be set to the directory where LIBOBJS objects are built.-  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"-  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'-done-LIBOBJS=$ac_libobjs--LTLIBOBJS=$ac_ltlibobjs----: "${CONFIG_STATUS=./config.status}"-ac_write_fail=0-ac_clean_files_save=$ac_clean_files-ac_clean_files="$ac_clean_files $CONFIG_STATUS"-{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5-$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}-as_write_fail=0-cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1-#! $SHELL-# Generated by $as_me.-# Run this file to recreate the current configuration.-# Compiler output produced by configure, useful for debugging-# configure, is in config.log if it exists.--debug=false-ac_cs_recheck=false-ac_cs_silent=false--SHELL=\${CONFIG_SHELL-$SHELL}-export SHELL-_ASEOF-cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1-## -------------------- ##-## M4sh Initialization. ##-## -------------------- ##--# Be more Bourne compatible-DUALCASE=1; export DUALCASE # for MKS sh-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :-  emulate sh-  NULLCMD=:-  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which-  # is contrary to our usage.  Disable this feature.-  alias -g '${1+"$@"}'='"$@"'-  setopt NO_GLOB_SUBST-else-  case `(set -o) 2>/dev/null` in #(-  *posix*) :-    set -o posix ;; #(-  *) :-     ;;-esac-fi---as_nl='-'-export as_nl-# Printing a long string crashes Solaris 7 /usr/bin/printf.-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo-# Prefer a ksh shell builtin over an external printf program on Solaris,-# but without wasting forks for bash or zsh.-if test -z "$BASH_VERSION$ZSH_VERSION" \-    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then-  as_echo='print -r --'-  as_echo_n='print -rn --'-elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then-  as_echo='printf %s\n'-  as_echo_n='printf %s'-else-  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then-    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'-    as_echo_n='/usr/ucb/echo -n'-  else-    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'-    as_echo_n_body='eval-      arg=$1;-      case $arg in #(-      *"$as_nl"*)-	expr "X$arg" : "X\\(.*\\)$as_nl";-	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;-      esac;-      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"-    '-    export as_echo_n_body-    as_echo_n='sh -c $as_echo_n_body as_echo'-  fi-  export as_echo_body-  as_echo='sh -c $as_echo_body as_echo'-fi--# The user is always right.-if test "${PATH_SEPARATOR+set}" != set; then-  PATH_SEPARATOR=:-  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {-    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||-      PATH_SEPARATOR=';'-  }-fi---# IFS-# We need space, tab and new line, in precisely that order.  Quoting is-# there to prevent editors from complaining about space-tab.-# (If _AS_PATH_WALK were called with IFS unset, it would disable word-# splitting by setting IFS to empty value.)-IFS=" ""	$as_nl"--# Find who we are.  Look in the path if we contain no directory separator.-as_myself=-case $0 in #((-  *[\\/]* ) as_myself=$0 ;;-  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break-  done-IFS=$as_save_IFS--     ;;-esac-# We did not find ourselves, most probably we were run as `sh COMMAND'-# in which case we are not to be found in the path.-if test "x$as_myself" = x; then-  as_myself=$0-fi-if test ! -f "$as_myself"; then-  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2-  exit 1-fi--# Unset variables that we do not need and which cause bugs (e.g. in-# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"-# suppresses any "Segmentation fault" message there.  '((' could-# trigger a bug in pdksh 5.2.14.-for as_var in BASH_ENV ENV MAIL MAILPATH-do eval test x\${$as_var+set} = xset \-  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :-done-PS1='$ '-PS2='> '-PS4='+ '--# NLS nuisances.-LC_ALL=C-export LC_ALL-LANGUAGE=C-export LANGUAGE--# CDPATH.-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH---# as_fn_error STATUS ERROR [LINENO LOG_FD]-# -----------------------------------------# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are-# provided, also output the error to LOG_FD, referencing LINENO. Then exit the-# script with STATUS, using 1 if that was 0.-as_fn_error ()-{-  as_status=$1; test $as_status -eq 0 && as_status=1-  if test "$4"; then-    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack-    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4-  fi-  $as_echo "$as_me: error: $2" >&2-  as_fn_exit $as_status-} # as_fn_error---# as_fn_set_status STATUS-# ------------------------# Set $? to STATUS, without forking.-as_fn_set_status ()-{-  return $1-} # as_fn_set_status--# as_fn_exit STATUS-# ------------------# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.-as_fn_exit ()-{-  set +e-  as_fn_set_status $1-  exit $1-} # as_fn_exit--# as_fn_unset VAR-# ----------------# Portably unset VAR.-as_fn_unset ()-{-  { eval $1=; unset $1;}-}-as_unset=as_fn_unset-# as_fn_append VAR VALUE-# -----------------------# Append the text in VALUE to the end of the definition contained in VAR. Take-# advantage of any shell optimizations that allow amortized linear growth over-# repeated appends, instead of the typical quadratic growth present in naive-# implementations.-if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :-  eval 'as_fn_append ()-  {-    eval $1+=\$2-  }'-else-  as_fn_append ()-  {-    eval $1=\$$1\$2-  }-fi # as_fn_append--# as_fn_arith ARG...-# -------------------# Perform arithmetic evaluation on the ARGs, and store the result in the-# global $as_val. Take advantage of shells that can avoid forks. The arguments-# must be portable across $(()) and expr.-if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :-  eval 'as_fn_arith ()-  {-    as_val=$(( $* ))-  }'-else-  as_fn_arith ()-  {-    as_val=`expr "$@" || test $? -eq 1`-  }-fi # as_fn_arith---if expr a : '\(a\)' >/dev/null 2>&1 &&-   test "X`expr 00001 : '.*\(...\)'`" = X001; then-  as_expr=expr-else-  as_expr=false-fi--if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then-  as_basename=basename-else-  as_basename=false-fi--if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then-  as_dirname=dirname-else-  as_dirname=false-fi--as_me=`$as_basename -- "$0" ||-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \-	 X"$0" : 'X\(//\)$' \| \-	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X/"$0" |-    sed '/^.*\/\([^/][^/]*\)\/*$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`--# Avoid depending upon Character Ranges.-as_cr_letters='abcdefghijklmnopqrstuvwxyz'-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'-as_cr_Letters=$as_cr_letters$as_cr_LETTERS-as_cr_digits='0123456789'-as_cr_alnum=$as_cr_Letters$as_cr_digits--ECHO_C= ECHO_N= ECHO_T=-case `echo -n x` in #(((((--n*)-  case `echo 'xy\c'` in-  *c*) ECHO_T='	';;	# ECHO_T is single tab character.-  xy)  ECHO_C='\c';;-  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null-       ECHO_T='	';;-  esac;;-*)-  ECHO_N='-n';;-esac--rm -f conf$$ conf$$.exe conf$$.file-if test -d conf$$.dir; then-  rm -f conf$$.dir/conf$$.file-else-  rm -f conf$$.dir-  mkdir conf$$.dir 2>/dev/null-fi-if (echo >conf$$.file) 2>/dev/null; then-  if ln -s conf$$.file conf$$ 2>/dev/null; then-    as_ln_s='ln -s'-    # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -p'.-    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||-      as_ln_s='cp -p'-  elif ln conf$$.file conf$$ 2>/dev/null; then-    as_ln_s=ln-  else-    as_ln_s='cp -p'-  fi-else-  as_ln_s='cp -p'-fi-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file-rmdir conf$$.dir 2>/dev/null---# as_fn_mkdir_p-# --------------# Create "$as_dir" as a directory, including parents if necessary.-as_fn_mkdir_p ()-{--  case $as_dir in #(-  -*) as_dir=./$as_dir;;-  esac-  test -d "$as_dir" || eval $as_mkdir_p || {-    as_dirs=-    while :; do-      case $as_dir in #(-      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(-      *) as_qdir=$as_dir;;-      esac-      as_dirs="'$as_qdir' $as_dirs"-      as_dir=`$as_dirname -- "$as_dir" ||-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \-	 X"$as_dir" : 'X\(//\)[^/]' \| \-	 X"$as_dir" : 'X\(//\)$' \| \-	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_dir" |-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)[^/].*/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`-      test -d "$as_dir" && break-    done-    test -z "$as_dirs" || eval "mkdir $as_dirs"-  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"---} # as_fn_mkdir_p-if mkdir -p . 2>/dev/null; then-  as_mkdir_p='mkdir -p "$as_dir"'-else-  test -d ./-p && rmdir ./-p-  as_mkdir_p=false-fi--if test -x / >/dev/null 2>&1; then-  as_test_x='test -x'-else-  if ls -dL / >/dev/null 2>&1; then-    as_ls_L_option=L-  else-    as_ls_L_option=-  fi-  as_test_x='-    eval sh -c '\''-      if test -d "$1"; then-	test -d "$1/.";-      else-	case $1 in #(-	-*)set "./$1";;-	esac;-	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((-	???[sx]*):;;*)false;;esac;fi-    '\'' sh-  '-fi-as_executable_p=$as_test_x--# Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"--# Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"---exec 6>&1-## ----------------------------------- ##-## Main body of $CONFIG_STATUS script. ##-## ----------------------------------- ##-_ASEOF-test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# Save the log message, to keep $0 and so on meaningful, and to-# report actual input values of CONFIG_FILES etc. instead of their-# values after options handling.-ac_log="-This file was extended by Haskell OpenGL package $as_me 2.2.3.0, which was-generated by GNU Autoconf 2.68.  Invocation command line was--  CONFIG_FILES    = $CONFIG_FILES-  CONFIG_HEADERS  = $CONFIG_HEADERS-  CONFIG_LINKS    = $CONFIG_LINKS-  CONFIG_COMMANDS = $CONFIG_COMMANDS-  $ $0 $@--on `(hostname || uname -n) 2>/dev/null | sed 1q`-"--_ACEOF--case $ac_config_files in *"-"*) set x $ac_config_files; shift; ac_config_files=$*;;-esac--case $ac_config_headers in *"-"*) set x $ac_config_headers; shift; ac_config_headers=$*;;-esac---cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-# Files that config.status was made for.-config_files="$ac_config_files"-config_headers="$ac_config_headers"--_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-ac_cs_usage="\-\`$as_me' instantiates files and other configuration actions-from templates according to the current configuration.  Unless the files-and actions are specified as TAGs, all are instantiated by default.--Usage: $0 [OPTION]... [TAG]...--  -h, --help       print this help, then exit-  -V, --version    print version number and configuration settings, then exit-      --config     print configuration, then exit-  -q, --quiet, --silent-                   do not print progress messages-  -d, --debug      don't remove temporary files-      --recheck    update $as_me by reconfiguring in the same conditions-      --file=FILE[:TEMPLATE]-                   instantiate the configuration file FILE-      --header=FILE[:TEMPLATE]-                   instantiate the configuration header FILE--Configuration files:-$config_files--Configuration headers:-$config_headers--Report bugs to <sven.panne@aedion.de>."--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"-ac_cs_version="\\-Haskell OpenGL package config.status 2.2.3.0-configured by $0, generated by GNU Autoconf 2.68,-  with options \\"\$ac_cs_config\\"--Copyright (C) 2010 Free Software Foundation, Inc.-This config.status script is free software; the Free Software Foundation-gives unlimited permission to copy, distribute and modify it."--ac_pwd='$ac_pwd'-srcdir='$srcdir'-test -n "\$AWK" || AWK=awk-_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# The default lists apply if the user does not specify any file.-ac_need_defaults=:-while test $# != 0-do-  case $1 in-  --*=?*)-    ac_option=`expr "X$1" : 'X\([^=]*\)='`-    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`-    ac_shift=:-    ;;-  --*=)-    ac_option=`expr "X$1" : 'X\([^=]*\)='`-    ac_optarg=-    ac_shift=:-    ;;-  *)-    ac_option=$1-    ac_optarg=$2-    ac_shift=shift-    ;;-  esac--  case $ac_option in-  # Handling of the options.-  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)-    ac_cs_recheck=: ;;-  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )-    $as_echo "$ac_cs_version"; exit ;;-  --config | --confi | --conf | --con | --co | --c )-    $as_echo "$ac_cs_config"; exit ;;-  --debug | --debu | --deb | --de | --d | -d )-    debug=: ;;-  --file | --fil | --fi | --f )-    $ac_shift-    case $ac_optarg in-    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;-    '') as_fn_error $? "missing file argument" ;;-    esac-    as_fn_append CONFIG_FILES " '$ac_optarg'"-    ac_need_defaults=false;;-  --header | --heade | --head | --hea )-    $ac_shift-    case $ac_optarg in-    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;-    esac-    as_fn_append CONFIG_HEADERS " '$ac_optarg'"-    ac_need_defaults=false;;-  --he | --h)-    # Conflict between --help and --header-    as_fn_error $? "ambiguous option: \`$1'-Try \`$0 --help' for more information.";;-  --help | --hel | -h )-    $as_echo "$ac_cs_usage"; exit ;;-  -q | -quiet | --quiet | --quie | --qui | --qu | --q \-  | -silent | --silent | --silen | --sile | --sil | --si | --s)-    ac_cs_silent=: ;;--  # This is an error.-  -*) as_fn_error $? "unrecognized option: \`$1'-Try \`$0 --help' for more information." ;;--  *) as_fn_append ac_config_targets " $1"-     ac_need_defaults=false ;;--  esac-  shift-done--ac_configure_extra_args=--if $ac_cs_silent; then-  exec 6>/dev/null-  ac_configure_extra_args="$ac_configure_extra_args --silent"-fi--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-if \$ac_cs_recheck; then-  set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion-  shift-  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6-  CONFIG_SHELL='$SHELL'-  export CONFIG_SHELL-  exec "\$@"-fi--_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-exec 5>>config.log-{-  echo-  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX-## Running $as_me. ##-_ASBOX-  $as_echo "$ac_log"-} >&5--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1--# Handling of arguments.-for ac_config_target in $ac_config_targets-do-  case $ac_config_target in-    "include/HsOpenGLConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsOpenGLConfig.h" ;;-    "include/HsOpenGL.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsOpenGL.h" ;;-    "OpenGL.buildinfo") CONFIG_FILES="$CONFIG_FILES OpenGL.buildinfo" ;;--  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;-  esac-done---# If the user did not use the arguments to specify the items to instantiate,-# then the envvar interface is used.  Set only those that are not.-# We use the long form for the default assignment because of an extremely-# bizarre bug on SunOS 4.1.3.-if $ac_need_defaults; then-  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files-  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers-fi--# Have a temporary directory for convenience.  Make it in the build tree-# simply because there is no reason against having it here, and in addition,-# creating and moving files from /tmp can sometimes cause problems.-# Hook for its removal unless debugging.-# Note that there is a small window in which the directory will not be cleaned:-# after its creation but before its name has been assigned to `$tmp'.-$debug ||-{-  tmp= ac_tmp=-  trap 'exit_status=$?-  : "${ac_tmp:=$tmp}"-  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status-' 0-  trap 'as_fn_exit 1' 1 2 13 15-}-# Create a (secure) tmp directory for tmp files.--{-  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&-  test -d "$tmp"-}  ||-{-  tmp=./conf$$-$RANDOM-  (umask 077 && mkdir "$tmp")-} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5-ac_tmp=$tmp--# Set up the scripts for CONFIG_FILES section.-# No need to generate them if there are no CONFIG_FILES.-# This happens for instance with `./config.status config.h'.-if test -n "$CONFIG_FILES"; then---ac_cr=`echo X | tr X '\015'`-# On cygwin, bash can eat \r inside `` if the user requested igncr.-# But we know of no other shell where ac_cr would be empty at this-# point, so we can use a bashism as a fallback.-if test "x$ac_cr" = x; then-  eval ac_cr=\$\'\\r\'-fi-ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`-if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then-  ac_cs_awk_cr='\\r'-else-  ac_cs_awk_cr=$ac_cr-fi--echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&-_ACEOF---{-  echo "cat >conf$$subs.awk <<_ACEOF" &&-  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&-  echo "_ACEOF"-} >conf$$subs.sh ||-  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5-ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`-ac_delim='%!_!# '-for ac_last_try in false false false false false :; do-  . ./conf$$subs.sh ||-    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5--  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`-  if test $ac_delim_n = $ac_delim_num; then-    break-  elif $ac_last_try; then-    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5-  else-    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "-  fi-done-rm -f conf$$subs.sh--cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&-_ACEOF-sed -n '-h-s/^/S["/; s/!.*/"]=/-p-g-s/^[^!]*!//-:repl-t repl-s/'"$ac_delim"'$//-t delim-:nl-h-s/\(.\{148\}\)..*/\1/-t more1-s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/-p-n-b repl-:more1-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t nl-:delim-h-s/\(.\{148\}\)..*/\1/-t more2-s/["\\]/\\&/g; s/^/"/; s/$/"/-p-b-:more2-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t delim-' <conf$$subs.awk | sed '-/^[^""]/{-  N-  s/\n//-}-' >>$CONFIG_STATUS || ac_write_fail=1-rm -f conf$$subs.awk-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-_ACAWK-cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&-  for (key in S) S_is_set[key] = 1-  FS = ""--}-{-  line = $ 0-  nfields = split(line, field, "@")-  substed = 0-  len = length(field[1])-  for (i = 2; i < nfields; i++) {-    key = field[i]-    keylen = length(key)-    if (S_is_set[key]) {-      value = S[key]-      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)-      len += length(value) + length(field[++i])-      substed = 1-    } else-      len += 1 + keylen-  }--  print line-}--_ACAWK-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then-  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"-else-  cat-fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \-  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5-_ACEOF--# VPATH may cause trouble with some makes, so we remove sole $(srcdir),-# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and-# trailing colons and then remove the whole line if VPATH becomes empty-# (actually we leave an empty line to preserve line numbers).-if test "x$srcdir" = x.; then-  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{-h-s///-s/^/:/-s/[	 ]*$/:/-s/:\$(srcdir):/:/g-s/:\${srcdir}:/:/g-s/:@srcdir@:/:/g-s/^:*//-s/:*$//-x-s/\(=[	 ]*\).*/\1/-G-s/\n//-s/^[^=]*=[	 ]*$//-}'-fi--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-fi # test -n "$CONFIG_FILES"--# Set up the scripts for CONFIG_HEADERS section.-# No need to generate them if there are no CONFIG_HEADERS.-# This happens for instance with `./config.status Makefile'.-if test -n "$CONFIG_HEADERS"; then-cat >"$ac_tmp/defines.awk" <<\_ACAWK ||-BEGIN {-_ACEOF--# Transform confdefs.h into an awk script `defines.awk', embedded as-# here-document in config.status, that substitutes the proper values into-# config.h.in to produce config.h.--# Create a delimiter string that does not exist in confdefs.h, to ease-# handling of long lines.-ac_delim='%!_!# '-for ac_last_try in false false :; do-  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`-  if test -z "$ac_tt"; then-    break-  elif $ac_last_try; then-    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5-  else-    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "-  fi-done--# For the awk script, D is an array of macro values keyed by name,-# likewise P contains macro parameters if any.  Preserve backslash-# newline sequences.--ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*-sed -n '-s/.\{148\}/&'"$ac_delim"'/g-t rset-:rset-s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /-t def-d-:def-s/\\$//-t bsnl-s/["\\]/\\&/g-s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\-D["\1"]=" \3"/p-s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p-d-:bsnl-s/["\\]/\\&/g-s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\-D["\1"]=" \3\\\\\\n"\\/p-t cont-s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p-t cont-d-:cont-n-s/.\{148\}/&'"$ac_delim"'/g-t clear-:clear-s/\\$//-t bsnlc-s/["\\]/\\&/g; s/^/"/; s/$/"/p-d-:bsnlc-s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p-b cont-' <confdefs.h | sed '-s/'"$ac_delim"'/"\\\-"/g' >>$CONFIG_STATUS || ac_write_fail=1--cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-  for (key in D) D_is_set[key] = 1-  FS = ""-}-/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {-  line = \$ 0-  split(line, arg, " ")-  if (arg[1] == "#") {-    defundef = arg[2]-    mac1 = arg[3]-  } else {-    defundef = substr(arg[1], 2)-    mac1 = arg[2]-  }-  split(mac1, mac2, "(") #)-  macro = mac2[1]-  prefix = substr(line, 1, index(line, defundef) - 1)-  if (D_is_set[macro]) {-    # Preserve the white space surrounding the "#".-    print prefix "define", macro P[macro] D[macro]-    next-  } else {-    # Replace #undef with comments.  This is necessary, for example,-    # in the case of _POSIX_SOURCE, which is predefined and required-    # on some systems where configure will not decide to define it.-    if (defundef == "undef") {-      print "/*", prefix defundef, macro, "*/"-      next-    }-  }-}-{ print }-_ACAWK-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5-fi # test -n "$CONFIG_HEADERS"---eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    "-shift-for ac_tag-do-  case $ac_tag in-  :[FHLC]) ac_mode=$ac_tag; continue;;-  esac-  case $ac_mode$ac_tag in-  :[FHL]*:*);;-  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;-  :[FH]-) ac_tag=-:-;;-  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;-  esac-  ac_save_IFS=$IFS-  IFS=:-  set x $ac_tag-  IFS=$ac_save_IFS-  shift-  ac_file=$1-  shift--  case $ac_mode in-  :L) ac_source=$1;;-  :[FH])-    ac_file_inputs=-    for ac_f-    do-      case $ac_f in-      -) ac_f="$ac_tmp/stdin";;-      *) # Look for the file first in the build tree, then in the source tree-	 # (if the path is not absolute).  The absolute path cannot be DOS-style,-	 # because $ac_f cannot contain `:'.-	 test -f "$ac_f" ||-	   case $ac_f in-	   [\\/$]*) false;;-	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;-	   esac ||-	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;-      esac-      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac-      as_fn_append ac_file_inputs " '$ac_f'"-    done--    # Let's still pretend it is `configure' which instantiates (i.e., don't-    # use $as_me), people would be surprised to read:-    #    /* config.h.  Generated by config.status.  */-    configure_input='Generated from '`-	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'-	`' by configure.'-    if test x"$ac_file" != x-; then-      configure_input="$ac_file.  $configure_input"-      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5-$as_echo "$as_me: creating $ac_file" >&6;}-    fi-    # Neutralize special characters interpreted by sed in replacement strings.-    case $configure_input in #(-    *\&* | *\|* | *\\* )-       ac_sed_conf_input=`$as_echo "$configure_input" |-       sed 's/[\\\\&|]/\\\\&/g'`;; #(-    *) ac_sed_conf_input=$configure_input;;-    esac--    case $ac_tag in-    *:-:* | *:-) cat >"$ac_tmp/stdin" \-      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;-    esac-    ;;-  esac--  ac_dir=`$as_dirname -- "$ac_file" ||-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \-	 X"$ac_file" : 'X\(//\)[^/]' \| \-	 X"$ac_file" : 'X\(//\)$' \| \-	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$ac_file" |-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)[^/].*/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`-  as_dir="$ac_dir"; as_fn_mkdir_p-  ac_builddir=.--case "$ac_dir" in-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;-*)-  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`-  # A ".." for each directory in $ac_dir_suffix.-  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`-  case $ac_top_builddir_sub in-  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;-  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;-  esac ;;-esac-ac_abs_top_builddir=$ac_pwd-ac_abs_builddir=$ac_pwd$ac_dir_suffix-# for backward compatibility:-ac_top_builddir=$ac_top_build_prefix--case $srcdir in-  .)  # We are building in place.-    ac_srcdir=.-    ac_top_srcdir=$ac_top_builddir_sub-    ac_abs_top_srcdir=$ac_pwd ;;-  [\\/]* | ?:[\\/]* )  # Absolute name.-    ac_srcdir=$srcdir$ac_dir_suffix;-    ac_top_srcdir=$srcdir-    ac_abs_top_srcdir=$srcdir ;;-  *) # Relative name.-    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix-    ac_top_srcdir=$ac_top_build_prefix$srcdir-    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;-esac-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix---  case $ac_mode in-  :F)-  #-  # CONFIG_FILE-  #--_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# If the template does not know about datarootdir, expand it.-# FIXME: This hack should be removed a few years after 2.60.-ac_datarootdir_hack=; ac_datarootdir_seen=-ac_sed_dataroot='-/datarootdir/ {-  p-  q-}-/@datadir@/p-/@docdir@/p-/@infodir@/p-/@localedir@/p-/@mandir@/p'-case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in-*datarootdir*) ac_datarootdir_seen=yes;;-*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)-  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5-$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}-_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-  ac_datarootdir_hack='-  s&@datadir@&$datadir&g-  s&@docdir@&$docdir&g-  s&@infodir@&$infodir&g-  s&@localedir@&$localedir&g-  s&@mandir@&$mandir&g-  s&\\\${datarootdir}&$datarootdir&g' ;;-esac-_ACEOF--# Neutralize VPATH when `$srcdir' = `.'.-# Shell code in configure.ac might set extrasub.-# FIXME: do we really want to maintain this feature?-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-ac_sed_extra="$ac_vpsub-$extrasub-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-:t-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b-s|@configure_input@|$ac_sed_conf_input|;t t-s&@top_builddir@&$ac_top_builddir_sub&;t t-s&@top_build_prefix@&$ac_top_build_prefix&;t t-s&@srcdir@&$ac_srcdir&;t t-s&@abs_srcdir@&$ac_abs_srcdir&;t t-s&@top_srcdir@&$ac_top_srcdir&;t t-s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t-s&@builddir@&$ac_builddir&;t t-s&@abs_builddir@&$ac_abs_builddir&;t t-s&@abs_top_builddir@&$ac_abs_top_builddir&;t t-$ac_datarootdir_hack-"-eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \-  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5--test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&-  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&-  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \-      "$ac_tmp/out"`; test -z "$ac_out"; } &&-  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined.  Please make sure it is defined" >&5-$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined.  Please make sure it is defined" >&2;}--  rm -f "$ac_tmp/stdin"-  case $ac_file in-  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;-  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;-  esac \-  || as_fn_error $? "could not create $ac_file" "$LINENO" 5- ;;-  :H)-  #-  # CONFIG_HEADER-  #-  if test x"$ac_file" != x-; then-    {-      $as_echo "/* $configure_input  */" \-      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"-    } >"$ac_tmp/config.h" \-      || as_fn_error $? "could not create $ac_file" "$LINENO" 5-    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then-      { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5-$as_echo "$as_me: $ac_file is unchanged" >&6;}-    else-      rm -f "$ac_file"-      mv "$ac_tmp/config.h" "$ac_file" \-	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5-    fi-  else-    $as_echo "/* $configure_input  */" \-      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \-      || as_fn_error $? "could not create -" "$LINENO" 5-  fi- ;;---  esac--done # for ac_tag---as_fn_exit 0-_ACEOF-ac_clean_files=$ac_clean_files_save--test $ac_write_fail = 0 ||-  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5---# configure is writing to config.log, and then calls config.status.-# config.status does its own redirection, appending to config.log.-# Unfortunately, on DOS this fails, as config.log is still kept open-# by configure, so config.status won't be able to write to it; its-# output is simply discarded.  So we exec the FD to /dev/null,-# effectively closing config.log, so it can be properly (re)opened and-# appended to by config.status.  When coming back to configure, we-# need to make the FD available again.-if test "$no_create" != yes; then-  ac_cs_success=:-  ac_config_status_args=-  test "$silent" = yes &&-    ac_config_status_args="$ac_config_status_args --quiet"-  exec 5>/dev/null-  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false-  exec 5>>config.log-  # Use ||, not &&, to avoid exiting from the if with $? = 1, which-  # would make configure fail if this is the last instruction.-  $ac_cs_success || as_fn_exit 1-fi-if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then-  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5-$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}-fi-
− configure.ac 
@@ -1,97 +0,0 @@-AC_INIT([Haskell OpenGL package], [2.2.3.0], [sven.panne@aedion.de], [OpenGL])--# Safety check: Ensure that we are in the correct source directory.-AC_CONFIG_SRCDIR([include/HsOpenGL.h.in])--# The first file mentioned below will be generated by autoheader and contains-# defines which are needed during package build time only. The second header-# contains all kinds of stuff which is needed for using this package.-AC_CONFIG_HEADERS([include/HsOpenGLConfig.h include/HsOpenGL.h])--# we do not really care about this here, but this avoids a warning about an-# unknown option-FP_ARG_COMPILER--# We set this to "yes" later when we have found OpenGL libs and headers.-GL_BUILD_PACKAGE=no--# Shall we build this package at all?-FP_ARG_OPENGL--if test x"$enable_opengl" != xno; then--# Check for OpenGL include paths and libraries-FP_CHECK_GLU--if test x"$GLU_LIBS" = xno; then-  AC_MSG_FAILURE([no OpenGL library found, so this package cannot be built])-fi--# check for OpenGL include files-gl_found_header=no-glu_found_header=no-fp_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-AC_CHECK_HEADERS([GL/gl.h OpenGL/gl.h], [gl_found_header=yes])-AC_CHECK_HEADERS([GL/glu.h OpenGL/glu.h], [glu_found_header=yes])-CPPFLAGS="$fp_save_cppflags"--if test x"$gl_found_header" = xno || test x"$glu_found_header" = xno; then-  AC_MSG_FAILURE([no OpenGL headers found, so this package cannot be built])-fi--GL_BUILD_PACKAGE=yes--FPTOOLS_CHECK_HTYPE([GLboolean])-FPTOOLS_CHECK_HTYPE([GLbyte])-FPTOOLS_CHECK_HTYPE([GLubyte])-FPTOOLS_CHECK_HTYPE([GLshort])-FPTOOLS_CHECK_HTYPE([GLushort])-FPTOOLS_CHECK_HTYPE([GLint])-FPTOOLS_CHECK_HTYPE([GLuint])-FPTOOLS_CHECK_HTYPE([GLsizei])-FPTOOLS_CHECK_HTYPE([GLenum])-FPTOOLS_CHECK_HTYPE([GLbitfield])-FPTOOLS_CHECK_HTYPE([GLfloat])-FPTOOLS_CHECK_HTYPE([GLclampf])-FPTOOLS_CHECK_HTYPE([GLdouble])-FPTOOLS_CHECK_HTYPE([GLclampd])--# cruel hack for ancient Windows headers-FPTOOLS_CHECK_HTYPE([char])-FPTOOLS_CHECK_HTYPE([GLchar], [$fptools_cv_htype_char])--# ... and a similar hack-FPTOOLS_CHECK_HTYPE([ptrdiff_t])-FPTOOLS_CHECK_HTYPE([GLintptr], [$fptools_cv_htype_ptrdiff_t])-FPTOOLS_CHECK_HTYPE([GLsizeiptr], [$fptools_cv_htype_ptrdiff_t])--AC_DEFINE_UNQUOTED([GLU_CFLAGS],-  [`echo '' $GLU_CFLAGS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`],-  [C flags for GLU, as a list of string literals.])--AC_DEFINE_UNQUOTED([GLU_LIBS],-  [`echo '' $GLU_LIBS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`],-  [Library flags for GLU, as a list of string literals.])--AC_DEFINE_UNQUOTED([GLU_FRAMEWORKS],-  [`echo '' $GLU_FRAMEWORKS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`],-  [Framework flags for GLU, as a list of string literals.])--fi--if test x"$GL_BUILD_PACKAGE" = xyes; then-  BUILD_PACKAGE_BOOL=True-else-  BUILD_PACKAGE_BOOL=False-fi-AC_SUBST([BUILD_PACKAGE_BOOL])--case "$host" in-*-mingw32) CALLCONV=stdcall ;;-*)	CALLCONV=ccall ;;-esac-AC_SUBST([CALLCONV])--AC_CONFIG_FILES([OpenGL.buildinfo])-AC_OUTPUT
− include/HsOpenGL.h 
@@ -1,45 +0,0 @@-/* include/HsOpenGL.h.  Generated from HsOpenGL.h.in by configure.  */-/* ------------------------------------------------------------------------------ *- * Module      :  C support for Graphics.Rendering.OpenGL- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)- * - * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional- * Portability :  portable- *- * -------------------------------------------------------------------------- */--#ifndef HSOPENGL_H-#define HSOPENGL_H--/* Define to 1 if native OpenGL should be used on Mac OS X */-#define USE_QUARTZ_OPENGL 1--#if defined(_WIN32) || defined(__CYGWIN__)--/* for the prototype of wglGetProcAddress */-#include <windows.h>-#include <GL/glu.h>--#elif defined(USE_QUARTZ_OPENGL)--#include <OpenGL/glu.h>--#else--/* Hmmm, this seems to be necessary to get a prototype for glXGetProcAddressARB-   when Mesa is used. Strange... */-#ifndef GLX_GLXEXT_PROTOTYPES-#define GLX_GLXEXT_PROTOTYPES-#endif--#include <GL/glu.h>-#include <GL/glx.h>--#endif--extern void* hs_OpenGL_getProcAddress(char* procName);--#endif
− include/HsOpenGL.h.in 
@@ -1,44 +0,0 @@-/* ------------------------------------------------------------------------------ *- * Module      :  C support for Graphics.Rendering.OpenGL- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)- * - * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional- * Portability :  portable- *- * -------------------------------------------------------------------------- */--#ifndef HSOPENGL_H-#define HSOPENGL_H--/* Define to 1 if native OpenGL should be used on Mac OS X */-#undef USE_QUARTZ_OPENGL--#if defined(_WIN32) || defined(__CYGWIN__)--/* for the prototype of wglGetProcAddress */-#include <windows.h>-#include <GL/glu.h>--#elif defined(USE_QUARTZ_OPENGL)--#include <OpenGL/glu.h>--#else--/* Hmmm, this seems to be necessary to get a prototype for glXGetProcAddressARB-   when Mesa is used. Strange... */-#ifndef GLX_GLXEXT_PROTOTYPES-#define GLX_GLXEXT_PROTOTYPES-#endif--#include <GL/glu.h>-#include <GL/glx.h>--#endif--extern void* hs_OpenGL_getProcAddress(char* procName);--#endif
− include/HsOpenGLConfig.h.in 
@@ -1,133 +0,0 @@-/* include/HsOpenGLConfig.h.in.  Generated from configure.ac by autoheader.  */--/* C flags for GLU, as a list of string literals. */-#undef GLU_CFLAGS--/* Framework flags for GLU, as a list of string literals. */-#undef GLU_FRAMEWORKS--/* Library flags for GLU, as a list of string literals. */-#undef GLU_LIBS--/* Define to 1 if you have the <GL/glu.h> header file. */-#undef HAVE_GL_GLU_H--/* Define to 1 if you have the <GL/gl.h> header file. */-#undef HAVE_GL_GL_H--/* Define to 1 if you have the <inttypes.h> header file. */-#undef HAVE_INTTYPES_H--/* Define to 1 if you have the <memory.h> header file. */-#undef HAVE_MEMORY_H--/* Define to 1 if you have the <OpenGL/glu.h> header file. */-#undef HAVE_OPENGL_GLU_H--/* Define to 1 if you have the <OpenGL/gl.h> header file. */-#undef HAVE_OPENGL_GL_H--/* Define to 1 if you have the <stdint.h> header file. */-#undef HAVE_STDINT_H--/* Define to 1 if you have the <stdlib.h> header file. */-#undef HAVE_STDLIB_H--/* Define to 1 if you have the <strings.h> header file. */-#undef HAVE_STRINGS_H--/* Define to 1 if you have the <string.h> header file. */-#undef HAVE_STRING_H--/* Define to 1 if you have the <sys/stat.h> header file. */-#undef HAVE_SYS_STAT_H--/* Define to 1 if you have the <sys/types.h> header file. */-#undef HAVE_SYS_TYPES_H--/* Define to 1 if you have the <unistd.h> header file. */-#undef HAVE_UNISTD_H--/* Define to Haskell type for char */-#undef HTYPE_CHAR--/* Define to Haskell type for GLbitfield */-#undef HTYPE_GLBITFIELD--/* Define to Haskell type for GLboolean */-#undef HTYPE_GLBOOLEAN--/* Define to Haskell type for GLbyte */-#undef HTYPE_GLBYTE--/* Define to Haskell type for GLchar */-#undef HTYPE_GLCHAR--/* Define to Haskell type for GLclampd */-#undef HTYPE_GLCLAMPD--/* Define to Haskell type for GLclampf */-#undef HTYPE_GLCLAMPF--/* Define to Haskell type for GLdouble */-#undef HTYPE_GLDOUBLE--/* Define to Haskell type for GLenum */-#undef HTYPE_GLENUM--/* Define to Haskell type for GLfloat */-#undef HTYPE_GLFLOAT--/* Define to Haskell type for GLint */-#undef HTYPE_GLINT--/* Define to Haskell type for GLintptr */-#undef HTYPE_GLINTPTR--/* Define to Haskell type for GLshort */-#undef HTYPE_GLSHORT--/* Define to Haskell type for GLsizei */-#undef HTYPE_GLSIZEI--/* Define to Haskell type for GLsizeiptr */-#undef HTYPE_GLSIZEIPTR--/* Define to Haskell type for GLubyte */-#undef HTYPE_GLUBYTE--/* Define to Haskell type for GLuint */-#undef HTYPE_GLUINT--/* Define to Haskell type for GLushort */-#undef HTYPE_GLUSHORT--/* Define to Haskell type for ptrdiff_t */-#undef HTYPE_PTRDIFF_T--/* Define to the address where bug reports for this package should be sent. */-#undef PACKAGE_BUGREPORT--/* Define to the full name of this package. */-#undef PACKAGE_NAME--/* Define to the full name and version of this package. */-#undef PACKAGE_STRING--/* Define to the one symbol short name of this package. */-#undef PACKAGE_TARNAME--/* Define to the home page for this package. */-#undef PACKAGE_URL--/* Define to the version of this package. */-#undef PACKAGE_VERSION--/* Define to 1 if you have the ANSI C header files. */-#undef STDC_HEADERS--/* Define to 1 if native OpenGL should be used on Mac OS X */-#undef USE_QUARTZ_OPENGL--/* Define to 1 if the X Window System is missing or not being used. */-#undef X_DISPLAY_MISSING
− include/HsOpenGLExt.h 
@@ -1,29 +0,0 @@-/* ------------------------------------------------------------------------------ *- * Module      :  GL extension support for Graphics.Rendering.OpenGL- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)- * - * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional- * Portability :  portable- *- * This header should only define preprocessor macros!- *- * -------------------------------------------------------------------------- */--#ifndef HSOPENGLEXT_H-#define HSOPENGLEXT_H--/* NOTE: The macro must immediately start with the foreign declaration,-   otherwise the magic mangler (hack_foreign) in the Hugs build system-   doesn't recognize it. */-#define EXTENSION_ENTRY(_msg,_entry,_ty) \-foreign import CALLCONV unsafe "dynamic" dyn_/**/_entry :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (_ty) ; \-_entry :: (_ty) ; \-_entry = dyn_/**/_entry ptr_/**/_entry ; \-ptr_/**/_entry :: FunPtr a ; \-ptr_/**/_entry = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress (_msg) ("_entry")) ; \-{-# NOINLINE ptr_/**/_entry #-}--#endif
− include/HsOpenGLTypes.h 
@@ -1,42 +0,0 @@-/* ------------------------------------------------------------------------------ *- * Module      :  Macros for basic GL types to get better Haddock documentation- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)- * - * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional- * Portability :  portable- *- * This header should only define preprocessor macros!- *- * -------------------------------------------------------------------------- */--#ifndef HSOPENGLTYPES_H-#define HSOPENGLTYPES_H--#include "HsOpenGLConfig.h"--/* Using a type synonym in an instance head is not Haskell98, but it is much-   better for a useful documentation. */-#ifdef __HADDOCK__-#define GLbyte_   GLbyte-#define GLdouble_ GLdouble-#define GLfloat_  GLfloat-#define GLint_    GLint-#define GLshort_  GLshort-#define GLubyte_  GLubyte-#define GLuint_   GLuint-#define GLushort_ GLushort-#else-#define GLbyte_   HTYPE_GLBYTE-#define GLdouble_ HTYPE_GLDOUBLE-#define GLfloat_  HTYPE_GLFLOAT-#define GLint_    HTYPE_GLINT-#define GLshort_  HTYPE_GLSHORT-#define GLubyte_  HTYPE_GLUBYTE-#define GLuint_   HTYPE_GLUINT-#define GLushort_ HTYPE_GLUSHORT-#endif--#endif
− install-sh 
@@ -1,295 +0,0 @@-#!/bin/sh-# install - install a program, script, or datafile--scriptversion=2003-09-24.23--# This originates from X11R5 (mit/util/scripts/install.sh), which was-# later released in X11R6 (xc/config/util/install.sh) with the-# following copyright and license.-#-# Copyright (C) 1994 X Consortium-#-# Permission is hereby granted, free of charge, to any person obtaining a copy-# of this software and associated documentation files (the "Software"), to-# deal in the Software without restriction, including without limitation the-# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or-# sell copies of the Software, and to permit persons to whom the Software is-# furnished to do so, subject to the following conditions:-#-# The above copyright notice and this permission notice shall be included in-# all copies or substantial portions of the Software.-#-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE-# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN-# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC--# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.-#-# Except as contained in this notice, the name of the X Consortium shall not-# be used in advertising or otherwise to promote the sale, use or other deal--# ings in this Software without prior written authorization from the X Consor--# tium.-#-#-# FSF changes to this file are in the public domain.-#-# Calling this script install-sh is preferred over install.sh, to prevent-# `make' implicit rules from creating a file called install from it-# when there is no Makefile.-#-# This script is compatible with the BSD install script, but was written-# from scratch.  It can only install one file at a time, a restriction-# shared with many OS's install programs.--# set DOITPROG to echo to test this script--# Don't use :- since 4.3BSD and earlier shells don't like it.-doit="${DOITPROG-}"--# put in absolute paths if you don't have them in your path; or use env. vars.--mvprog="${MVPROG-mv}"-cpprog="${CPPROG-cp}"-chmodprog="${CHMODPROG-chmod}"-chownprog="${CHOWNPROG-chown}"-chgrpprog="${CHGRPPROG-chgrp}"-stripprog="${STRIPPROG-strip}"-rmprog="${RMPROG-rm}"-mkdirprog="${MKDIRPROG-mkdir}"--transformbasename=-transform_arg=-instcmd="$mvprog"-chmodcmd="$chmodprog 0755"-chowncmd=-chgrpcmd=-stripcmd=-rmcmd="$rmprog -f"-mvcmd="$mvprog"-src=-dst=-dir_arg=--usage="Usage: $0 [OPTION]... SRCFILE DSTFILE-   or: $0 -d DIR1 DIR2...--In the first form, install SRCFILE to DSTFILE, removing SRCFILE by default.-In the second, create the directory path DIR.--Options:--b=TRANSFORMBASENAME--c         copy source (using $cpprog) instead of moving (using $mvprog).--d         create directories instead of installing files.--g GROUP   $chgrp installed files to GROUP.--m MODE    $chmod installed files to MODE.--o USER    $chown installed files to USER.--s         strip installed files (using $stripprog).--t=TRANSFORM---help     display this help and exit.---version  display version info and exit.--Environment variables override the default commands:-  CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG-"--while test -n "$1"; do-  case $1 in-    -b=*) transformbasename=`echo $1 | sed 's/-b=//'`-        shift-        continue;;--    -c) instcmd=$cpprog-        shift-        continue;;--    -d) dir_arg=true-        shift-        continue;;--    -g) chgrpcmd="$chgrpprog $2"-        shift-        shift-        continue;;--    --help) echo "$usage"; exit 0;;--    -m) chmodcmd="$chmodprog $2"-        shift-        shift-        continue;;--    -o) chowncmd="$chownprog $2"-        shift-        shift-        continue;;--    -s) stripcmd=$stripprog-        shift-        continue;;--    -t=*) transformarg=`echo $1 | sed 's/-t=//'`-        shift-        continue;;--    --version) echo "$0 $scriptversion"; exit 0;;--    *)  if test -z "$src"; then-          src=$1-        else-          # this colon is to work around a 386BSD /bin/sh bug-          :-          dst=$1-        fi-        shift-        continue;;-  esac-done--if test -z "$src"; then-  echo "$0: no input file specified." >&2-  exit 1-fi--# Protect names starting with `-'.-case $src in-  -*) src=./$src ;;-esac--if test -n "$dir_arg"; then-  dst=$src-  src=--  if test -d "$dst"; then-    instcmd=:-    chmodcmd=-  else-    instcmd=$mkdirprog-  fi-else-  # Waiting for this to be detected by the "$instcmd $src $dsttmp" command-  # might cause directories to be created, which would be especially bad-  # if $src (and thus $dsttmp) contains '*'.-  if test ! -f "$src" && test ! -d "$src"; then-    echo "$0: $src does not exist." >&2-    exit 1-  fi--  if test -z "$dst"; then-    echo "$0: no destination specified." >&2-    exit 1-  fi--  # Protect names starting with `-'.-  case $dst in-    -*) dst=./$dst ;;-  esac--  # If destination is a directory, append the input filename; won't work-  # if double slashes aren't ignored.-  if test -d "$dst"; then-    dst=$dst/`basename "$src"`-  fi-fi--# This sed command emulates the dirname command.-dstdir=`echo "$dst" | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`--# Make sure that the destination directory exists.--# Skip lots of stat calls in the usual case.-if test ! -d "$dstdir"; then-  defaultIFS='-	'-  IFS="${IFS-$defaultIFS}"--  oIFS=$IFS-  # Some sh's can't handle IFS=/ for some reason.-  IFS='%'-  set - `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'`-  IFS=$oIFS--  pathcomp=--  while test $# -ne 0 ; do-    pathcomp=$pathcomp$1-    shift-    test -d "$pathcomp" || $mkdirprog "$pathcomp"-    pathcomp=$pathcomp/-  done-fi--if test -n "$dir_arg"; then-  $doit $instcmd "$dst" \-    && { test -z "$chowncmd" || $doit $chowncmd "$dst"; } \-    && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } \-    && { test -z "$stripcmd" || $doit $stripcmd "$dst"; } \-    && { test -z "$chmodcmd" || $doit $chmodcmd "$dst"; }--else-  # If we're going to rename the final executable, determine the name now.-  if test -z "$transformarg"; then-    dstfile=`basename "$dst"`-  else-    dstfile=`basename "$dst" $transformbasename \-             | sed $transformarg`$transformbasename-  fi--  # don't allow the sed command to completely eliminate the filename.-  test -z "$dstfile" && dstfile=`basename "$dst"`--  # Make a couple of temp file names in the proper directory.-  dsttmp=$dstdir/_inst.$$_-  rmtmp=$dstdir/_rm.$$_--  # Trap to clean up those temp files at exit.-  trap 'status=$?; rm -f "$dsttmp" "$rmtmp" && exit $status' 0-  trap '(exit $?); exit' 1 2 13 15--  # Move or copy the file name to the temp name-  $doit $instcmd "$src" "$dsttmp" &&--  # and set any options; do chmod last to preserve setuid bits.-  #-  # If any of these fail, we abort the whole thing.  If we want to-  # ignore errors from any of these, just make sure not to ignore-  # errors from the above "$doit $instcmd $src $dsttmp" command.-  #-  { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } \-    && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } \-    && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } \-    && { test -z "$chmodcmd" || $doit $chmodcmd "$dsttmp"; } &&--  # Now remove or move aside any old file at destination location.  We-  # try this two ways since rm can't unlink itself on some systems and-  # the destination file might be busy for other reasons.  In this case,-  # the final cleanup might fail but the new file should still install-  # successfully.-  {-    if test -f "$dstdir/$dstfile"; then-      $doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null \-      || $doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null \-      || {-	  echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2-	  (exit 1); exit-      }-    else-      :-    fi-  } &&--  # Now rename the file to the real destination.-  $doit $mvcmd "$dsttmp" "$dstdir/$dstfile"-fi &&--# The final little trick to "correctly" pass the exit status to the exit trap.-{-  (exit 0); exit-}--# Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)-# time-stamp-start: "scriptversion="-# time-stamp-format: "%:y-%02m-%02d.%02H"-# time-stamp-end: "$"-# End:
+ 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