packages feed

OpenGL 2.9.0.0 → 2.9.1.0

raw patch · 118 files changed

+18139/−18139 lines, 118 files

Files

Graphics/Rendering/OpenGL.hs view
@@ -1,138 +1,138 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.
Graphics/Rendering/OpenGL/GL.hs view
@@ -1,122 +1,122 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw.Types,
-   module Graphics.Rendering.OpenGL.GL.FlushFinish,
-   module Graphics.Rendering.OpenGL.GL.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.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,
-
-   -- * State and State Requests
-   module Graphics.Rendering.OpenGL.GL.StateVar,
-   module Graphics.Rendering.OpenGL.GL.Tensor,
-   module Graphics.Rendering.OpenGL.GL.StringQueries,
-   module Graphics.Rendering.OpenGL.GL.SavingState
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Types
-import Graphics.Rendering.OpenGL.GL.FlushFinish
-import Graphics.Rendering.OpenGL.GL.ObjectName
-
-import Graphics.Rendering.OpenGL.GL.SyncObjects
-import Graphics.Rendering.OpenGL.GL.QueryObjects
-
-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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.StringQueries
-import Graphics.Rendering.OpenGL.GL.SavingState
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw.Types,+   module Graphics.Rendering.OpenGL.GL.FlushFinish,+   module Graphics.Rendering.OpenGL.GL.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.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,++   -- * State and State Requests+   module Graphics.Rendering.OpenGL.GL.StateVar,+   module Graphics.Rendering.OpenGL.GL.Tensor,+   module Graphics.Rendering.OpenGL.GL.StringQueries,+   module Graphics.Rendering.OpenGL.GL.SavingState+) where++import Graphics.Rendering.OpenGL.Raw.Types+import Graphics.Rendering.OpenGL.GL.FlushFinish+import Graphics.Rendering.OpenGL.GL.ObjectName++import Graphics.Rendering.OpenGL.GL.SyncObjects+import Graphics.Rendering.OpenGL.GL.QueryObjects++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.StateVar+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.StringQueries+import Graphics.Rendering.OpenGL.GL.SavingState
Graphics/Rendering/OpenGL/GL/Antialiasing.hs view
@@ -1,40 +1,40 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Antialiasing
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Antialiasing+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/BeginEnd.hs view
@@ -1,129 +1,129 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.BeginEnd
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
-   PrimitiveMode(..),
-   renderPrimitive, unsafeRenderPrimitive, primitiveRestart,
-
-   -- * Polygon Edges
-   EdgeFlag(..),
-   edgeFlag
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.EdgeFlag
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.PrimitiveMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | Delimit the vertices that define a primitive or a group of like primitives.
---
--- Only a subset of GL commands can be used in the delimited action:
--- Those for specifying vertex coordinates
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.vertex',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.vertexv'),
--- vertex colors
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.color',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.colorv',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColor',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColorv',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.index',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.indexv'),
--- normal
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.normal',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.normalv'),
--- texture coordinates
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.texCoord',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.texCoordv',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoord',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoordv'),
--- and fog coordinates
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoord',
---  'Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoordv').
--- Additionally,
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint1',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint2',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1v',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2v',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbient',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialDiffuse',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbientAndDiffuse',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialSpecular',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialEmission',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialShininess',
--- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callList',
--- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callLists',
--- and setting 'edgeFlag' are allowed. Writing the respective state variables
--- is allowed in the delimited action, too.
---
--- Regardless of the chosen 'PrimitiveMode', there is no limit to the number of
--- vertices that can be defined during a single 'renderPrimitive'. Lines,
--- triangles, quadrilaterals, and polygons that are incompletely specified are
--- not drawn. Incomplete specification results when either too few vertices are
--- provided to specify even a single primitive or when an incorrect multiple of
--- vertices is specified. The incomplete primitive is ignored; the rest are
--- drawn.
---
--- The minimum specification of vertices for each primitive is as follows: 1
--- for a point, 2 for a line, 3 for a triangle, 4 for a quadrilateral, and 3 for
--- a polygon. Modes that require a certain multiple of vertices are 'Lines' (2),
--- 'Triangles' (3), 'Quads' (4), and 'QuadStrip' (2).
-
-renderPrimitive :: PrimitiveMode -> IO a -> IO a
-renderPrimitive = renderPrim bracket_
-
--- | A more efficient, but potentially dangerous version of 'renderPrimitive':
--- The given action is not allowed to throw an exception.
-
-unsafeRenderPrimitive :: PrimitiveMode -> IO a -> IO a
-unsafeRenderPrimitive = renderPrim unsafeBracket_
-
-{-# INLINE renderPrim #-}
-renderPrim :: (IO () -> IO () -> IO a -> IO a) -> PrimitiveMode -> IO a -> IO a
-renderPrim brack_ beginMode =
-   brack_ (glBegin (marshalPrimitiveMode beginMode)) glEnd
-
---------------------------------------------------------------------------------
-
-primitiveRestart :: IO ()
-primitiveRestart = glPrimitiveRestart
-
---------------------------------------------------------------------------------
-
--- | Each vertex of a polygon, separate triangle, or separate quadrilateral
--- specified during 'renderPrimitive' is marked as the start of either a boundary
--- or nonboundary (interior) edge.
---
--- The vertices of connected triangles and connected quadrilaterals are always
--- marked as boundary, regardless of the value of the edge flag.
---
--- Boundary and nonboundary edge flags on vertices are significant only if
--- 'Graphics.Rendering.OpenGL.GL.Polygons.polygonMode' is set to
--- 'Graphics.Rendering.OpenGL.GL.Polygons.Point' or
--- 'Graphics.Rendering.OpenGL.GL.Polygons.Line'.
---
--- Note that the current edge flag can be updated at any time, in particular
--- during 'renderPrimitive'.
-
-edgeFlag :: StateVar EdgeFlag
-edgeFlag =
-   makeStateVar (getBoolean1 unmarshalEdgeFlag GetEdgeFlag)
-                (glEdgeFlag . marshalEdgeFlag)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BeginEnd+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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+   PrimitiveMode(..),+   renderPrimitive, unsafeRenderPrimitive, primitiveRestart,++   -- * Polygon Edges+   EdgeFlag(..),+   edgeFlag+) where++import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.EdgeFlag+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.PrimitiveMode+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | Delimit the vertices that define a primitive or a group of like primitives.+--+-- Only a subset of GL commands can be used in the delimited action:+-- Those for specifying vertex coordinates+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.vertex',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.vertexv'),+-- vertex colors+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.color',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.colorv',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColor',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColorv',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.index',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.indexv'),+-- normal+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.normal',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.normalv'),+-- texture coordinates+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.texCoord',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.texCoordv',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoord',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoordv'),+-- and fog coordinates+-- ('Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoord',+--  'Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoordv').+-- Additionally,+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint1',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint2',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1v',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2',+-- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2v',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbient',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialDiffuse',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbientAndDiffuse',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialSpecular',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialEmission',+-- 'Graphics.Rendering.OpenGL.GL.Colors.materialShininess',+-- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callList',+-- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callLists',+-- and setting 'edgeFlag' are allowed. Writing the respective state variables+-- is allowed in the delimited action, too.+--+-- Regardless of the chosen 'PrimitiveMode', there is no limit to the number of+-- vertices that can be defined during a single 'renderPrimitive'. Lines,+-- triangles, quadrilaterals, and polygons that are incompletely specified are+-- not drawn. Incomplete specification results when either too few vertices are+-- provided to specify even a single primitive or when an incorrect multiple of+-- vertices is specified. The incomplete primitive is ignored; the rest are+-- drawn.+--+-- The minimum specification of vertices for each primitive is as follows: 1+-- for a point, 2 for a line, 3 for a triangle, 4 for a quadrilateral, and 3 for+-- a polygon. Modes that require a certain multiple of vertices are 'Lines' (2),+-- 'Triangles' (3), 'Quads' (4), and 'QuadStrip' (2).++renderPrimitive :: PrimitiveMode -> IO a -> IO a+renderPrimitive = renderPrim bracket_++-- | A more efficient, but potentially dangerous version of 'renderPrimitive':+-- The given action is not allowed to throw an exception.++unsafeRenderPrimitive :: PrimitiveMode -> IO a -> IO a+unsafeRenderPrimitive = renderPrim unsafeBracket_++{-# INLINE renderPrim #-}+renderPrim :: (IO () -> IO () -> IO a -> IO a) -> PrimitiveMode -> IO a -> IO a+renderPrim brack_ beginMode =+   brack_ (glBegin (marshalPrimitiveMode beginMode)) glEnd++--------------------------------------------------------------------------------++primitiveRestart :: IO ()+primitiveRestart = glPrimitiveRestart++--------------------------------------------------------------------------------++-- | Each vertex of a polygon, separate triangle, or separate quadrilateral+-- specified during 'renderPrimitive' is marked as the start of either a boundary+-- or nonboundary (interior) edge.+--+-- The vertices of connected triangles and connected quadrilaterals are always+-- marked as boundary, regardless of the value of the edge flag.+--+-- Boundary and nonboundary edge flags on vertices are significant only if+-- 'Graphics.Rendering.OpenGL.GL.Polygons.polygonMode' is set to+-- 'Graphics.Rendering.OpenGL.GL.Polygons.Point' or+-- 'Graphics.Rendering.OpenGL.GL.Polygons.Line'.+--+-- Note that the current edge flag can be updated at any time, in particular+-- during 'renderPrimitive'.++edgeFlag :: StateVar EdgeFlag+edgeFlag =+   makeStateVar (getBoolean1 unmarshalEdgeFlag GetEdgeFlag)+                (glEdgeFlag . marshalEdgeFlag)
Graphics/Rendering/OpenGL/GL/Bitmaps.hs view
@@ -1,28 +1,28 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Bitmaps
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Bitmaps+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++bitmap :: Size -> (Vertex2 GLfloat) -> (Vector2 GLfloat) -> Ptr GLubyte -> IO ()+bitmap (Size w h) (Vertex2 xbo ybo) (Vector2 xbi ybi) =+   glBitmap w h xbo ybo xbi ybi
Graphics/Rendering/OpenGL/GL/BlendingFactor.hs view
@@ -1,77 +1,77 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.BlendingFactor
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BlendingFactor+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data BlendingFactor =+     Zero+   | One+   | SrcColor+   | OneMinusSrcColor+   | DstColor+   | OneMinusDstColor+   | SrcAlpha+   | OneMinusSrcAlpha+   | DstAlpha+   | OneMinusDstAlpha+   | ConstantColor+   | OneMinusConstantColor+   | ConstantAlpha+   | OneMinusConstantAlpha+   | SrcAlphaSaturate+   deriving ( Eq, Ord, Show )++marshalBlendingFactor :: BlendingFactor -> GLenum+marshalBlendingFactor x = case x of+   Zero -> gl_ZERO+   One -> gl_ONE+   SrcColor -> gl_SRC_COLOR+   OneMinusSrcColor -> gl_ONE_MINUS_SRC_COLOR+   DstColor -> gl_DST_COLOR+   OneMinusDstColor -> gl_ONE_MINUS_DST_COLOR+   SrcAlpha -> gl_SRC_ALPHA+   OneMinusSrcAlpha -> gl_ONE_MINUS_SRC_ALPHA+   DstAlpha -> gl_DST_ALPHA+   OneMinusDstAlpha -> gl_ONE_MINUS_DST_ALPHA+   ConstantColor -> gl_CONSTANT_COLOR+   OneMinusConstantColor -> gl_ONE_MINUS_CONSTANT_COLOR+   ConstantAlpha -> gl_CONSTANT_ALPHA+   OneMinusConstantAlpha -> gl_ONE_MINUS_CONSTANT_ALPHA+   SrcAlphaSaturate -> gl_SRC_ALPHA_SATURATE++unmarshalBlendingFactor :: GLenum -> BlendingFactor+unmarshalBlendingFactor x+   | x == gl_ZERO = Zero+   | x == gl_ONE = One+   | x == gl_SRC_COLOR = SrcColor+   | x == gl_ONE_MINUS_SRC_COLOR = OneMinusSrcColor+   | x == gl_DST_COLOR = DstColor+   | x == gl_ONE_MINUS_DST_COLOR = OneMinusDstColor+   | x == gl_SRC_ALPHA = SrcAlpha+   | x == gl_ONE_MINUS_SRC_ALPHA = OneMinusSrcAlpha+   | x == gl_DST_ALPHA = DstAlpha+   | x == gl_ONE_MINUS_DST_ALPHA = OneMinusDstAlpha+   | x == gl_CONSTANT_COLOR = ConstantColor+   | x == gl_ONE_MINUS_CONSTANT_COLOR = OneMinusConstantColor+   | x == gl_CONSTANT_ALPHA = ConstantAlpha+   | x == gl_ONE_MINUS_CONSTANT_ALPHA = OneMinusConstantAlpha+   | x == gl_SRC_ALPHA_SATURATE = SrcAlphaSaturate+   | otherwise = error ("unmarshalBlendingFactor: illegal value " ++ show x)
Graphics/Rendering/OpenGL/GL/BufferMode.hs view
@@ -1,113 +1,113 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.BufferMode
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | 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.
-   | 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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BufferMode+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 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.+   | 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
Graphics/Rendering/OpenGL/GL/BufferObjects.hs view
@@ -1,434 +1,434 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.BufferObjects
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Data.Maybe
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.VertexArrays
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype BufferObject = BufferObject { bufferID :: GLuint }
-   deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-instance ObjectName BufferObject where
-   isObjectName = fmap unmarshalGLboolean . glIsBuffer . bufferID
-
-   deleteObjectNames bufferObjects =
-      withArrayLen (map bufferID bufferObjects) $
-         glDeleteBuffers . fromIntegral
-
-instance GeneratableObjectName BufferObject where
-   genObjectNames n =
-      allocaArray n $ \buf -> do
-        glGenBuffers (fromIntegral n) buf
-        fmap (map BufferObject) $ peekArray n buf
-
---------------------------------------------------------------------------------
-
-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 = alloca $ \buf -> do
-   glGetBufferParameteriv (marshalBufferTarget t)
-                          (marshalGetBufferPName p) buf
-   peek1 (f . fromIntegral) buf
-
---------------------------------------------------------------------------------
-
-getBufferPointer :: BufferTarget -> IO (Ptr a)
-getBufferPointer t = alloca $ \buf -> do
-   glGetBufferPointerv (marshalBufferTarget t) gl_BUFFER_MAP_POINTER buf
-   peek buf
-
---------------------------------------------------------------------------------
-
-data MappingFailure =
-     MappingFailed
-   | UnmappingFailed
-   deriving ( Eq, Ord, Show )
-
--- | Convenience function for an exception-safe combination of 'mapBuffer' and
--- 'unmapBuffer'.
-withMappedBuffer :: BufferTarget -> BufferAccess -> (Ptr a -> IO b) -> (MappingFailure -> IO b) -> IO b
-withMappedBuffer t a action err = do
-   maybeBuf <- mapBuffer t a
-   case maybeBuf  of
-      Nothing -> err MappingFailed
-      Just buf -> do (ret, ok) <- action buf `finallyRet` unmapBuffer t
-                     if ok
-                        then return ret
-                        else err UnmappingFailed
-
-mapBuffer :: BufferTarget -> BufferAccess -> IO (Maybe (Ptr a))
-mapBuffer t = fmap (maybeNullPtr Nothing Just) . mapBuffer_ t
-
-mapBuffer_ :: BufferTarget -> BufferAccess -> IO (Ptr a)
-mapBuffer_ t = glMapBuffer (marshalBufferTarget t) . marshalBufferAccess
-
-unmapBuffer :: BufferTarget -> IO Bool
-unmapBuffer = fmap unmarshalGLboolean . glUnmapBuffer . marshalBufferTarget
-
-bufferAccess :: BufferTarget -> GettableStateVar BufferAccess
-bufferAccess t = makeGettableStateVar $
-   getBufferParameter t unmarshalBufferAccess GetBufferAccess
-
-bufferMapped :: BufferTarget -> GettableStateVar Bool
-bufferMapped t = makeGettableStateVar $
-   getBufferParameter t unmarshalGLboolean GetBufferMapped
-
---------------------------------------------------------------------------------
-
-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 =
-     IndexedTransformFeedbackBuffer
---marshaling
-marshalIndexedBufferTarget :: IndexedBufferTarget -> IPName1I
-marshalIndexedBufferTarget x = case x of
-   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBuffer
-
-marshalIndexedBufferStart :: IndexedBufferTarget -> IPName1I
-marshalIndexedBufferStart x = case x of
-   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBufferStart
-
-marshalIndexedBufferSize :: IndexedBufferTarget -> IPName1I
-marshalIndexedBufferSize x = case x of
-   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBufferSize
-
-getIndexed :: Num a => IPName1I -> BufferIndex -> GettableStateVar a
-getIndexed e i = makeGettableStateVar $ getInteger1i fromIntegral e i
-
---buffer
-bindBufferBase :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferObject)
-bindBufferBase t i = makeStateVar (getIndexedBufferBinding t i) (setIndexedBufferBase t i)
-
-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
-
-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
-
-bindBufferRange :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferRange)
-bindBufferRange t i = makeStateVar (getIndexedBufferRange t i) (setIndexedBufferRange t i)
-
-setIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> Maybe BufferRange -> IO ()
-setIndexedBufferRange t i (Just (buf, start, range)) =
-   case marshalGetPName . marshalIndexedBufferTarget $ t of
-      Nothing -> recordInvalidEnum
-      Just t' -> glBindBufferRange t' i (bufferID buf) start range
-setIndexedBufferRange t i Nothing = setIndexedBufferBase t i Nothing
-
-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)
-
-
-indexedBufferStart :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeStartIndex
-indexedBufferStart = getIndexed . marshalIndexedBufferStart
-
-indexedBufferSize :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeSize
-indexedBufferSize = getIndexed . marshalIndexedBufferSize
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.BufferObjects+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Data.Maybe+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.VertexArrays+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype BufferObject = BufferObject { bufferID :: GLuint }+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++instance ObjectName BufferObject where+   isObjectName = fmap unmarshalGLboolean . glIsBuffer . bufferID++   deleteObjectNames bufferObjects =+      withArrayLen (map bufferID bufferObjects) $+         glDeleteBuffers . fromIntegral++instance GeneratableObjectName BufferObject where+   genObjectNames n =+      allocaArray n $ \buf -> do+        glGenBuffers (fromIntegral n) buf+        fmap (map BufferObject) $ peekArray n buf++--------------------------------------------------------------------------------++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 = alloca $ \buf -> do+   glGetBufferParameteriv (marshalBufferTarget t)+                          (marshalGetBufferPName p) buf+   peek1 (f . fromIntegral) buf++--------------------------------------------------------------------------------++getBufferPointer :: BufferTarget -> IO (Ptr a)+getBufferPointer t = alloca $ \buf -> do+   glGetBufferPointerv (marshalBufferTarget t) gl_BUFFER_MAP_POINTER buf+   peek buf++--------------------------------------------------------------------------------++data MappingFailure =+     MappingFailed+   | UnmappingFailed+   deriving ( Eq, Ord, Show )++-- | Convenience function for an exception-safe combination of 'mapBuffer' and+-- 'unmapBuffer'.+withMappedBuffer :: BufferTarget -> BufferAccess -> (Ptr a -> IO b) -> (MappingFailure -> IO b) -> IO b+withMappedBuffer t a action err = do+   maybeBuf <- mapBuffer t a+   case maybeBuf  of+      Nothing -> err MappingFailed+      Just buf -> do (ret, ok) <- action buf `finallyRet` unmapBuffer t+                     if ok+                        then return ret+                        else err UnmappingFailed++mapBuffer :: BufferTarget -> BufferAccess -> IO (Maybe (Ptr a))+mapBuffer t = fmap (maybeNullPtr Nothing Just) . mapBuffer_ t++mapBuffer_ :: BufferTarget -> BufferAccess -> IO (Ptr a)+mapBuffer_ t = glMapBuffer (marshalBufferTarget t) . marshalBufferAccess++unmapBuffer :: BufferTarget -> IO Bool+unmapBuffer = fmap unmarshalGLboolean . glUnmapBuffer . marshalBufferTarget++bufferAccess :: BufferTarget -> GettableStateVar BufferAccess+bufferAccess t = makeGettableStateVar $+   getBufferParameter t unmarshalBufferAccess GetBufferAccess++bufferMapped :: BufferTarget -> GettableStateVar Bool+bufferMapped t = makeGettableStateVar $+   getBufferParameter t unmarshalGLboolean GetBufferMapped++--------------------------------------------------------------------------------++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 =+     IndexedTransformFeedbackBuffer+--marshaling+marshalIndexedBufferTarget :: IndexedBufferTarget -> IPName1I+marshalIndexedBufferTarget x = case x of+   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBuffer++marshalIndexedBufferStart :: IndexedBufferTarget -> IPName1I+marshalIndexedBufferStart x = case x of+   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBufferStart++marshalIndexedBufferSize :: IndexedBufferTarget -> IPName1I+marshalIndexedBufferSize x = case x of+   IndexedTransformFeedbackBuffer -> GetTransformFeedbackBufferSize++getIndexed :: Num a => IPName1I -> BufferIndex -> GettableStateVar a+getIndexed e i = makeGettableStateVar $ getInteger1i fromIntegral e i++--buffer+bindBufferBase :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferObject)+bindBufferBase t i = makeStateVar (getIndexedBufferBinding t i) (setIndexedBufferBase t i)++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++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++bindBufferRange :: IndexedBufferTarget -> BufferIndex -> StateVar (Maybe BufferRange)+bindBufferRange t i = makeStateVar (getIndexedBufferRange t i) (setIndexedBufferRange t i)++setIndexedBufferRange :: IndexedBufferTarget -> BufferIndex -> Maybe BufferRange -> IO ()+setIndexedBufferRange t i (Just (buf, start, range)) =+   case marshalGetPName . marshalIndexedBufferTarget $ t of+      Nothing -> recordInvalidEnum+      Just t' -> glBindBufferRange t' i (bufferID buf) start range+setIndexedBufferRange t i Nothing = setIndexedBufferBase t i Nothing++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)+++indexedBufferStart :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeStartIndex+indexedBufferStart = getIndexed . marshalIndexedBufferStart++indexedBufferSize :: IndexedBufferTarget -> BufferIndex -> GettableStateVar RangeSize+indexedBufferSize = getIndexed . marshalIndexedBufferSize
Graphics/Rendering/OpenGL/GL/ByteString.hs view
@@ -1,62 +1,62 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.ByteString
--- Copyright   :  (c) Sven Panne 2013
--- 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
-) where
-
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ByteString+-- Copyright   :  (c) Sven Panne 2013+-- 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+) where++import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw+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
Graphics/Rendering/OpenGL/GL/Capability.hs view
@@ -1,308 +1,308 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Capability
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
-
-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
-   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
-   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
-   CapVertexBlend -> Just gl_VERTEX_BLEND
-   CapWeightArray -> Just gl_WEIGHT_ARRAY
-   CapMatrixPalette -> Just gl_MATRIX_PALETTE
-   CapDepthClamp -> Just gl_DEPTH_CLAMP
-   CapDepthBoundsTest -> Just gl_DEPTH_BOUNDS_TEST
-   CapPrimitiveRestart -> Just gl_PRIMITIVE_RESTART
-   CapPointSprite -> Just gl_POINT_SPRITE
-   CapStencilTestTwoSide -> Just gl_STENCIL_TEST_TWO_SIDE
-   -- TODO: use RASTER_POSITION_UNCLIPPED_IBM from IBM_rasterpos_clip extension
-   CapRasterPositionUnclipped -> Just 0x19262
-   CapRasterizerDiscard -> Just gl_RASTERIZER_DISCARD
-   -- TODO: use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension
-   CapTextureColorTable -> Just 0x80bc
-   CapVertexProgramPointSize -> Just gl_VERTEX_PROGRAM_POINT_SIZE
-   CapVertexProgramTwoSide -> Just gl_VERTEX_PROGRAM_TWO_SIDE
-
---------------------------------------------------------------------------------
-
-makeCapability :: EnableCap -> StateVar Capability
-makeCapability cap = makeStateVar (isEnabled cap) (enable cap)
-
---------------------------------------------------------------------------------
-
-isEnabled :: EnableCap -> IO Capability
-isEnabled =
-   maybe (do recordInvalidEnum; return Disabled)
-         (fmap unmarshalCapability . glIsEnabled) .
-   marshalEnableCap
-
---------------------------------------------------------------------------------
-
-enable :: EnableCap -> Capability -> IO ()
-enable cap state = maybe recordInvalidEnum (f state) (marshalEnableCap cap)
-   where f Disabled = glDisable
-         f Enabled  = glEnable
-
---------------------------------------------------------------------------------
-
-makeStateVarMaybe :: IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)
-makeStateVarMaybe getCap getAct setAct =
-   makeStateVar
-      (getStateVarMaybe getCap getAct)
-      (setStateVarMaybe getCap setAct)
-
-getStateVarMaybe :: IO EnableCap -> IO a -> IO (Maybe a)
-getStateVarMaybe getCap act = do
-   capability <- fmap makeCapability getCap
-   state <- get capability
-   if state == Enabled
-      then fmap Just act
-      else return Nothing
-
-setStateVarMaybe :: IO EnableCap -> (a -> IO ()) -> Maybe a -> IO ()
-setStateVarMaybe getCap act val = do
-   capability <- fmap makeCapability getCap
-   maybe (capability $= Disabled) (\x -> act x >> capability $= Enabled) val
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Capability+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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++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+   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+   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+   CapVertexBlend -> Just gl_VERTEX_BLEND+   CapWeightArray -> Just gl_WEIGHT_ARRAY+   CapMatrixPalette -> Just gl_MATRIX_PALETTE+   CapDepthClamp -> Just gl_DEPTH_CLAMP+   CapDepthBoundsTest -> Just gl_DEPTH_BOUNDS_TEST+   CapPrimitiveRestart -> Just gl_PRIMITIVE_RESTART+   CapPointSprite -> Just gl_POINT_SPRITE+   CapStencilTestTwoSide -> Just gl_STENCIL_TEST_TWO_SIDE+   -- TODO: use RASTER_POSITION_UNCLIPPED_IBM from IBM_rasterpos_clip extension+   CapRasterPositionUnclipped -> Just 0x19262+   CapRasterizerDiscard -> Just gl_RASTERIZER_DISCARD+   -- TODO: use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension+   CapTextureColorTable -> Just 0x80bc+   CapVertexProgramPointSize -> Just gl_VERTEX_PROGRAM_POINT_SIZE+   CapVertexProgramTwoSide -> Just gl_VERTEX_PROGRAM_TWO_SIDE++--------------------------------------------------------------------------------++makeCapability :: EnableCap -> StateVar Capability+makeCapability cap = makeStateVar (isEnabled cap) (enable cap)++--------------------------------------------------------------------------------++isEnabled :: EnableCap -> IO Capability+isEnabled =+   maybe (do recordInvalidEnum; return Disabled)+         (fmap unmarshalCapability . glIsEnabled) .+   marshalEnableCap++--------------------------------------------------------------------------------++enable :: EnableCap -> Capability -> IO ()+enable cap state = maybe recordInvalidEnum (f state) (marshalEnableCap cap)+   where f Disabled = glDisable+         f Enabled  = glEnable++--------------------------------------------------------------------------------++makeStateVarMaybe :: IO EnableCap -> IO a -> (a -> IO ()) -> StateVar (Maybe a)+makeStateVarMaybe getCap getAct setAct =+   makeStateVar+      (getStateVarMaybe getCap getAct)+      (setStateVarMaybe getCap setAct)++getStateVarMaybe :: IO EnableCap -> IO a -> IO (Maybe a)+getStateVarMaybe getCap act = do+   capability <- fmap makeCapability getCap+   state <- get capability+   if state == Enabled+      then fmap Just act+      else return Nothing++setStateVarMaybe :: IO EnableCap -> (a -> IO ()) -> Maybe a -> IO ()+setStateVarMaybe getCap act val = do+   capability <- fmap makeCapability getCap+   maybe (capability $= Disabled) (\x -> act x >> capability $= Enabled) val++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Clipping.hs view
@@ -1,57 +1,57 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Clipping
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.GL.StateVar
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Clipping+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.GL.StateVar+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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)
Graphics/Rendering/OpenGL/GL/ColorSum.hs view
@@ -1,25 +1,25 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.ColorSum
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-
---------------------------------------------------------------------------------
-
-colorSum :: StateVar Capability
-colorSum = makeCapability CapColorSum
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ColorSum+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Capability++--------------------------------------------------------------------------------++colorSum :: StateVar Capability+colorSum = makeCapability CapColorSum
Graphics/Rendering/OpenGL/GL/Colors.hs view
@@ -1,509 +1,509 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Colors
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
-
-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
-
-marshalClampMode :: ClampMode -> GLenum
-marshalClampMode x = case x of
-   ClampOn -> gl_TRUE
-   FixedOnly -> gl_FIXED_ONLY
-   ClampOff -> gl_FALSE
-
-unmarshalClampMode :: GLenum -> ClampMode
-unmarshalClampMode x
-   | x == gl_TRUE = ClampOn
-   | x == gl_FIXED_ONLY = FixedOnly
-   | x == gl_FALSE = ClampOff
-   | otherwise = error $ "unmarshalClampMode: unknown enum value " ++ show x
-
---------------------------------------------------------------------------------
-
-clampColor :: ClampTarget -> StateVar ClampMode
-clampColor ct = makeStateVar (getClampColor ct) (setClampColor ct)
-   where setClampColor t = glClampColor (marshalClampTarget t) . marshalClampMode
-         getClampColor = getEnum1 unmarshalClampMode . marshalClampTargetToPName
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Colors+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.StateVar+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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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++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++marshalClampMode :: ClampMode -> GLenum+marshalClampMode x = case x of+   ClampOn -> gl_TRUE+   FixedOnly -> gl_FIXED_ONLY+   ClampOff -> gl_FALSE++unmarshalClampMode :: GLenum -> ClampMode+unmarshalClampMode x+   | x == gl_TRUE = ClampOn+   | x == gl_FIXED_ONLY = FixedOnly+   | x == gl_FALSE = ClampOff+   | otherwise = error $ "unmarshalClampMode: unknown enum value " ++ show x++--------------------------------------------------------------------------------++clampColor :: ClampTarget -> StateVar ClampMode+clampColor ct = makeStateVar (getClampColor ct) (setClampColor ct)+   where setClampColor t = glClampColor (marshalClampTarget t) . marshalClampMode+         getClampColor = getEnum1 unmarshalClampMode . marshalClampTargetToPName
Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs view
@@ -1,57 +1,57 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.ComparisonFunction
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ComparisonFunction+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data ComparisonFunction =+     Never+   | Less+   | Equal+   | Lequal+   | Greater+   | Notequal+   | Gequal+   | Always+   deriving ( Eq, Ord, Show )++marshalComparisonFunction :: ComparisonFunction -> GLenum+marshalComparisonFunction x = case x of+   Never -> gl_NEVER+   Less -> gl_LESS+   Equal -> gl_EQUAL+   Lequal -> gl_LEQUAL+   Greater -> gl_GREATER+   Notequal -> gl_NOTEQUAL+   Gequal -> gl_GEQUAL+   Always -> gl_ALWAYS++unmarshalComparisonFunction :: GLenum -> ComparisonFunction+unmarshalComparisonFunction x+   | x == gl_NEVER = Never+   | x == gl_LESS = Less+   | x == gl_EQUAL = Equal+   | x == gl_LEQUAL = Lequal+   | x == gl_GREATER = Greater+   | x == gl_NOTEQUAL = Notequal+   | x == gl_GEQUAL = Gequal+   | x == gl_ALWAYS = Always+   | otherwise = error ("unmarshalComparisonFunction: illegal value " ++ show x)
Graphics/Rendering/OpenGL/GL/ConditionalRendering.hs view
@@ -1,52 +1,52 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.ConditionalRendering
--- Copyright   :  (c) Sven Panne 2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ConditionalRendering+-- Copyright   :  (c) Sven Panne 2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/ControlPoint.hs view
@@ -1,162 +1,162 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.ControlPoint
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ControlPoint+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++class ControlPoint c where+   map1Target       :: Domain d => c d -> GLenum+   map2Target       :: Domain d => c d -> GLenum+   enableCap1       :: Domain d => c d -> EnableCap+   enableCap2       :: Domain d => c d -> EnableCap+   numComponents    :: Domain d => c d -> Stride+   peekControlPoint :: Domain d => Ptr (c d) -> IO (c d)+   pokeControlPoint :: Domain d => Ptr (c d) -> (c d) -> IO ()++instance ControlPoint Vertex3 where+   map1Target       = marshalMapTarget . const Map1Vertex3+   map2Target       = marshalMapTarget . const Map2Vertex3+   enableCap1       = const CapMap1Vertex3+   enableCap2       = const CapMap2Vertex3+   numComponents    = const 3+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Vertex4 where+   map1Target       = marshalMapTarget . const Map1Vertex4+   map2Target       = marshalMapTarget . const Map2Vertex4+   enableCap1       = const CapMap1Vertex4+   enableCap2       = const CapMap2Vertex4+   numComponents    = const 4+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Index1 where+   map1Target       = marshalMapTarget . const Map1Index+   map2Target       = marshalMapTarget . const Map2Index+   enableCap1       = const CapMap1Index+   enableCap2       = const CapMap2Index+   numComponents    = const 1+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Color4 where+   map1Target       = marshalMapTarget . const Map1Color4+   map2Target       = marshalMapTarget . const Map2Color4+   enableCap1       = const CapMap1Color4+   enableCap2       = const CapMap2Color4+   numComponents    = const 4+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint Normal3 where+   map1Target       = marshalMapTarget . const Map1Normal+   map2Target       = marshalMapTarget . const Map2Normal+   enableCap1       = const CapMap1Normal+   enableCap2       = const CapMap2Normal+   numComponents    = const 3+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord1 where+   map1Target       = marshalMapTarget . const Map1TextureCoord1+   map2Target       = marshalMapTarget . const Map2TextureCoord1+   enableCap1       = const CapMap1TextureCoord1+   enableCap2       = const CapMap2TextureCoord1+   numComponents    = const 1+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord2 where+   map1Target       = marshalMapTarget . const Map1TextureCoord2+   map2Target       = marshalMapTarget . const Map2TextureCoord2+   enableCap1       = const CapMap1TextureCoord2+   enableCap2       = const CapMap2TextureCoord2+   numComponents    = const 2+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord3 where+   map1Target       = marshalMapTarget . const Map1TextureCoord3+   map2Target       = marshalMapTarget . const Map2TextureCoord3+   enableCap1       = const CapMap1TextureCoord3+   enableCap2       = const CapMap2TextureCoord3+   numComponents    = const 3+   peekControlPoint = peek+   pokeControlPoint = poke++instance ControlPoint TexCoord4 where+   map1Target       = marshalMapTarget . const Map1TextureCoord4+   map2Target       = marshalMapTarget . const Map2TextureCoord4+   enableCap1       = const CapMap1TextureCoord4+   enableCap2       = const CapMap2TextureCoord4+   numComponents    = const 4+   peekControlPoint = peek+   pokeControlPoint = poke++--------------------------------------------------------------------------------++data MapTarget =+     Map1Color4+   | Map1Index+   | Map1Normal+   | Map1TextureCoord1+   | Map1TextureCoord2+   | Map1TextureCoord3+   | Map1TextureCoord4+   | Map1Vertex3+   | Map1Vertex4+   | Map2Color4+   | Map2Index+   | Map2Normal+   | Map2TextureCoord1+   | Map2TextureCoord2+   | Map2TextureCoord3+   | Map2TextureCoord4+   | Map2Vertex3+   | Map2Vertex4++marshalMapTarget :: MapTarget -> GLenum+marshalMapTarget x = case x of+   Map1Color4 -> gl_MAP1_COLOR_4+   Map1Index -> gl_MAP1_INDEX+   Map1Normal -> gl_MAP1_NORMAL+   Map1TextureCoord1 -> gl_MAP1_TEXTURE_COORD_1+   Map1TextureCoord2 -> gl_MAP1_TEXTURE_COORD_2+   Map1TextureCoord3 -> gl_MAP1_TEXTURE_COORD_3+   Map1TextureCoord4 -> gl_MAP1_TEXTURE_COORD_4+   Map1Vertex3 -> gl_MAP1_VERTEX_3+   Map1Vertex4 -> gl_MAP1_VERTEX_4+   Map2Color4 -> gl_MAP2_COLOR_4+   Map2Index -> gl_MAP2_INDEX+   Map2Normal -> gl_MAP2_NORMAL+   Map2TextureCoord1 -> gl_MAP2_TEXTURE_COORD_1+   Map2TextureCoord2 -> gl_MAP2_TEXTURE_COORD_2+   Map2TextureCoord3 -> gl_MAP2_TEXTURE_COORD_3+   Map2TextureCoord4 -> gl_MAP2_TEXTURE_COORD_4+   Map2Vertex3 -> gl_MAP2_VERTEX_3+   Map2Vertex4 -> gl_MAP2_VERTEX_4
Graphics/Rendering/OpenGL/GL/CoordTrans.hs view
@@ -1,518 +1,518 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.CoordTrans
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.
---
---------------------------------------------------------------------------------
-
-{-# LANGUAGE TypeSynonymInstances #-}
-
-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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | After clipping and division by /w/, depth coordinates range from -1 to 1,
--- corresponding to the near and far clipping planes. 'depthRange' specifies a
--- linear mapping of the normalized depth coordinates in this range to window
--- depth coordinates. Regardless of the actual depth buffer implementation,
--- window coordinate depth values are treated as though they range from 0
--- through 1 (like color components). Thus, the values accepted by 'depthRange'
--- are both clamped to this range before they are accepted.
---
--- The initial setting of (0, 1) maps the near plane to 0 and the far plane to
--- 1. With this mapping, the depth buffer range is fully utilized.
---
--- It is not necessary that the near value be less than the far value. Reverse
--- mappings such as (1, 0) are acceptable.
-
-depthRange :: StateVar (GLclampd, GLclampd)
-depthRange = makeStateVar (getClampd2 (,) GetDepthRange) (uncurry glDepthRange)
-
---------------------------------------------------------------------------------
-
--- | A 2-dimensional position, measured in pixels.
-data Position = Position !GLint !GLint
-   deriving ( Eq, Ord, Show )
-
--- | A 2-dimensional size, measured in pixels.
-data Size = Size !GLsizei !GLsizei
-   deriving ( Eq, Ord, Show )
-
--- | Controls the affine transformation from normalized device coordinates to
--- window coordinates. The viewport state variable consists of the coordinates
--- (/x/, /y/) of the lower left corner of the viewport rectangle, (in pixels,
--- initial value (0,0)), and the size (/width/, /height/) of the viewport. When
--- a GL context is first attached to a window, /width/ and /height/ are set to
--- the dimensions of that window.
---
--- Let (/xnd/, /ynd/) be normalized device coordinates. Then the window
--- coordinates (/xw/, /yw/) are computed as follows:
---
--- /xw/ = (/xnd/ + 1) (/width/  \/ 2) + /x/
---
--- /yw/ = (/ynd/ + 1) (/heigth/ \/ 2) + /y/
---
--- Viewport width and height are silently clamped to a range that depends on the
--- implementation, see 'maxViewportDims'.
-
-viewport :: StateVar (Position, Size)
-viewport = makeStateVar (getInteger4 makeVp GetViewport)
-                        (\(Position x y, Size w h) -> glViewport x y w h)
-   where makeVp x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))
-
--- | The implementation-dependent maximum viewport width and height.
-
-maxViewportDims :: GettableStateVar Size
-maxViewportDims = makeGettableStateVar (getSizei2 Size GetMaxViewportDims)
-
---------------------------------------------------------------------------------
-
--- | A matrix stack.
-
-data MatrixMode =
-     Modelview GLsizei  -- ^ The modelview matrix stack of the specified vertex unit.
-   | Projection         -- ^ The projection matrix stack.
-   | Texture            -- ^ The texture matrix stack.
-   | Color              -- ^ The color matrix stack.
-   | MatrixPalette      -- ^ The matrix palette stack.
-   deriving ( Eq, Ord, Show )
-
-marshalMatrixMode :: MatrixMode -> Maybe GLenum
-marshalMatrixMode x = case x of
-   Modelview i -> modelviewIndexToEnum i
-   Projection -> Just gl_PROJECTION
-   Texture -> Just gl_TEXTURE
-   Color -> Just gl_COLOR
-   MatrixPalette -> Just gl_MATRIX_PALETTE
-
-unmarshalMatrixMode :: GLenum -> MatrixMode
-unmarshalMatrixMode x
-   | x == gl_PROJECTION = Projection
-   | x == gl_TEXTURE = Texture
-   | x == gl_COLOR = Color
-   | x == gl_MATRIX_PALETTE = MatrixPalette
-   | otherwise =
-        case modelviewEnumToIndex x of
-           Just i -> Modelview i
-           Nothing -> error ("unmarshalMatrixMode: illegal value " ++ show x)
-
-matrixModeToGetMatrix :: MatrixMode -> 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 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 ()
-   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
-   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
-   rotate a (Vector3 x y z) = glRotated a x y z
-   translate (Vector3 x y z) = glTranslated x y z
-   scale = glScaled
-
---------------------------------------------------------------------------------
-
-class Matrix m where
-   -- | Create a new matrix of the given order (containing undefined elements)
-   -- and call the action to fill it with 4x4 elements.
-   withNewMatrix ::
-      MatrixComponent c => MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)
-
-   -- | Call the action with the given matrix. /Note:/ The action is /not/
-   -- allowed to modify the matrix elements!
-   withMatrix ::
-      MatrixComponent c => m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a
-
-   newMatrix :: MatrixComponent c => MatrixOrder -> [c] -> IO (m c)
-   getMatrixComponents :: MatrixComponent c => MatrixOrder -> m c -> IO [c]
-
-   withNewMatrix order act =
-      allocaArray 16 $ \p -> do
-         act p
-         components <- peekArray 16 p
-         newMatrix order components
-
-   withMatrix mat act = do
-      components <- getMatrixComponents ColumnMajor mat
-      withArray components $ act ColumnMajor
-
-   newMatrix order components =
-      withNewMatrix order $ flip pokeArray (take 16 components)
-
-   getMatrixComponents desiredOrder mat =
-      withMatrix mat $ \order p ->
-        if desiredOrder == order
-           then peekArray 16 p
-           else mapM (peekElemOff p) [ 0, 4,  8, 12,
-                                       1, 5,  9, 13,
-                                       2, 6, 10, 14,
-                                       3, 7, 11, 15 ]
-
---------------------------------------------------------------------------------
-
-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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.CoordTrans+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.+--+--------------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | After clipping and division by /w/, depth coordinates range from -1 to 1,+-- corresponding to the near and far clipping planes. 'depthRange' specifies a+-- linear mapping of the normalized depth coordinates in this range to window+-- depth coordinates. Regardless of the actual depth buffer implementation,+-- window coordinate depth values are treated as though they range from 0+-- through 1 (like color components). Thus, the values accepted by 'depthRange'+-- are both clamped to this range before they are accepted.+--+-- The initial setting of (0, 1) maps the near plane to 0 and the far plane to+-- 1. With this mapping, the depth buffer range is fully utilized.+--+-- It is not necessary that the near value be less than the far value. Reverse+-- mappings such as (1, 0) are acceptable.++depthRange :: StateVar (GLclampd, GLclampd)+depthRange = makeStateVar (getClampd2 (,) GetDepthRange) (uncurry glDepthRange)++--------------------------------------------------------------------------------++-- | A 2-dimensional position, measured in pixels.+data Position = Position !GLint !GLint+   deriving ( Eq, Ord, Show )++-- | A 2-dimensional size, measured in pixels.+data Size = Size !GLsizei !GLsizei+   deriving ( Eq, Ord, Show )++-- | Controls the affine transformation from normalized device coordinates to+-- window coordinates. The viewport state variable consists of the coordinates+-- (/x/, /y/) of the lower left corner of the viewport rectangle, (in pixels,+-- initial value (0,0)), and the size (/width/, /height/) of the viewport. When+-- a GL context is first attached to a window, /width/ and /height/ are set to+-- the dimensions of that window.+--+-- Let (/xnd/, /ynd/) be normalized device coordinates. Then the window+-- coordinates (/xw/, /yw/) are computed as follows:+--+-- /xw/ = (/xnd/ + 1) (/width/  \/ 2) + /x/+--+-- /yw/ = (/ynd/ + 1) (/heigth/ \/ 2) + /y/+--+-- Viewport width and height are silently clamped to a range that depends on the+-- implementation, see 'maxViewportDims'.++viewport :: StateVar (Position, Size)+viewport = makeStateVar (getInteger4 makeVp GetViewport)+                        (\(Position x y, Size w h) -> glViewport x y w h)+   where makeVp x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))++-- | The implementation-dependent maximum viewport width and height.++maxViewportDims :: GettableStateVar Size+maxViewportDims = makeGettableStateVar (getSizei2 Size GetMaxViewportDims)++--------------------------------------------------------------------------------++-- | A matrix stack.++data MatrixMode =+     Modelview GLsizei  -- ^ The modelview matrix stack of the specified vertex unit.+   | Projection         -- ^ The projection matrix stack.+   | Texture            -- ^ The texture matrix stack.+   | Color              -- ^ The color matrix stack.+   | MatrixPalette      -- ^ The matrix palette stack.+   deriving ( Eq, Ord, Show )++marshalMatrixMode :: MatrixMode -> Maybe GLenum+marshalMatrixMode x = case x of+   Modelview i -> modelviewIndexToEnum i+   Projection -> Just gl_PROJECTION+   Texture -> Just gl_TEXTURE+   Color -> Just gl_COLOR+   MatrixPalette -> Just gl_MATRIX_PALETTE++unmarshalMatrixMode :: GLenum -> MatrixMode+unmarshalMatrixMode x+   | x == gl_PROJECTION = Projection+   | x == gl_TEXTURE = Texture+   | x == gl_COLOR = Color+   | x == gl_MATRIX_PALETTE = MatrixPalette+   | otherwise =+        case modelviewEnumToIndex x of+           Just i -> Modelview i+           Nothing -> error ("unmarshalMatrixMode: illegal value " ++ show x)++matrixModeToGetMatrix :: MatrixMode -> 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 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 ()+   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+   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+   rotate a (Vector3 x y z) = glRotated a x y z+   translate (Vector3 x y z) = glTranslated x y z+   scale = glScaled++--------------------------------------------------------------------------------++class Matrix m where+   -- | Create a new matrix of the given order (containing undefined elements)+   -- and call the action to fill it with 4x4 elements.+   withNewMatrix ::+      MatrixComponent c => MatrixOrder -> (Ptr c -> IO ()) -> IO (m c)++   -- | Call the action with the given matrix. /Note:/ The action is /not/+   -- allowed to modify the matrix elements!+   withMatrix ::+      MatrixComponent c => m c -> (MatrixOrder -> Ptr c -> IO a) -> IO a++   newMatrix :: MatrixComponent c => MatrixOrder -> [c] -> IO (m c)+   getMatrixComponents :: MatrixComponent c => MatrixOrder -> m c -> IO [c]++   withNewMatrix order act =+      allocaArray 16 $ \p -> do+         act p+         components <- peekArray 16 p+         newMatrix order components++   withMatrix mat act = do+      components <- getMatrixComponents ColumnMajor mat+      withArray components $ act ColumnMajor++   newMatrix order components =+      withNewMatrix order $ flip pokeArray (take 16 components)++   getMatrixComponents desiredOrder mat =+      withMatrix mat $ \order p ->+        if desiredOrder == order+           then peekArray 16 p+           else mapM (peekElemOff p) [ 0, 4,  8, 12,+                                       1, 5,  9, 13,+                                       2, 6, 10, 14,+                                       3, 7, 11, 15 ]++--------------------------------------------------------------------------------++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)
Graphics/Rendering/OpenGL/GL/DataType.hs view
@@ -1,158 +1,158 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.DataType
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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,
-   DataTypeType(..), marshalDataTypeType, unmarshalDataTypeType
-) where
-
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- basically table 3.2 (pixel data type parameter) plus a few additions
-data DataType =
-     UnsignedByte
-   | Byte
-   | UnsignedShort
-   | Short
-   | UnsignedInt
-   | Int
-   | HalfFloat
-   | Float
-   | UnsignedByte332
-   | UnsignedByte233Rev
-   | UnsignedShort565
-   | UnsignedShort565Rev
-   | UnsignedShort4444
-   | UnsignedShort4444Rev
-   | UnsignedShort5551
-   | UnsignedShort1555Rev
-   | UnsignedInt8888
-   | UnsignedInt8888Rev
-   | UnsignedInt1010102
-   | UnsignedInt2101010Rev
-   | UnsignedInt248
-   | UnsignedInt10f11f11fRev
-   | UnsignedInt5999Rev
-   | Float32UnsignedInt248Rev
-   | Bitmap                    -- pixel data, deprecated in 3.1
-   | UnsignedShort88           -- MESA_ycbcr_texture/APPLE_ycbcr_422
-   | UnsignedShort88Rev        -- MESA_ycbcr_texture/APPLE_ycbcr_422
-   | Double                    -- vertex arrays (EXT_vertex_array, now core)
-   | TwoBytes                  -- CallLists
-   | ThreeBytes                -- CallLists
-   | FourBytes                 -- CallLists
-   deriving ( Eq, Ord, Show )
-
-marshalDataType :: DataType -> GLenum
-marshalDataType x = case x of
-   UnsignedByte -> gl_UNSIGNED_BYTE
-   Byte -> gl_BYTE
-   UnsignedShort -> gl_UNSIGNED_SHORT
-   Short -> gl_SHORT
-   UnsignedInt -> gl_UNSIGNED_INT
-   Int -> gl_INT
-   HalfFloat -> gl_HALF_FLOAT
-   Float -> gl_FLOAT
-   UnsignedByte332 -> gl_UNSIGNED_BYTE_3_3_2
-   UnsignedByte233Rev -> gl_UNSIGNED_BYTE_2_3_3_REV
-   UnsignedShort565 -> gl_UNSIGNED_SHORT_5_6_5
-   UnsignedShort565Rev -> gl_UNSIGNED_SHORT_5_6_5_REV
-   UnsignedShort4444 -> gl_UNSIGNED_SHORT_4_4_4_4
-   UnsignedShort4444Rev -> gl_UNSIGNED_SHORT_4_4_4_4_REV
-   UnsignedShort5551 -> gl_UNSIGNED_SHORT_5_5_5_1
-   UnsignedShort1555Rev -> gl_UNSIGNED_SHORT_1_5_5_5_REV
-   UnsignedInt8888 -> gl_UNSIGNED_INT_8_8_8_8
-   UnsignedInt8888Rev -> gl_UNSIGNED_INT_8_8_8_8_REV
-   UnsignedInt1010102 -> gl_UNSIGNED_INT_10_10_10_2
-   UnsignedInt2101010Rev -> gl_UNSIGNED_INT_2_10_10_10_REV
-   UnsignedInt248 -> gl_UNSIGNED_INT_24_8
-   UnsignedInt10f11f11fRev -> gl_UNSIGNED_INT_10F_11F_11F_REV
-   UnsignedInt5999Rev -> gl_UNSIGNED_INT_5_9_9_9_REV
-   Float32UnsignedInt248Rev -> gl_FLOAT_32_UNSIGNED_INT_24_8_REV
-   Bitmap -> gl_BITMAP
-   -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension
-   UnsignedShort88 -> 0x85ba
-   -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension
-   UnsignedShort88Rev -> 0x85bb
-   Double -> gl_DOUBLE
-   TwoBytes -> gl_2_BYTES
-   ThreeBytes -> gl_3_BYTES
-   FourBytes -> gl_4_BYTES
-
-unmarshalDataType :: GLenum -> DataType
-unmarshalDataType x
-   | x == gl_UNSIGNED_BYTE = UnsignedByte
-   | x == gl_BYTE = Byte
-   | x == gl_UNSIGNED_SHORT = UnsignedShort
-   | x == gl_SHORT = Short
-   | x == gl_UNSIGNED_INT = UnsignedInt
-   | x == gl_INT = Int
-   | x == gl_HALF_FLOAT = HalfFloat
-   | x == gl_FLOAT = Float
-   | x == gl_UNSIGNED_BYTE_3_3_2 = UnsignedByte332
-   | x == gl_UNSIGNED_BYTE_2_3_3_REV = UnsignedByte233Rev
-   | x == gl_UNSIGNED_SHORT_5_6_5 = UnsignedShort565
-   | x == gl_UNSIGNED_SHORT_5_6_5_REV = UnsignedShort565Rev
-   | x == gl_UNSIGNED_SHORT_4_4_4_4 = UnsignedShort4444
-   | x == gl_UNSIGNED_SHORT_4_4_4_4_REV = UnsignedShort4444Rev
-   | x == gl_UNSIGNED_SHORT_5_5_5_1 = UnsignedShort5551
-   | x == gl_UNSIGNED_SHORT_1_5_5_5_REV = UnsignedShort1555Rev
-   | x == gl_UNSIGNED_INT_8_8_8_8 = UnsignedInt8888
-   | x == gl_UNSIGNED_INT_8_8_8_8_REV = UnsignedInt8888Rev
-   | x == gl_UNSIGNED_INT_10_10_10_2 = UnsignedInt1010102
-   | x == gl_UNSIGNED_INT_2_10_10_10_REV = UnsignedInt2101010Rev
-   | x == gl_UNSIGNED_INT_24_8 = UnsignedInt248
-   | x == gl_UNSIGNED_INT_10F_11F_11F_REV = UnsignedInt10f11f11fRev
-   | x == gl_UNSIGNED_INT_5_9_9_9_REV = UnsignedInt5999Rev
-   | x == gl_FLOAT_32_UNSIGNED_INT_24_8_REV = Float32UnsignedInt248Rev
-   | x == gl_BITMAP = Bitmap
-   -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension
-   | x == 0x85ba = UnsignedShort88
-   -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension
-   | x == 0x85bb = UnsignedShort88Rev
-   | x == gl_DOUBLE = Double
-   | x == gl_2_BYTES = TwoBytes
-   | x == gl_3_BYTES = ThreeBytes
-   | x == gl_4_BYTES = FourBytes
-   | otherwise = error ("unmarshalDataType: illegal value " ++ show x)
-
-data DataTypeType
-   = TNone
-   | TSignedNormalized
-   | TUnsignedNormalized
-   | TFloat
-   | TInt
-   | TUnsignedInt
-
-marshalDataTypeType :: DataTypeType -> GLenum
-marshalDataTypeType x = case x of
-   TNone -> gl_NONE
-   TSignedNormalized -> gl_SIGNED_NORMALIZED
-   TUnsignedNormalized -> gl_UNSIGNED_NORMALIZED
-   TFloat -> gl_FLOAT
-   TInt -> gl_INT
-   TUnsignedInt -> gl_UNSIGNED_INT
-
-unmarshalDataTypeType :: GLenum -> DataTypeType
-unmarshalDataTypeType x
-   | x == gl_NONE = TNone
-   | x == gl_SIGNED_NORMALIZED = TSignedNormalized
-   | x == gl_UNSIGNED_NORMALIZED = TUnsignedNormalized
-   | x == gl_FLOAT = TFloat
-   | x == gl_INT = TInt
-   | x == gl_UNSIGNED_INT = TUnsignedInt
-   | otherwise = error $ "unmarshalDataTypeType: illegal value " ++ show x
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.DataType+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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,+   DataTypeType(..), marshalDataTypeType, unmarshalDataTypeType+) where++import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- basically table 3.2 (pixel data type parameter) plus a few additions+data DataType =+     UnsignedByte+   | Byte+   | UnsignedShort+   | Short+   | UnsignedInt+   | Int+   | HalfFloat+   | Float+   | UnsignedByte332+   | UnsignedByte233Rev+   | UnsignedShort565+   | UnsignedShort565Rev+   | UnsignedShort4444+   | UnsignedShort4444Rev+   | UnsignedShort5551+   | UnsignedShort1555Rev+   | UnsignedInt8888+   | UnsignedInt8888Rev+   | UnsignedInt1010102+   | UnsignedInt2101010Rev+   | UnsignedInt248+   | UnsignedInt10f11f11fRev+   | UnsignedInt5999Rev+   | Float32UnsignedInt248Rev+   | Bitmap                    -- pixel data, deprecated in 3.1+   | UnsignedShort88           -- MESA_ycbcr_texture/APPLE_ycbcr_422+   | UnsignedShort88Rev        -- MESA_ycbcr_texture/APPLE_ycbcr_422+   | Double                    -- vertex arrays (EXT_vertex_array, now core)+   | TwoBytes                  -- CallLists+   | ThreeBytes                -- CallLists+   | FourBytes                 -- CallLists+   deriving ( Eq, Ord, Show )++marshalDataType :: DataType -> GLenum+marshalDataType x = case x of+   UnsignedByte -> gl_UNSIGNED_BYTE+   Byte -> gl_BYTE+   UnsignedShort -> gl_UNSIGNED_SHORT+   Short -> gl_SHORT+   UnsignedInt -> gl_UNSIGNED_INT+   Int -> gl_INT+   HalfFloat -> gl_HALF_FLOAT+   Float -> gl_FLOAT+   UnsignedByte332 -> gl_UNSIGNED_BYTE_3_3_2+   UnsignedByte233Rev -> gl_UNSIGNED_BYTE_2_3_3_REV+   UnsignedShort565 -> gl_UNSIGNED_SHORT_5_6_5+   UnsignedShort565Rev -> gl_UNSIGNED_SHORT_5_6_5_REV+   UnsignedShort4444 -> gl_UNSIGNED_SHORT_4_4_4_4+   UnsignedShort4444Rev -> gl_UNSIGNED_SHORT_4_4_4_4_REV+   UnsignedShort5551 -> gl_UNSIGNED_SHORT_5_5_5_1+   UnsignedShort1555Rev -> gl_UNSIGNED_SHORT_1_5_5_5_REV+   UnsignedInt8888 -> gl_UNSIGNED_INT_8_8_8_8+   UnsignedInt8888Rev -> gl_UNSIGNED_INT_8_8_8_8_REV+   UnsignedInt1010102 -> gl_UNSIGNED_INT_10_10_10_2+   UnsignedInt2101010Rev -> gl_UNSIGNED_INT_2_10_10_10_REV+   UnsignedInt248 -> gl_UNSIGNED_INT_24_8+   UnsignedInt10f11f11fRev -> gl_UNSIGNED_INT_10F_11F_11F_REV+   UnsignedInt5999Rev -> gl_UNSIGNED_INT_5_9_9_9_REV+   Float32UnsignedInt248Rev -> gl_FLOAT_32_UNSIGNED_INT_24_8_REV+   Bitmap -> gl_BITMAP+   -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension+   UnsignedShort88 -> 0x85ba+   -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension+   UnsignedShort88Rev -> 0x85bb+   Double -> gl_DOUBLE+   TwoBytes -> gl_2_BYTES+   ThreeBytes -> gl_3_BYTES+   FourBytes -> gl_4_BYTES++unmarshalDataType :: GLenum -> DataType+unmarshalDataType x+   | x == gl_UNSIGNED_BYTE = UnsignedByte+   | x == gl_BYTE = Byte+   | x == gl_UNSIGNED_SHORT = UnsignedShort+   | x == gl_SHORT = Short+   | x == gl_UNSIGNED_INT = UnsignedInt+   | x == gl_INT = Int+   | x == gl_HALF_FLOAT = HalfFloat+   | x == gl_FLOAT = Float+   | x == gl_UNSIGNED_BYTE_3_3_2 = UnsignedByte332+   | x == gl_UNSIGNED_BYTE_2_3_3_REV = UnsignedByte233Rev+   | x == gl_UNSIGNED_SHORT_5_6_5 = UnsignedShort565+   | x == gl_UNSIGNED_SHORT_5_6_5_REV = UnsignedShort565Rev+   | x == gl_UNSIGNED_SHORT_4_4_4_4 = UnsignedShort4444+   | x == gl_UNSIGNED_SHORT_4_4_4_4_REV = UnsignedShort4444Rev+   | x == gl_UNSIGNED_SHORT_5_5_5_1 = UnsignedShort5551+   | x == gl_UNSIGNED_SHORT_1_5_5_5_REV = UnsignedShort1555Rev+   | x == gl_UNSIGNED_INT_8_8_8_8 = UnsignedInt8888+   | x == gl_UNSIGNED_INT_8_8_8_8_REV = UnsignedInt8888Rev+   | x == gl_UNSIGNED_INT_10_10_10_2 = UnsignedInt1010102+   | x == gl_UNSIGNED_INT_2_10_10_10_REV = UnsignedInt2101010Rev+   | x == gl_UNSIGNED_INT_24_8 = UnsignedInt248+   | x == gl_UNSIGNED_INT_10F_11F_11F_REV = UnsignedInt10f11f11fRev+   | x == gl_UNSIGNED_INT_5_9_9_9_REV = UnsignedInt5999Rev+   | x == gl_FLOAT_32_UNSIGNED_INT_24_8_REV = Float32UnsignedInt248Rev+   | x == gl_BITMAP = Bitmap+   -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension+   | x == 0x85ba = UnsignedShort88+   -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension+   | x == 0x85bb = UnsignedShort88Rev+   | x == gl_DOUBLE = Double+   | x == gl_2_BYTES = TwoBytes+   | x == gl_3_BYTES = ThreeBytes+   | x == gl_4_BYTES = FourBytes+   | otherwise = error ("unmarshalDataType: illegal value " ++ show x)++data DataTypeType+   = TNone+   | TSignedNormalized+   | TUnsignedNormalized+   | TFloat+   | TInt+   | TUnsignedInt++marshalDataTypeType :: DataTypeType -> GLenum+marshalDataTypeType x = case x of+   TNone -> gl_NONE+   TSignedNormalized -> gl_SIGNED_NORMALIZED+   TUnsignedNormalized -> gl_UNSIGNED_NORMALIZED+   TFloat -> gl_FLOAT+   TInt -> gl_INT+   TUnsignedInt -> gl_UNSIGNED_INT++unmarshalDataTypeType :: GLenum -> DataTypeType+unmarshalDataTypeType x+   | x == gl_NONE = TNone+   | x == gl_SIGNED_NORMALIZED = TSignedNormalized+   | x == gl_UNSIGNED_NORMALIZED = TUnsignedNormalized+   | x == gl_FLOAT = TFloat+   | x == gl_INT = TInt+   | x == gl_UNSIGNED_INT = TUnsignedInt+   | otherwise = error $ "unmarshalDataTypeType: illegal value " ++ show x
Graphics/Rendering/OpenGL/GL/DisplayLists.hs view
@@ -1,124 +1,124 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.DisplayLists
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.DataType
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype DisplayList = DisplayList { displayListID :: GLuint }
-   deriving ( Eq, Ord, Show )
-
-instance ObjectName DisplayList where
-   isObjectName = fmap unmarshalGLboolean . glIsList . displayListID
-   deleteObjectNames = mapM_ (uncurry glDeleteLists) . combineConsecutive
-
-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 = 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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.DisplayLists+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.DataType+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype DisplayList = DisplayList { displayListID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName DisplayList where+   isObjectName = fmap unmarshalGLboolean . glIsList . displayListID+   deleteObjectNames = mapM_ (uncurry glDeleteLists) . combineConsecutive++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 = 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)
Graphics/Rendering/OpenGL/GL/Domain.hs view
@@ -1,68 +1,68 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Domain
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Domain+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/EdgeFlag.hs view
@@ -1,36 +1,36 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.EdgeFlag
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | 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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.EdgeFlag+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 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
Graphics/Rendering/OpenGL/GL/Evaluators.hs view
@@ -1,367 +1,367 @@-{-# LANGUAGE KindSignatures #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Evaluators
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.ForeignPtr
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.ControlPoint
-import Graphics.Rendering.OpenGL.GL.Domain
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PolygonMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.VertexArrays
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-type Order = GLint
-
-maxOrder :: GettableStateVar Order
-maxOrder = makeGettableStateVar (getInteger1 id GetMaxEvalOrder)
-
---------------------------------------------------------------------------------
-
-data MapDescriptor d =
-   MapDescriptor (d, d) Stride Order NumComponents
-   deriving ( Eq, Ord, Show )
-
-totalComponents1 :: Domain d => MapDescriptor d -> Int
-totalComponents1 (MapDescriptor _ stride order numComp) =
-   fromIntegral stride * (fromIntegral order - 1) + fromIntegral numComp
-
-totalComponents2 :: Domain d => MapDescriptor d -> MapDescriptor d -> Int
-totalComponents2 uDescriptor vDescriptor@(MapDescriptor _ _ _ numComp) =
-   totalComponents1 uDescriptor + totalComponents1 vDescriptor - fromIntegral numComp
-
---------------------------------------------------------------------------------
-
-peekControlPoints1 ::
-   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> IO [c d]
-peekControlPoints1 descriptor ptr =
-   mapM peekControlPoint (controlPointPtrs1 descriptor ptr)
-
-peekControlPoints2 ::
-      (ControlPoint c, Domain d)
-   => MapDescriptor d -> MapDescriptor d -> Ptr d -> IO [[c d]]
-peekControlPoints2 uDescriptor vDescriptor ptr =
-   mapM (mapM peekControlPoint) (controlPointPtrs2 uDescriptor vDescriptor ptr)
-
-pokeControlPoints1 ::
-   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> [c d] -> IO ()
-pokeControlPoints1 descriptor ptr =
-   zipWithM_ pokeControlPoint (controlPointPtrs1 descriptor ptr)
-
-pokeControlPoints2 ::
-      (ControlPoint c, Domain d)
-   => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[c d]] -> IO ()
-pokeControlPoints2 uDescriptor vDescriptor ptr =
-   zipWithM_ (zipWithM_ pokeControlPoint)
-             (controlPointPtrs2 uDescriptor vDescriptor ptr)
-
-controlPointPtrs1 :: Domain d => MapDescriptor d -> Ptr d -> [Ptr a]
-controlPointPtrs1 (MapDescriptor _ stride order _) ptr =
-   [ ptr `plusPtr` (o * s) | o <- [ 0 .. fromIntegral order - 1 ] ]
-   where s = sizeOfPtr ptr * fromIntegral stride
-
-controlPointPtrs2 ::
-   Domain d => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[Ptr a]]
-controlPointPtrs2 uDescriptor vDescriptor ptr =
-   [ controlPointPtrs1 vDescriptor p | p <- controlPointPtrs1 uDescriptor ptr ]
-
-sizeOfPtr :: Storable a => Ptr a -> Int
-sizeOfPtr = sizeOf . (const undefined :: Ptr a -> a)
-
---------------------------------------------------------------------------------
-
-class Map1 m where
-   withNewMap1 :: (ControlPoint c, Domain d)
-      => MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)
-
-   withMap1 :: (ControlPoint c, Domain d)
-      => m c d -> (MapDescriptor d -> Ptr d -> IO a) -> IO a
-
-   newMap1 :: (ControlPoint c, Domain d)
-      => (d, d) -> [c d] -> IO (m c d)
-
-   getMap1Components :: (ControlPoint c, Domain d)
-      => m c d -> IO ((d, d), [c d])
-
-   withNewMap1 descriptor@(MapDescriptor domain _ _ _) act = do
-      allocaArray (totalComponents1 descriptor) $ \ptr -> do
-         act ptr
-         controlPoints <- peekControlPoints1 descriptor ptr
-         newMap1 domain controlPoints
-
-   withMap1 m act = do
-      (domain, controlPoints) <- getMap1Components m
-      let stride = numComponents (head controlPoints)
-          order = genericLength controlPoints
-          descriptor = MapDescriptor domain stride order (fromIntegral stride)
-      allocaArray (totalComponents1 descriptor) $ \ptr -> do
-         pokeControlPoints1 descriptor ptr controlPoints
-         act descriptor ptr
-
-   newMap1 domain controlPoints = do
-      let stride = numComponents (head controlPoints)
-          order = genericLength controlPoints
-          descriptor = MapDescriptor domain stride order (fromIntegral stride)
-      withNewMap1 descriptor $ \ptr ->
-         pokeControlPoints1 descriptor ptr controlPoints
-
-   getMap1Components m =
-      withMap1 m $ \descriptor@(MapDescriptor domain _ _ _) ptr -> do
-         controlPoints <- peekControlPoints1 descriptor ptr
-         return (domain, controlPoints)
-
---------------------------------------------------------------------------------
-
-data GLmap1 (c :: * -> *) d =
-   GLmap1 (MapDescriptor d) (ForeignPtr d)
-   deriving ( Eq, Ord, Show )
-
-instance Map1 GLmap1 where
-   withNewMap1 descriptor act = do
-      fp <- mallocForeignPtrArray (totalComponents1 descriptor)
-      withForeignPtr fp act
-      return $ GLmap1 descriptor fp
-
-   withMap1 (GLmap1 descriptor fp) act =
-      withForeignPtr fp $ act descriptor
-
---------------------------------------------------------------------------------
-
-map1 :: (Map1 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))
-map1 = makeMap1StateVar enableCap1 getMap1 setMap1
-
-makeMap1StateVar ::
-      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())
-   -> StateVar (Maybe (m c d))
-makeMap1StateVar getCap getAct setAct =
-   makeStateVarMaybe
-      (return (getCap undefined))
-      (getAct undefined)
-      (setAct undefined)
-
-getMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> IO (m c d)
-getMap1 dummyControlPoint = do
-   let target = map1Target dummyControlPoint
-       numComp = fromIntegral (numComponents dummyControlPoint)
-   domain <- allocaArray 2 $ \ptr -> do
-      glGetMapv target (marshalGetMapQuery Domain) ptr
-      peek2 (,) ptr
-   order <- alloca $ \ptr -> do
-      glGetMapiv target (marshalGetMapQuery Order) ptr
-      fmap fromIntegral $ peek ptr
-   withNewMap1 (MapDescriptor domain (numComponents dummyControlPoint) order numComp) $
-      glGetMapv target (marshalGetMapQuery Coeff)
-
-setMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()
-setMap1 dummyControlPoint m =
-   withMap1 m $ \(MapDescriptor (u1, u2) stride order _) ->
-      glMap1 (map1Target dummyControlPoint) u1 u2
-             (fromIntegral stride) (fromIntegral order)
-
---------------------------------------------------------------------------------
-
-class Map2 m where
-   withNewMap2 :: (ControlPoint c, Domain d)
-      => MapDescriptor d -> MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)
-
-   withMap2 :: (ControlPoint c, Domain d)
-      => m c d -> (MapDescriptor d -> MapDescriptor d -> Ptr d -> IO a) -> IO a
-
-   newMap2 :: (ControlPoint c, Domain d)
-      => (d, d) -> (d, d) -> [[c d]] -> IO (m c d)
-
-   getMap2Components :: (ControlPoint c, Domain d)
-      => m c d -> IO ((d, d), (d, d), [[c d]])
-
-   withNewMap2 uDescriptor@(MapDescriptor uDomain _ _ _)
-               vDescriptor@(MapDescriptor vDomain _ _ _) act =
-      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do
-         act ptr
-         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr
-         newMap2 uDomain vDomain controlPoints
-
-   withMap2 m act = do
-      (uDomain, vDomain, controlPoints) <- getMap2Components m
-      let vStride = numComponents (head (head controlPoints))
-          vOrder = genericLength (head controlPoints)
-          uStride = vStride * fromIntegral vOrder
-          uOrder = genericLength controlPoints
-          numComp = fromIntegral vStride
-          uDescriptor = MapDescriptor uDomain uStride uOrder numComp
-          vDescriptor = MapDescriptor vDomain vStride vOrder numComp
-      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do
-         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints
-         act uDescriptor vDescriptor ptr
-
-   newMap2 uDomain vDomain controlPoints = do
-      let vStride = numComponents (head (head controlPoints))
-          vOrder = genericLength (head controlPoints)
-          uStride = vStride * fromIntegral vOrder
-          uOrder = genericLength controlPoints
-          numComp = fromIntegral vStride
-          uDescriptor = MapDescriptor uDomain uStride uOrder numComp
-          vDescriptor = MapDescriptor vDomain vStride vOrder numComp
-      withNewMap2 uDescriptor vDescriptor $ \ptr ->
-         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints
-
-   getMap2Components m =
-      withMap2 m $ \uDescriptor@(MapDescriptor uDomain _ _ _)
-                    vDescriptor@(MapDescriptor vDomain _ _ _) ptr -> do
-         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr
-         return (uDomain, vDomain, controlPoints)
-
---------------------------------------------------------------------------------
-
-data GLmap2 (c :: * -> *) d =
-   GLmap2 (MapDescriptor d)  (MapDescriptor d) (ForeignPtr d)
-   deriving ( Eq, Ord, Show )
-
-instance Map2 GLmap2 where
-   withNewMap2 uDescriptor vDescriptor act = do
-      fp <- mallocForeignPtrArray (totalComponents2 uDescriptor vDescriptor)
-      withForeignPtr fp act
-      return $ GLmap2 uDescriptor vDescriptor fp
-
-   withMap2 (GLmap2 uDescriptor vDescriptor fp) act =
-      withForeignPtr fp $ act uDescriptor vDescriptor
-
---------------------------------------------------------------------------------
-
-map2 :: (Map2 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))
-map2 = makeMap2StateVar enableCap2 getMap2 setMap2
-
-makeMap2StateVar ::
-      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())
-   -> StateVar (Maybe (m c d))
-makeMap2StateVar getCap getAct setAct =
-   makeStateVarMaybe
-      (return (getCap undefined))
-      (getAct undefined)
-      (setAct undefined)
-
-getMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> IO (m c d)
-getMap2 dummyControlPoint = do
-   let target = map2Target dummyControlPoint
-   (uDomain, vDomain) <- allocaArray 4 $ \ptr -> do
-      glGetMapv target (marshalGetMapQuery Domain) ptr
-      peek4 (\u1 u2 v1 v2 -> ((u1, u2), (v1, v2))) ptr
-   (uOrder, vOrder) <- allocaArray 2 $ \ptr -> do
-      glGetMapiv target (marshalGetMapQuery Order) ptr
-      peek2 (,) ptr
-   let vStride = numComponents dummyControlPoint
-       uStride = vStride * fromIntegral vOrder
-   withNewMap2 (MapDescriptor uDomain uStride uOrder (fromIntegral vStride))
-               (MapDescriptor vDomain vStride vOrder (fromIntegral vStride)) $
-      glGetMapv target (marshalGetMapQuery Coeff)
-
-setMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()
-setMap2 dummyControlPoint m =
-   withMap2 m $ \(MapDescriptor (u1, u2) uStride uOrder _)
-                 (MapDescriptor (v1, v2) vStride vOrder _) ->
-      glMap2 (map2Target dummyControlPoint)
-             u1 u2 (fromIntegral uStride) (fromIntegral uOrder)
-             v1 v2 (fromIntegral vStride) (fromIntegral vOrder)
-
---------------------------------------------------------------------------------
-
-data GetMapQuery =
-     Coeff
-   | Order
-   | Domain
-
-marshalGetMapQuery :: GetMapQuery -> GLenum
-marshalGetMapQuery x = case x of
-   Coeff -> gl_COEFF
-   Order -> gl_ORDER
-   Domain -> gl_DOMAIN
-
---------------------------------------------------------------------------------
-
-mapGrid1 :: Domain d => StateVar (GLint, (d, d))
-mapGrid1 =
-   makeStateVar
-      (do n <- getInteger1 id GetMap1GridSegments
-          domain <- get2 (,) GetMap1GridDomain
-          return (n, domain))
-      (\(n, (u1, u2)) -> glMapGrid1 n u1 u2)
-
-mapGrid2 :: Domain d => StateVar ((GLint, (d, d)), (GLint, (d, d)))
-mapGrid2 =
-   makeStateVar
-      (do (un, vn) <- getInteger2 (,) GetMap2GridSegments
-          (u1, u2, v1, v2) <- get4 (,,,) GetMap2GridDomain
-          return ((un, (u1, u2)), (vn, (v1, v2))))
-      (\((un, (u1, u2)), (vn, (v1, v2))) -> glMapGrid2 un u1 u2 vn v1 v2)
-
---------------------------------------------------------------------------------
-
-evalMesh1 :: PolygonMode -> (GLint, GLint) -> IO ()
-evalMesh1 m (p1, p2) = glEvalMesh1 (marshalPolygonMode m) p1 p2
-
-evalMesh2 :: PolygonMode -> (GLint, GLint) -> (GLint, GLint) -> IO ()
-evalMesh2 m (p1, p2) (q1, q2) = glEvalMesh2 (marshalPolygonMode m) p1 p2 q1 q2
-
---------------------------------------------------------------------------------
-
-evalPoint1 :: GLint -> IO ()
-evalPoint1 = glEvalPoint1
-
-evalPoint2 :: (GLint, GLint) -> IO ()
-evalPoint2 = uncurry glEvalPoint2
-
---------------------------------------------------------------------------------
-
-autoNormal :: StateVar Capability
-autoNormal = makeCapability CapAutoNormal
+{-# LANGUAGE KindSignatures #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Evaluators+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.ForeignPtr+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.ControlPoint+import Graphics.Rendering.OpenGL.GL.Domain+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PolygonMode+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.VertexArrays+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++type Order = GLint++maxOrder :: GettableStateVar Order+maxOrder = makeGettableStateVar (getInteger1 id GetMaxEvalOrder)++--------------------------------------------------------------------------------++data MapDescriptor d =+   MapDescriptor (d, d) Stride Order NumComponents+   deriving ( Eq, Ord, Show )++totalComponents1 :: Domain d => MapDescriptor d -> Int+totalComponents1 (MapDescriptor _ stride order numComp) =+   fromIntegral stride * (fromIntegral order - 1) + fromIntegral numComp++totalComponents2 :: Domain d => MapDescriptor d -> MapDescriptor d -> Int+totalComponents2 uDescriptor vDescriptor@(MapDescriptor _ _ _ numComp) =+   totalComponents1 uDescriptor + totalComponents1 vDescriptor - fromIntegral numComp++--------------------------------------------------------------------------------++peekControlPoints1 ::+   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> IO [c d]+peekControlPoints1 descriptor ptr =+   mapM peekControlPoint (controlPointPtrs1 descriptor ptr)++peekControlPoints2 ::+      (ControlPoint c, Domain d)+   => MapDescriptor d -> MapDescriptor d -> Ptr d -> IO [[c d]]+peekControlPoints2 uDescriptor vDescriptor ptr =+   mapM (mapM peekControlPoint) (controlPointPtrs2 uDescriptor vDescriptor ptr)++pokeControlPoints1 ::+   (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> [c d] -> IO ()+pokeControlPoints1 descriptor ptr =+   zipWithM_ pokeControlPoint (controlPointPtrs1 descriptor ptr)++pokeControlPoints2 ::+      (ControlPoint c, Domain d)+   => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[c d]] -> IO ()+pokeControlPoints2 uDescriptor vDescriptor ptr =+   zipWithM_ (zipWithM_ pokeControlPoint)+             (controlPointPtrs2 uDescriptor vDescriptor ptr)++controlPointPtrs1 :: Domain d => MapDescriptor d -> Ptr d -> [Ptr a]+controlPointPtrs1 (MapDescriptor _ stride order _) ptr =+   [ ptr `plusPtr` (o * s) | o <- [ 0 .. fromIntegral order - 1 ] ]+   where s = sizeOfPtr ptr * fromIntegral stride++controlPointPtrs2 ::+   Domain d => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[Ptr a]]+controlPointPtrs2 uDescriptor vDescriptor ptr =+   [ controlPointPtrs1 vDescriptor p | p <- controlPointPtrs1 uDescriptor ptr ]++sizeOfPtr :: Storable a => Ptr a -> Int+sizeOfPtr = sizeOf . (const undefined :: Ptr a -> a)++--------------------------------------------------------------------------------++class Map1 m where+   withNewMap1 :: (ControlPoint c, Domain d)+      => MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)++   withMap1 :: (ControlPoint c, Domain d)+      => m c d -> (MapDescriptor d -> Ptr d -> IO a) -> IO a++   newMap1 :: (ControlPoint c, Domain d)+      => (d, d) -> [c d] -> IO (m c d)++   getMap1Components :: (ControlPoint c, Domain d)+      => m c d -> IO ((d, d), [c d])++   withNewMap1 descriptor@(MapDescriptor domain _ _ _) act = do+      allocaArray (totalComponents1 descriptor) $ \ptr -> do+         act ptr+         controlPoints <- peekControlPoints1 descriptor ptr+         newMap1 domain controlPoints++   withMap1 m act = do+      (domain, controlPoints) <- getMap1Components m+      let stride = numComponents (head controlPoints)+          order = genericLength controlPoints+          descriptor = MapDescriptor domain stride order (fromIntegral stride)+      allocaArray (totalComponents1 descriptor) $ \ptr -> do+         pokeControlPoints1 descriptor ptr controlPoints+         act descriptor ptr++   newMap1 domain controlPoints = do+      let stride = numComponents (head controlPoints)+          order = genericLength controlPoints+          descriptor = MapDescriptor domain stride order (fromIntegral stride)+      withNewMap1 descriptor $ \ptr ->+         pokeControlPoints1 descriptor ptr controlPoints++   getMap1Components m =+      withMap1 m $ \descriptor@(MapDescriptor domain _ _ _) ptr -> do+         controlPoints <- peekControlPoints1 descriptor ptr+         return (domain, controlPoints)++--------------------------------------------------------------------------------++data GLmap1 (c :: * -> *) d =+   GLmap1 (MapDescriptor d) (ForeignPtr d)+   deriving ( Eq, Ord, Show )++instance Map1 GLmap1 where+   withNewMap1 descriptor act = do+      fp <- mallocForeignPtrArray (totalComponents1 descriptor)+      withForeignPtr fp act+      return $ GLmap1 descriptor fp++   withMap1 (GLmap1 descriptor fp) act =+      withForeignPtr fp $ act descriptor++--------------------------------------------------------------------------------++map1 :: (Map1 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))+map1 = makeMap1StateVar enableCap1 getMap1 setMap1++makeMap1StateVar ::+      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())+   -> StateVar (Maybe (m c d))+makeMap1StateVar getCap getAct setAct =+   makeStateVarMaybe+      (return (getCap undefined))+      (getAct undefined)+      (setAct undefined)++getMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> IO (m c d)+getMap1 dummyControlPoint = do+   let target = map1Target dummyControlPoint+       numComp = fromIntegral (numComponents dummyControlPoint)+   domain <- allocaArray 2 $ \ptr -> do+      glGetMapv target (marshalGetMapQuery Domain) ptr+      peek2 (,) ptr+   order <- alloca $ \ptr -> do+      glGetMapiv target (marshalGetMapQuery Order) ptr+      fmap fromIntegral $ peek ptr+   withNewMap1 (MapDescriptor domain (numComponents dummyControlPoint) order numComp) $+      glGetMapv target (marshalGetMapQuery Coeff)++setMap1 :: (Map1 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()+setMap1 dummyControlPoint m =+   withMap1 m $ \(MapDescriptor (u1, u2) stride order _) ->+      glMap1 (map1Target dummyControlPoint) u1 u2+             (fromIntegral stride) (fromIntegral order)++--------------------------------------------------------------------------------++class Map2 m where+   withNewMap2 :: (ControlPoint c, Domain d)+      => MapDescriptor d -> MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)++   withMap2 :: (ControlPoint c, Domain d)+      => m c d -> (MapDescriptor d -> MapDescriptor d -> Ptr d -> IO a) -> IO a++   newMap2 :: (ControlPoint c, Domain d)+      => (d, d) -> (d, d) -> [[c d]] -> IO (m c d)++   getMap2Components :: (ControlPoint c, Domain d)+      => m c d -> IO ((d, d), (d, d), [[c d]])++   withNewMap2 uDescriptor@(MapDescriptor uDomain _ _ _)+               vDescriptor@(MapDescriptor vDomain _ _ _) act =+      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do+         act ptr+         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr+         newMap2 uDomain vDomain controlPoints++   withMap2 m act = do+      (uDomain, vDomain, controlPoints) <- getMap2Components m+      let vStride = numComponents (head (head controlPoints))+          vOrder = genericLength (head controlPoints)+          uStride = vStride * fromIntegral vOrder+          uOrder = genericLength controlPoints+          numComp = fromIntegral vStride+          uDescriptor = MapDescriptor uDomain uStride uOrder numComp+          vDescriptor = MapDescriptor vDomain vStride vOrder numComp+      allocaArray (totalComponents2 uDescriptor vDescriptor) $ \ptr -> do+         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints+         act uDescriptor vDescriptor ptr++   newMap2 uDomain vDomain controlPoints = do+      let vStride = numComponents (head (head controlPoints))+          vOrder = genericLength (head controlPoints)+          uStride = vStride * fromIntegral vOrder+          uOrder = genericLength controlPoints+          numComp = fromIntegral vStride+          uDescriptor = MapDescriptor uDomain uStride uOrder numComp+          vDescriptor = MapDescriptor vDomain vStride vOrder numComp+      withNewMap2 uDescriptor vDescriptor $ \ptr ->+         pokeControlPoints2 uDescriptor vDescriptor ptr controlPoints++   getMap2Components m =+      withMap2 m $ \uDescriptor@(MapDescriptor uDomain _ _ _)+                    vDescriptor@(MapDescriptor vDomain _ _ _) ptr -> do+         controlPoints <- peekControlPoints2 uDescriptor vDescriptor ptr+         return (uDomain, vDomain, controlPoints)++--------------------------------------------------------------------------------++data GLmap2 (c :: * -> *) d =+   GLmap2 (MapDescriptor d)  (MapDescriptor d) (ForeignPtr d)+   deriving ( Eq, Ord, Show )++instance Map2 GLmap2 where+   withNewMap2 uDescriptor vDescriptor act = do+      fp <- mallocForeignPtrArray (totalComponents2 uDescriptor vDescriptor)+      withForeignPtr fp act+      return $ GLmap2 uDescriptor vDescriptor fp++   withMap2 (GLmap2 uDescriptor vDescriptor fp) act =+      withForeignPtr fp $ act uDescriptor vDescriptor++--------------------------------------------------------------------------------++map2 :: (Map2 m, ControlPoint c, Domain d) => StateVar (Maybe (m c d))+map2 = makeMap2StateVar enableCap2 getMap2 setMap2++makeMap2StateVar ::+      (c d -> EnableCap) -> (c d -> IO (m c d)) -> (c d -> m c d -> IO ())+   -> StateVar (Maybe (m c d))+makeMap2StateVar getCap getAct setAct =+   makeStateVarMaybe+      (return (getCap undefined))+      (getAct undefined)+      (setAct undefined)++getMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> IO (m c d)+getMap2 dummyControlPoint = do+   let target = map2Target dummyControlPoint+   (uDomain, vDomain) <- allocaArray 4 $ \ptr -> do+      glGetMapv target (marshalGetMapQuery Domain) ptr+      peek4 (\u1 u2 v1 v2 -> ((u1, u2), (v1, v2))) ptr+   (uOrder, vOrder) <- allocaArray 2 $ \ptr -> do+      glGetMapiv target (marshalGetMapQuery Order) ptr+      peek2 (,) ptr+   let vStride = numComponents dummyControlPoint+       uStride = vStride * fromIntegral vOrder+   withNewMap2 (MapDescriptor uDomain uStride uOrder (fromIntegral vStride))+               (MapDescriptor vDomain vStride vOrder (fromIntegral vStride)) $+      glGetMapv target (marshalGetMapQuery Coeff)++setMap2 :: (Map2 m, ControlPoint c, Domain d) => c d -> m c d -> IO ()+setMap2 dummyControlPoint m =+   withMap2 m $ \(MapDescriptor (u1, u2) uStride uOrder _)+                 (MapDescriptor (v1, v2) vStride vOrder _) ->+      glMap2 (map2Target dummyControlPoint)+             u1 u2 (fromIntegral uStride) (fromIntegral uOrder)+             v1 v2 (fromIntegral vStride) (fromIntegral vOrder)++--------------------------------------------------------------------------------++data GetMapQuery =+     Coeff+   | Order+   | Domain++marshalGetMapQuery :: GetMapQuery -> GLenum+marshalGetMapQuery x = case x of+   Coeff -> gl_COEFF+   Order -> gl_ORDER+   Domain -> gl_DOMAIN++--------------------------------------------------------------------------------++mapGrid1 :: Domain d => StateVar (GLint, (d, d))+mapGrid1 =+   makeStateVar+      (do n <- getInteger1 id GetMap1GridSegments+          domain <- get2 (,) GetMap1GridDomain+          return (n, domain))+      (\(n, (u1, u2)) -> glMapGrid1 n u1 u2)++mapGrid2 :: Domain d => StateVar ((GLint, (d, d)), (GLint, (d, d)))+mapGrid2 =+   makeStateVar+      (do (un, vn) <- getInteger2 (,) GetMap2GridSegments+          (u1, u2, v1, v2) <- get4 (,,,) GetMap2GridDomain+          return ((un, (u1, u2)), (vn, (v1, v2))))+      (\((un, (u1, u2)), (vn, (v1, v2))) -> glMapGrid2 un u1 u2 vn v1 v2)++--------------------------------------------------------------------------------++evalMesh1 :: PolygonMode -> (GLint, GLint) -> IO ()+evalMesh1 m (p1, p2) = glEvalMesh1 (marshalPolygonMode m) p1 p2++evalMesh2 :: PolygonMode -> (GLint, GLint) -> (GLint, GLint) -> IO ()+evalMesh2 m (p1, p2) (q1, q2) = glEvalMesh2 (marshalPolygonMode m) p1 p2 q1 q2++--------------------------------------------------------------------------------++evalPoint1 :: GLint -> IO ()+evalPoint1 = glEvalPoint1++evalPoint2 :: (GLint, GLint) -> IO ()+evalPoint2 = uncurry glEvalPoint2++--------------------------------------------------------------------------------++autoNormal :: StateVar Capability+autoNormal = makeCapability CapAutoNormal
Graphics/Rendering/OpenGL/GL/Exception.hs view
@@ -1,55 +1,55 @@-{-# LANGUAGE CPP #-}
-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Exception
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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)
+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Exception+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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)
Graphics/Rendering/OpenGL/GL/Face.hs view
@@ -1,41 +1,41 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Face
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Face+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data Face =+     Front+   | Back+   | FrontAndBack+   deriving ( Eq, Ord, Show )++marshalFace :: Face -> GLenum+marshalFace x = case x of+   Front -> gl_FRONT+   Back -> gl_BACK+   FrontAndBack -> gl_FRONT_AND_BACK++unmarshalFace :: GLenum -> Face+unmarshalFace x+   | x == gl_FRONT = Front+   | x == gl_BACK = Back+   | x == gl_FRONT_AND_BACK = FrontAndBack+   | otherwise = error ("unmarshalFace: illegal value " ++ show x)
Graphics/Rendering/OpenGL/GL/Feedback.hs view
@@ -1,196 +1,196 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Feedback
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Feedback+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data FeedbackToken =+     PointToken VertexInfo+   | LineToken VertexInfo VertexInfo+   | LineResetToken VertexInfo VertexInfo+   | PolygonToken [VertexInfo]+   | BitmapToken VertexInfo+   | DrawPixelToken VertexInfo+   | CopyPixelToken VertexInfo+   | PassThroughToken PassThroughValue+   deriving ( Eq, Ord, Show )++data VertexInfo =+     Vertex2D             (Vertex2 GLfloat)+   | Vertex3D             (Vertex3 GLfloat)+   | Vertex3DColor        (Vertex3 GLfloat) ColorInfo+   | Vertex3DColorTexture (Vertex3 GLfloat) ColorInfo (TexCoord4 GLfloat)+   | Vertex4DColorTexture (Vertex4 GLfloat) ColorInfo (TexCoord4 GLfloat)+   deriving ( Eq, Ord, Show )++type ColorInfo = Either (Index1 GLint) (Color4 GLfloat)++--------------------------------------------------------------------------------++data FeedbackTag =+     PointTag+   | LineTag+   | LineResetTag+   | PolygonTag+   | BitmapTag+   | DrawPixelTag+   | CopyPixelTag+   | PassThroughTag++unmarshalFeedbackTag :: GLenum -> FeedbackTag+unmarshalFeedbackTag x+   | x == gl_POINT_TOKEN = PointTag+   | x == gl_LINE_TOKEN = LineTag+   | x == gl_LINE_RESET_TOKEN = LineResetTag+   | x == gl_POLYGON_TOKEN = PolygonTag+   | x == gl_BITMAP_TOKEN = BitmapTag+   | x == gl_DRAW_PIXEL_TOKEN = DrawPixelTag+   | x == gl_COPY_PIXEL_TOKEN = CopyPixelTag+   | x == gl_PASS_THROUGH_TOKEN = PassThroughTag+   | otherwise = error ("unmarshalFeedbackTag: illegal value " ++ show x)++--------------------------------------------------------------------------------++data FeedbackType =+     TwoD+   | ThreeD+   | ThreeDColor+   | ThreeDColorTexture+   | FourDColorTexture+   deriving ( Eq, Ord, Show )++marshalFeedbackType :: FeedbackType -> GLenum+marshalFeedbackType x = case x of+   TwoD -> gl_2D+   ThreeD -> gl_3D+   ThreeDColor -> gl_3D_COLOR+   ThreeDColorTexture -> gl_3D_COLOR_TEXTURE+   FourDColorTexture -> gl_4D_COLOR_TEXTURE++--------------------------------------------------------------------------------++getFeedbackTokens ::+   GLsizei -> FeedbackType -> IO a -> IO (a, Maybe [FeedbackToken])+getFeedbackTokens bufSize feedbackType action =+   allocaArray (fromIntegral bufSize) $ \buf -> do+      glFeedbackBuffer bufSize (marshalFeedbackType feedbackType) buf+      (value, numValues) <- withRenderMode Feedback action+      tokens <- parseFeedbackBuffer numValues buf feedbackType+      return (value, tokens)++--------------------------------------------------------------------------------++parseFeedbackBuffer ::+   GLint -> Ptr GLfloat -> FeedbackType -> IO (Maybe [FeedbackToken])+parseFeedbackBuffer numValues buf feedbackType+   | numValues < 0 = return Nothing+   | otherwise     = do+      rgba <- get rgbaMode+      let end = buf `plusPtr`+                  (sizeOf (undefined :: GLfloat) * fromIntegral numValues)+          infoParser = calcInfoParser feedbackType (calcColorParser rgba)+          loop tokens = do+             ptr <- getIOState+             if ptr == end+                then return (reverse tokens)+                else do token <- tokenParser infoParser+                        loop (token : tokens)+      fmap Just $ evalIOState (loop []) buf++type Parser a = IOState GLfloat a++tokenParser :: Parser VertexInfo -> Parser FeedbackToken+tokenParser infoParser = do+   tag <- parseGLenum+   case unmarshalFeedbackTag tag of+      PointTag -> fmap PointToken infoParser+      LineTag -> liftM2 LineToken infoParser infoParser+      LineResetTag -> liftM2 LineResetToken infoParser infoParser+      PolygonTag -> do n <- parseGLint; fmap PolygonToken (nTimes n infoParser)+      BitmapTag -> fmap BitmapToken infoParser+      DrawPixelTag -> fmap DrawPixelToken infoParser+      CopyPixelTag -> fmap CopyPixelToken infoParser+      PassThroughTag -> fmap PassThroughToken parsePassThroughValue++calcInfoParser :: FeedbackType -> Parser ColorInfo -> Parser VertexInfo+calcInfoParser feedbackType colorParser = case feedbackType of+   TwoD ->+      fmap Vertex2D parseVertex2+   ThreeD ->+      fmap Vertex3D parseVertex3+   ThreeDColor ->+      liftM2 Vertex3DColor parseVertex3 colorParser+   ThreeDColorTexture ->+      liftM3 Vertex3DColorTexture parseVertex3 colorParser parseTexCoord4+   FourDColorTexture ->+      liftM3 Vertex4DColorTexture parseVertex4 colorParser parseTexCoord4++parseVertex2 :: Parser (Vertex2 GLfloat)+parseVertex2 = liftM2 Vertex2 parseGLfloat parseGLfloat++parseVertex3 :: Parser (Vertex3 GLfloat)+parseVertex3 = liftM3 Vertex3 parseGLfloat parseGLfloat parseGLfloat++parseVertex4 :: Parser (Vertex4 GLfloat)+parseVertex4 =+   liftM4 Vertex4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat++calcColorParser :: Bool -> Parser ColorInfo+calcColorParser False = fmap Left parseIndex1+calcColorParser True  = fmap Right parseColor4++parseIndex1 :: Parser (Index1 GLint)+parseIndex1 = fmap Index1 parseGLint++parseColor4 :: Parser (Color4 GLfloat)+parseColor4 = liftM4 Color4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat++parseTexCoord4 :: Parser (TexCoord4 GLfloat)+parseTexCoord4 =+   liftM4 TexCoord4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat++parsePassThroughValue :: Parser PassThroughValue+parsePassThroughValue = fmap PassThroughValue parseGLfloat++parseGLenum :: Parser GLenum+parseGLenum = fmap round parseGLfloat++parseGLint :: Parser GLint+parseGLint = fmap round parseGLfloat++parseGLfloat :: Parser GLfloat+parseGLfloat = peekIOState++--------------------------------------------------------------------------------++newtype PassThroughValue = PassThroughValue GLfloat+   deriving ( Eq, Ord, Show )++passThrough :: PassThroughValue -> IO ()+passThrough (PassThroughValue ptv) = glPassThrough ptv
Graphics/Rendering/OpenGL/GL/FlushFinish.hs view
@@ -1,50 +1,50 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FlushFinish
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | 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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FlushFinish+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | Different GL implementations buffer commands in several different+-- locations, including network buffers and the graphics accelerator itself.+-- 'flush' empties all of these buffers, causing all issued commands to be+-- executed as quickly as they are accepted by the actual rendering engine.+-- Though this execution may not be completed in any particular time period, it+-- does complete in finite time.+-- +-- Because any GL program might be executed over a network, or on an accelerator+-- that buffers commands, all programs should call 'flush' whenever they count+-- on having all of their previously issued commands completed. For example,+-- call 'flush' before waiting for user input that depends on the generated+-- image.+-- +-- Note that 'flush' can return at any time. It does not wait until the+-- execution of all previously issued GL commands is complete.++flush :: IO ()+flush = glFlush++-- | 'finish' does not return until the effects of all previously called GL+-- commands are complete. Such effects include all changes to GL state, all+-- changes to connection state, and all changes to the frame buffer contents.+-- +-- Note that 'finish' requires a round trip to the server.++finish :: IO ()+finish = glFinish
Graphics/Rendering/OpenGL/GL/Fog.hs view
@@ -1,203 +1,203 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Fog
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Utils
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-fog :: StateVar Capability
-fog = makeCapability CapFog
-
---------------------------------------------------------------------------------
-
-data FogParameter =
-     FogIndex
-   | FogDensity
-   | FogStart
-   | FogEnd
-   | FogMode
-   | FogColor
-   | FogCoordSrc
-   | FogDistanceMode
-
-marshalFogParameter :: FogParameter -> GLenum
-marshalFogParameter x = case x of
-   FogIndex -> gl_FOG_INDEX
-   FogDensity -> gl_FOG_DENSITY
-   FogStart -> gl_FOG_START
-   FogEnd -> gl_FOG_END
-   FogMode -> gl_FOG_MODE
-   FogColor -> gl_FOG_COLOR
-   FogCoordSrc -> gl_FOG_COORD_SRC
-   -- TODO: Use FOG_DISTANCE_MODE_NV from NV_fog_distance extension
-   FogDistanceMode -> 0x855a
-
---------------------------------------------------------------------------------
-
-data FogMode' =
-     Linear'
-   | Exp'
-   | Exp2'
-
-marshalFogMode' :: FogMode' -> GLint
-marshalFogMode' x = fromIntegral $ case x of
-   Linear' -> gl_LINEAR
-   Exp' -> gl_EXP
-   Exp2' -> gl_EXP2
-
-unmarshalFogMode' :: GLint -> FogMode'
-unmarshalFogMode' x
-   | y == gl_LINEAR = Linear'
-   | y == gl_EXP = Exp'
-   | y == gl_EXP2 = Exp2'
-   | otherwise = error ("unmarshalFogMode': illegal value " ++ show x)
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-data FogMode =
-     Linear GLfloat GLfloat
-   | Exp GLfloat
-   | Exp2 GLfloat
-   deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-fogMode :: StateVar FogMode
-fogMode = makeStateVar getFogMode setFogMode
-
-getFogMode :: IO FogMode
-getFogMode = do
-   mode <- getInteger1 unmarshalFogMode' GetFogMode
-   case mode of
-      Linear' -> do
-         start <- getFloat1 id GetFogStart
-         end <- getFloat1 id GetFogEnd
-         return $ Linear start end
-      Exp' -> getFloat1 Exp GetFogDensity
-      Exp2' -> getFloat1 Exp2 GetFogDensity
-
-setFogMode :: FogMode -> IO ()
-setFogMode (Linear start end) = do
-   fogi FogMode (marshalFogMode' Linear')
-   fogf FogStart start
-   fogf FogEnd end
-setFogMode (Exp density) = do
-   fogi FogMode (marshalFogMode' Exp')
-   fogf FogDensity density
-setFogMode (Exp2 density) = do
-   fogi FogMode (marshalFogMode' Exp2')
-   fogf FogDensity density
-
---------------------------------------------------------------------------------
-
-fogi :: FogParameter -> GLint -> IO ()
-fogi = glFogi . marshalFogParameter
-
-fogf :: FogParameter -> GLfloat -> IO ()
-fogf = glFogf . marshalFogParameter
-
-fogfv :: FogParameter -> Ptr (Color4 GLfloat) -> IO ()
-fogfv param ptr = glFogfv (marshalFogParameter param) (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-fogColor :: StateVar (Color4 GLclampf)
-fogColor =
-   makeStateVar
-      (getClampf4 Color4 GetFogColor)
-      (\c -> with c $ (fogfv FogColor . castPtr))
-
---------------------------------------------------------------------------------
-
-fogIndex :: StateVar (Index1 GLint)
-fogIndex =
-   makeStateVar
-      (getInteger1 Index1 GetFogIndex)
-      (\(Index1 i) -> fogi FogIndex i)
-
---------------------------------------------------------------------------------
-
-data FogCoordSrc =
-     FogCoord
-   | FragmentDepth
-   deriving ( Eq, Ord, Show )
-
-marshalFogCoordSrc :: FogCoordSrc -> GLint
-marshalFogCoordSrc x = fromIntegral $ case x of
-   FogCoord -> gl_FOG_COORD
-   FragmentDepth -> gl_FRAGMENT_DEPTH
-
-unmarshalFogCoordSrc :: GLint -> FogCoordSrc
-unmarshalFogCoordSrc x
-   | y == gl_FOG_COORD = FogCoord
-   | y == gl_FRAGMENT_DEPTH = FragmentDepth
-   | otherwise = error ("unmarshalFogCoordSrc: illegal value " ++ show x)
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-fogCoordSrc :: StateVar FogCoordSrc
-fogCoordSrc =
-   makeStateVar
-      (getInteger1 unmarshalFogCoordSrc GetFogCoordSrc)
-      (fogi FogCoordSrc . marshalFogCoordSrc)
-
---------------------------------------------------------------------------------
-
-data FogDistanceMode =
-     EyeRadial
-   | EyePlaneSigned
-   | EyePlaneAbsolute
-   deriving ( Eq, Ord, Show )
-
-marshalFogDistanceMode :: FogDistanceMode -> GLint
-marshalFogDistanceMode x = fromIntegral $ case x of
-   -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension
-   EyeRadial -> 0x855b
-   EyePlaneSigned ->gl_EYE_PLANE
-   -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension
-   EyePlaneAbsolute -> 0x855c
-
-unmarshalFogDistanceMode :: GLint -> FogDistanceMode
-unmarshalFogDistanceMode x
-   -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension
-   | y == 0x855b = EyeRadial
-   | y == gl_EYE_PLANE = EyePlaneSigned
-   -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension
-   | y == 0x855c = EyePlaneAbsolute
-   | otherwise = error ("unmarshalFogDistanceMode: illegal value " ++ show x)
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-fogDistanceMode :: StateVar FogDistanceMode
-fogDistanceMode =
-   makeStateVar
-      (getInteger1 unmarshalFogDistanceMode GetFogDistanceMode)
-      (fogi FogDistanceMode . marshalFogDistanceMode)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Fog+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Utils+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++fog :: StateVar Capability+fog = makeCapability CapFog++--------------------------------------------------------------------------------++data FogParameter =+     FogIndex+   | FogDensity+   | FogStart+   | FogEnd+   | FogMode+   | FogColor+   | FogCoordSrc+   | FogDistanceMode++marshalFogParameter :: FogParameter -> GLenum+marshalFogParameter x = case x of+   FogIndex -> gl_FOG_INDEX+   FogDensity -> gl_FOG_DENSITY+   FogStart -> gl_FOG_START+   FogEnd -> gl_FOG_END+   FogMode -> gl_FOG_MODE+   FogColor -> gl_FOG_COLOR+   FogCoordSrc -> gl_FOG_COORD_SRC+   -- TODO: Use FOG_DISTANCE_MODE_NV from NV_fog_distance extension+   FogDistanceMode -> 0x855a++--------------------------------------------------------------------------------++data FogMode' =+     Linear'+   | Exp'+   | Exp2'++marshalFogMode' :: FogMode' -> GLint+marshalFogMode' x = fromIntegral $ case x of+   Linear' -> gl_LINEAR+   Exp' -> gl_EXP+   Exp2' -> gl_EXP2++unmarshalFogMode' :: GLint -> FogMode'+unmarshalFogMode' x+   | y == gl_LINEAR = Linear'+   | y == gl_EXP = Exp'+   | y == gl_EXP2 = Exp2'+   | otherwise = error ("unmarshalFogMode': illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++data FogMode =+     Linear GLfloat GLfloat+   | Exp GLfloat+   | Exp2 GLfloat+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++fogMode :: StateVar FogMode+fogMode = makeStateVar getFogMode setFogMode++getFogMode :: IO FogMode+getFogMode = do+   mode <- getInteger1 unmarshalFogMode' GetFogMode+   case mode of+      Linear' -> do+         start <- getFloat1 id GetFogStart+         end <- getFloat1 id GetFogEnd+         return $ Linear start end+      Exp' -> getFloat1 Exp GetFogDensity+      Exp2' -> getFloat1 Exp2 GetFogDensity++setFogMode :: FogMode -> IO ()+setFogMode (Linear start end) = do+   fogi FogMode (marshalFogMode' Linear')+   fogf FogStart start+   fogf FogEnd end+setFogMode (Exp density) = do+   fogi FogMode (marshalFogMode' Exp')+   fogf FogDensity density+setFogMode (Exp2 density) = do+   fogi FogMode (marshalFogMode' Exp2')+   fogf FogDensity density++--------------------------------------------------------------------------------++fogi :: FogParameter -> GLint -> IO ()+fogi = glFogi . marshalFogParameter++fogf :: FogParameter -> GLfloat -> IO ()+fogf = glFogf . marshalFogParameter++fogfv :: FogParameter -> Ptr (Color4 GLfloat) -> IO ()+fogfv param ptr = glFogfv (marshalFogParameter param) (castPtr ptr)++--------------------------------------------------------------------------------++fogColor :: StateVar (Color4 GLclampf)+fogColor =+   makeStateVar+      (getClampf4 Color4 GetFogColor)+      (\c -> with c $ (fogfv FogColor . castPtr))++--------------------------------------------------------------------------------++fogIndex :: StateVar (Index1 GLint)+fogIndex =+   makeStateVar+      (getInteger1 Index1 GetFogIndex)+      (\(Index1 i) -> fogi FogIndex i)++--------------------------------------------------------------------------------++data FogCoordSrc =+     FogCoord+   | FragmentDepth+   deriving ( Eq, Ord, Show )++marshalFogCoordSrc :: FogCoordSrc -> GLint+marshalFogCoordSrc x = fromIntegral $ case x of+   FogCoord -> gl_FOG_COORD+   FragmentDepth -> gl_FRAGMENT_DEPTH++unmarshalFogCoordSrc :: GLint -> FogCoordSrc+unmarshalFogCoordSrc x+   | y == gl_FOG_COORD = FogCoord+   | y == gl_FRAGMENT_DEPTH = FragmentDepth+   | otherwise = error ("unmarshalFogCoordSrc: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++fogCoordSrc :: StateVar FogCoordSrc+fogCoordSrc =+   makeStateVar+      (getInteger1 unmarshalFogCoordSrc GetFogCoordSrc)+      (fogi FogCoordSrc . marshalFogCoordSrc)++--------------------------------------------------------------------------------++data FogDistanceMode =+     EyeRadial+   | EyePlaneSigned+   | EyePlaneAbsolute+   deriving ( Eq, Ord, Show )++marshalFogDistanceMode :: FogDistanceMode -> GLint+marshalFogDistanceMode x = fromIntegral $ case x of+   -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension+   EyeRadial -> 0x855b+   EyePlaneSigned ->gl_EYE_PLANE+   -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension+   EyePlaneAbsolute -> 0x855c++unmarshalFogDistanceMode :: GLint -> FogDistanceMode+unmarshalFogDistanceMode x+   -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension+   | y == 0x855b = EyeRadial+   | y == gl_EYE_PLANE = EyePlaneSigned+   -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension+   | y == 0x855c = EyePlaneAbsolute+   | otherwise = error ("unmarshalFogDistanceMode: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++fogDistanceMode :: StateVar FogDistanceMode+fogDistanceMode =+   makeStateVar+      (getInteger1 unmarshalFogDistanceMode GetFogDistanceMode)+      (fogi FogDistanceMode . marshalFogDistanceMode)
Graphics/Rendering/OpenGL/GL/Framebuffer.hs view
@@ -1,429 +1,429 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Framebuffer
--- Copyright   :  (c) Sven Panne 2002-2013
--- License     :  BSD3
---
--- Maintainer  :  Sven Panne <svenpanne@gmail.com>
--- 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
-   DrawBufferIndex, BufferMode(..), drawBuffer, drawBuffers, drawBufferi, maxDrawBuffers,
-
-   -- * Fine Control of Buffer Updates
-   indexMask, colorMask, colorMaski, stencilMask, stencilMaskSeparate, depthMask,
-
-   -- * Clearing the Buffers
-   ClearBuffer(..), clear,
-   clearColor, clearIndex, clearStencil, clearDepth, clearAccum,
-
-   -- * The Accumulation Buffer
-   AccumOp(..), accum
-) where
-
-import Control.Monad
-import Data.List
-import Data.Maybe
-import Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.BufferMode
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.Face
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | 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)
-
---------------------------------------------------------------------------------
-
-type DrawBufferIndex = GLuint
-
--- | '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
-
--- | 'drawBufferi' is a fast query function. For indices in the range 0..maxDrawBuffers it's results
--- are the same as selection the index from the list returned by drawBuffers. Though this function
--- only uses one gl-function call instead of maxDrawBuffers + 1.
-drawBufferi :: DrawBufferIndex -> GettableStateVar BufferMode
-drawBufferi ind = makeGettableStateVar
-    (getEnum1 unmarshalBufferMode . GetDrawBufferN $ fromIntegral ind)
-
-
---------------------------------------------------------------------------------
-
--- | 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 drawbuffer
-colorMaski :: DrawBufferIndex -> StateVar (Color4 Capability)
-colorMaski x = makeStateVar
-      (getBoolean4i (\r g b a -> Color4 (unmarshalCapability r)
-                                       (unmarshalCapability g)
-                                       (unmarshalCapability b)
-                                       (unmarshalCapability a))
-                    GetColorWritemask x)
-      (\(Color4 r g b a) -> glColorMaski (x) (marshalCapability r)
-                                        (marshalCapability g)
-                                        (marshalCapability b)
-                                        (marshalCapability a))
-
---------------------------------------------------------------------------------
-
--- | Controls whether the depth buffer is enabled for writing. The initial state
--- is 'Enabled'.
-
-depthMask :: StateVar Capability
-depthMask = makeStateVar (getBoolean1 unmarshalCapability GetDepthWritemask)
-                         (glDepthMask . marshalCapability)
-
---------------------------------------------------------------------------------
-
--- | Controls the writing of individual bits in the stencil planes. The least
--- significant /n/ bits of its value, where /n/ is the number of bits in the
--- stencil buffer, specify a mask. Where a 1 appears in the mask, it is
--- possible to write to the corresponding bit in the stencil buffer. Where a 0
--- appears, the corresponding bit is write-protected.
--- Initially, all bits are enabled for writing.
-
-stencilMask :: StateVar GLuint
-stencilMask =
-   makeStateVar (getInteger1 fromIntegral GetStencilWritemask) glStencilMask
-
-stencilMaskSeparate :: Face -> SettableStateVar GLuint
-stencilMaskSeparate face =
-   makeSettableStateVar $
-      glStencilMaskSeparate (marshalFace face)
-
---------------------------------------------------------------------------------
-
--- | The buffers which can be cleared with 'clear'.
-
-data ClearBuffer =
-     ColorBuffer   -- ^ The buffers currently enabled for color writing.
-   | AccumBuffer   -- ^ The accumulation buffer.
-   | StencilBuffer -- ^ The stencil buffer.
-   | DepthBuffer   -- ^ The depth buffer.
-   deriving ( Eq, Ord, Show )
-
-marshalClearBuffer :: ClearBuffer -> GLbitfield
-marshalClearBuffer x = case x of
-   ColorBuffer -> gl_COLOR_BUFFER_BIT
-   AccumBuffer -> gl_ACCUM_BUFFER_BIT
-   StencilBuffer -> gl_STENCIL_BUFFER_BIT
-   DepthBuffer -> gl_DEPTH_BUFFER_BIT
-
---------------------------------------------------------------------------------
-
--- | Set the bitplane area of the window to values previously selected by
--- 'clearColor', 'clearIndex', 'clearDepth', 'clearStencil', and 'clearAccum'.
--- Multiple color buffers can be cleared simultaneously by selecting more than
--- one buffer at a time using 'drawBuffer'.
---
--- The pixel ownership test, the scissor test, dithering, and the buffer
--- writemasks affect the operation of 'clear'. The scissor box bounds the
--- cleared region. Alpha function, blend function, logical operation,
--- stenciling, texure mapping, and depth-buffering are ignored by 'clear'.
---
--- 'clear' takes a list of buffers, indicating which buffers are to be cleared.
--- If a buffer is not present, then a 'clear' directed at that buffer has no
--- effect.
---
--- The value to which each buffer is cleared depends on the setting of the clear
--- value for that buffer.
-
-clear :: [ClearBuffer] -> IO ()
-clear = glClear . sum . map marshalClearBuffer
-
---------------------------------------------------------------------------------
-
--- | Controls the red, green, blue, and alpha values used by 'clear' to clear
--- the color buffers. Values written into 'clearColor' are clamped to the range
--- [0, 1]. Initially, all values are 0.
-
-clearColor :: StateVar (Color4 GLclampf)
-clearColor = makeStateVar (getClampf4 Color4 GetColorClearValue)
-                          (\(Color4 r g b a) -> glClearColor r g b a)
-
---------------------------------------------------------------------------------
-
--- | Controls the index /c/ used by 'clear' to clear the color index buffers.
--- /c/ is not clamped. Rather, /c/ is converted to a fixed-point value with
--- unspecified precision to the right of the binary point. The integer part of
--- this value is then masked with 2^/m/-1, where /m/ is the number of bits in a
--- color index stored in the framebuffer. Initially, the value is 0.
-
-clearIndex :: StateVar (Index1 GLfloat)
-clearIndex = makeStateVar (getFloat1 Index1 GetIndexClearValue)
-                          (\(Index1 i) -> glClearIndex i)
-
---------------------------------------------------------------------------------
-
--- | Controls the depth value used by 'clear' to clear the depth buffer. Values
--- written into 'clearDepth' are clamped to the range [0, 1]. The initial value
--- is 1.
-
-clearDepth :: StateVar GLclampd
-clearDepth = makeStateVar (getClampd1 id GetDepthClearValue) glClearDepth
-
---------------------------------------------------------------------------------
-
--- | Controls the value /s/ used by 'clear' to clear the stencil buffer. /s/ is
--- masked with 2^/m/-1, where /m/ is the number of bits in the stencil buffer.
--- Initially, the value is 0.
-
-clearStencil :: StateVar GLint
-clearStencil = makeStateVar (getInteger1 id GetStencilClearValue) glClearStencil
-
---------------------------------------------------------------------------------
-
--- | Controls the red, green, blue, and alpha values used by 'clear' to clear
--- the accumulation buffer. Values written into 'clearAccum' are clamped to the
--- range [-1, 1]. The initial values are all 0.
-
-clearAccum :: StateVar (Color4 GLfloat)
-clearAccum =
-   makeStateVar (getFloat4 Color4 GetAccumClearValue)
-                (\(Color4 r g b a) -> glClearAccum r g b a)
-
---------------------------------------------------------------------------------
-
--- | An operation on the accumulation buffer.
-
-data AccumOp =
-     Accum
-     -- ^ Obtains /R/, /G/, /B/, and /A/ values from the buffer currently
-     -- selected for reading (see
-     -- 'Graphics.Rendering.OpenGL.GL.ReadCopyPixels.readBuffer'). Each
-     -- component value is divided by 2^/n/-1, where /n/ is the number of bits
-     -- allocated to each color component in the currently selected buffer. The
-     -- result is a floating-point value in the range [0, 1], which is
-     -- multiplied by the value given to 'accum' and added to the corresponding
-     -- pixel component in the accumulation buffer, thereby updating the
-     -- accumulation buffer.
-   | Load
-     -- ^ Similar to 'Accum', except that the current value in the accumulation
-     -- buffer is not used in the calculation of the new value. That is, the
-     -- /R/, /G/, /B/, and /A/ values from the currently selected buffer are
-     -- divided by 2^/n/-1, multiplied by the value given to 'accum', and then
-     -- stored in the corresponding accumulation buffer cell, overwriting the
-     -- current value.
-   | Return
-     -- ^ Transfers accumulation buffer values to the color buffer or buffers
-     -- currently selected for writing. Each /R/, /G/, /B/, and /A/ component
-     -- is multiplied by the value given to 'accum', then multiplied by 2^/n/-1,
-     -- clamped to the range [0, 2^/n/-1], and stored in the corresponding
-     -- display buffer cell. The only fragment operations that are applied to
-     -- this transfer are pixel ownership, scissor, dithering, and color
-     -- writemasks.
-   | Mult
-     -- ^ Multiplies each /R/, /G/, /B/, and /A/ in the accumulation buffer by
-     -- the value given to 'accum' and returns the scaled component to its
-     -- corresponding accumulation buffer location.
-   | Add
-     -- ^ Adds the value given to 'accum' to each /R/, /G/, /B/, and /A/ in the
-     -- accumulation buffer.
-   deriving ( Eq, Ord, Show )
-
-marshalAccumOp :: AccumOp -> GLenum
-marshalAccumOp x = case x of
-   Accum -> gl_ACCUM
-   Load -> gl_LOAD
-   Return -> gl_RETURN
-   Mult -> gl_MULT
-   Add -> gl_ADD
-
---------------------------------------------------------------------------------
-
--- | The accumulation buffer is an extended-range color buffer. Images are not
--- rendered into it. Rather, images rendered into one of the color buffers are
--- added to the contents of the accumulation buffer after rendering. Effects
--- such as antialiasing (of points, lines, and polygons), motion blur, and
--- depth of field can be created by accumulating images generated with different
--- transformation matrices.
---
--- Each pixel in the accumulation buffer consists of red, green, blue, and alpha
--- values. The number of bits per component in the accumulation buffer depends
--- on the implementation (see 'accumBits'). Regardless of the number of bits per
--- component, the range of values stored by each component is [-1, 1]. The
--- accumulation buffer pixels are mapped one-to-one with frame buffer pixels.
---
--- 'accum' operates on the accumulation buffer. The first argument selects an
--- accumulation buffer operation. The second argument, is a floating-point value
--- to be used in that operation, see 'AccumOp'.
---
--- All accumulation buffer operations are limited to the area of the current
--- scissor box and applied identically to the red, green, blue, and alpha
--- components of each pixel. If an 'accum' operation results in a value outside
--- the range [-1, 1], the contents of an accumulation buffer pixel component
--- are undefined.
---
--- To clear the accumulation buffer, use 'clearAccum' to specify the clear
--- value, then call 'clear' with the accumulation buffer enabled.
-
-accum :: AccumOp -> GLfloat -> IO ()
-accum = glAccum . marshalAccumOp
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Framebuffer+-- Copyright   :  (c) Sven Panne 2002-2013+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- 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+   DrawBufferIndex, BufferMode(..), drawBuffer, drawBuffers, drawBufferi, maxDrawBuffers,++   -- * Fine Control of Buffer Updates+   indexMask, colorMask, colorMaski, stencilMask, stencilMaskSeparate, depthMask,++   -- * Clearing the Buffers+   ClearBuffer(..), clear,+   clearColor, clearIndex, clearStencil, clearDepth, clearAccum,++   -- * The Accumulation Buffer+   AccumOp(..), accum+) where++import Control.Monad+import Data.List+import Data.Maybe+import Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.BufferMode+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Face+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 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)++--------------------------------------------------------------------------------++type DrawBufferIndex = GLuint++-- | '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++-- | 'drawBufferi' is a fast query function. For indices in the range 0..maxDrawBuffers it's results+-- are the same as selection the index from the list returned by drawBuffers. Though this function+-- only uses one gl-function call instead of maxDrawBuffers + 1.+drawBufferi :: DrawBufferIndex -> GettableStateVar BufferMode+drawBufferi ind = makeGettableStateVar+    (getEnum1 unmarshalBufferMode . GetDrawBufferN $ fromIntegral ind)+++--------------------------------------------------------------------------------++-- | 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 drawbuffer+colorMaski :: DrawBufferIndex -> StateVar (Color4 Capability)+colorMaski x = makeStateVar+      (getBoolean4i (\r g b a -> Color4 (unmarshalCapability r)+                                       (unmarshalCapability g)+                                       (unmarshalCapability b)+                                       (unmarshalCapability a))+                    GetColorWritemask x)+      (\(Color4 r g b a) -> glColorMaski (x) (marshalCapability r)+                                        (marshalCapability g)+                                        (marshalCapability b)+                                        (marshalCapability a))++--------------------------------------------------------------------------------++-- | Controls whether the depth buffer is enabled for writing. The initial state+-- is 'Enabled'.++depthMask :: StateVar Capability+depthMask = makeStateVar (getBoolean1 unmarshalCapability GetDepthWritemask)+                         (glDepthMask . marshalCapability)++--------------------------------------------------------------------------------++-- | Controls the writing of individual bits in the stencil planes. The least+-- significant /n/ bits of its value, where /n/ is the number of bits in the+-- stencil buffer, specify a mask. Where a 1 appears in the mask, it is+-- possible to write to the corresponding bit in the stencil buffer. Where a 0+-- appears, the corresponding bit is write-protected.+-- Initially, all bits are enabled for writing.++stencilMask :: StateVar GLuint+stencilMask =+   makeStateVar (getInteger1 fromIntegral GetStencilWritemask) glStencilMask++stencilMaskSeparate :: Face -> SettableStateVar GLuint+stencilMaskSeparate face =+   makeSettableStateVar $+      glStencilMaskSeparate (marshalFace face)++--------------------------------------------------------------------------------++-- | The buffers which can be cleared with 'clear'.++data ClearBuffer =+     ColorBuffer   -- ^ The buffers currently enabled for color writing.+   | AccumBuffer   -- ^ The accumulation buffer.+   | StencilBuffer -- ^ The stencil buffer.+   | DepthBuffer   -- ^ The depth buffer.+   deriving ( Eq, Ord, Show )++marshalClearBuffer :: ClearBuffer -> GLbitfield+marshalClearBuffer x = case x of+   ColorBuffer -> gl_COLOR_BUFFER_BIT+   AccumBuffer -> gl_ACCUM_BUFFER_BIT+   StencilBuffer -> gl_STENCIL_BUFFER_BIT+   DepthBuffer -> gl_DEPTH_BUFFER_BIT++--------------------------------------------------------------------------------++-- | Set the bitplane area of the window to values previously selected by+-- 'clearColor', 'clearIndex', 'clearDepth', 'clearStencil', and 'clearAccum'.+-- Multiple color buffers can be cleared simultaneously by selecting more than+-- one buffer at a time using 'drawBuffer'.+--+-- The pixel ownership test, the scissor test, dithering, and the buffer+-- writemasks affect the operation of 'clear'. The scissor box bounds the+-- cleared region. Alpha function, blend function, logical operation,+-- stenciling, texure mapping, and depth-buffering are ignored by 'clear'.+--+-- 'clear' takes a list of buffers, indicating which buffers are to be cleared.+-- If a buffer is not present, then a 'clear' directed at that buffer has no+-- effect.+--+-- The value to which each buffer is cleared depends on the setting of the clear+-- value for that buffer.++clear :: [ClearBuffer] -> IO ()+clear = glClear . sum . map marshalClearBuffer++--------------------------------------------------------------------------------++-- | Controls the red, green, blue, and alpha values used by 'clear' to clear+-- the color buffers. Values written into 'clearColor' are clamped to the range+-- [0, 1]. Initially, all values are 0.++clearColor :: StateVar (Color4 GLclampf)+clearColor = makeStateVar (getClampf4 Color4 GetColorClearValue)+                          (\(Color4 r g b a) -> glClearColor r g b a)++--------------------------------------------------------------------------------++-- | Controls the index /c/ used by 'clear' to clear the color index buffers.+-- /c/ is not clamped. Rather, /c/ is converted to a fixed-point value with+-- unspecified precision to the right of the binary point. The integer part of+-- this value is then masked with 2^/m/-1, where /m/ is the number of bits in a+-- color index stored in the framebuffer. Initially, the value is 0.++clearIndex :: StateVar (Index1 GLfloat)+clearIndex = makeStateVar (getFloat1 Index1 GetIndexClearValue)+                          (\(Index1 i) -> glClearIndex i)++--------------------------------------------------------------------------------++-- | Controls the depth value used by 'clear' to clear the depth buffer. Values+-- written into 'clearDepth' are clamped to the range [0, 1]. The initial value+-- is 1.++clearDepth :: StateVar GLclampd+clearDepth = makeStateVar (getClampd1 id GetDepthClearValue) glClearDepth++--------------------------------------------------------------------------------++-- | Controls the value /s/ used by 'clear' to clear the stencil buffer. /s/ is+-- masked with 2^/m/-1, where /m/ is the number of bits in the stencil buffer.+-- Initially, the value is 0.++clearStencil :: StateVar GLint+clearStencil = makeStateVar (getInteger1 id GetStencilClearValue) glClearStencil++--------------------------------------------------------------------------------++-- | Controls the red, green, blue, and alpha values used by 'clear' to clear+-- the accumulation buffer. Values written into 'clearAccum' are clamped to the+-- range [-1, 1]. The initial values are all 0.++clearAccum :: StateVar (Color4 GLfloat)+clearAccum =+   makeStateVar (getFloat4 Color4 GetAccumClearValue)+                (\(Color4 r g b a) -> glClearAccum r g b a)++--------------------------------------------------------------------------------++-- | An operation on the accumulation buffer.++data AccumOp =+     Accum+     -- ^ Obtains /R/, /G/, /B/, and /A/ values from the buffer currently+     -- selected for reading (see+     -- 'Graphics.Rendering.OpenGL.GL.ReadCopyPixels.readBuffer'). Each+     -- component value is divided by 2^/n/-1, where /n/ is the number of bits+     -- allocated to each color component in the currently selected buffer. The+     -- result is a floating-point value in the range [0, 1], which is+     -- multiplied by the value given to 'accum' and added to the corresponding+     -- pixel component in the accumulation buffer, thereby updating the+     -- accumulation buffer.+   | Load+     -- ^ Similar to 'Accum', except that the current value in the accumulation+     -- buffer is not used in the calculation of the new value. That is, the+     -- /R/, /G/, /B/, and /A/ values from the currently selected buffer are+     -- divided by 2^/n/-1, multiplied by the value given to 'accum', and then+     -- stored in the corresponding accumulation buffer cell, overwriting the+     -- current value.+   | Return+     -- ^ Transfers accumulation buffer values to the color buffer or buffers+     -- currently selected for writing. Each /R/, /G/, /B/, and /A/ component+     -- is multiplied by the value given to 'accum', then multiplied by 2^/n/-1,+     -- clamped to the range [0, 2^/n/-1], and stored in the corresponding+     -- display buffer cell. The only fragment operations that are applied to+     -- this transfer are pixel ownership, scissor, dithering, and color+     -- writemasks.+   | Mult+     -- ^ Multiplies each /R/, /G/, /B/, and /A/ in the accumulation buffer by+     -- the value given to 'accum' and returns the scaled component to its+     -- corresponding accumulation buffer location.+   | Add+     -- ^ Adds the value given to 'accum' to each /R/, /G/, /B/, and /A/ in the+     -- accumulation buffer.+   deriving ( Eq, Ord, Show )++marshalAccumOp :: AccumOp -> GLenum+marshalAccumOp x = case x of+   Accum -> gl_ACCUM+   Load -> gl_LOAD+   Return -> gl_RETURN+   Mult -> gl_MULT+   Add -> gl_ADD++--------------------------------------------------------------------------------++-- | The accumulation buffer is an extended-range color buffer. Images are not+-- rendered into it. Rather, images rendered into one of the color buffers are+-- added to the contents of the accumulation buffer after rendering. Effects+-- such as antialiasing (of points, lines, and polygons), motion blur, and+-- depth of field can be created by accumulating images generated with different+-- transformation matrices.+--+-- Each pixel in the accumulation buffer consists of red, green, blue, and alpha+-- values. The number of bits per component in the accumulation buffer depends+-- on the implementation (see 'accumBits'). Regardless of the number of bits per+-- component, the range of values stored by each component is [-1, 1]. The+-- accumulation buffer pixels are mapped one-to-one with frame buffer pixels.+--+-- 'accum' operates on the accumulation buffer. The first argument selects an+-- accumulation buffer operation. The second argument, is a floating-point value+-- to be used in that operation, see 'AccumOp'.+--+-- All accumulation buffer operations are limited to the area of the current+-- scissor box and applied identically to the red, green, blue, and alpha+-- components of each pixel. If an 'accum' operation results in a value outside+-- the range [-1, 1], the contents of an accumulation buffer pixel component+-- are undefined.+--+-- To clear the accumulation buffer, use 'clearAccum' to specify the clear+-- value, then call 'clear' with the accumulation buffer enabled.++accum :: AccumOp -> GLfloat -> IO ()+accum = glAccum . marshalAccumOp
Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs view
@@ -1,25 +1,25 @@------------------------------------------------------------------------------
--- |
--- Copyright   :  (c) Sven Panne 2013
--- 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
+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (c) Sven Panne 2013+-- 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
Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs view
@@ -1,67 +1,67 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013
--- 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.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
-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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013+-- 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.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs view
@@ -1,41 +1,41 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject
--- Copyright   :  (c) Sven Panne 2013
--- 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 Foreign.Marshal
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.Raw
-       
---------------------------------------------------------------------------------
-
-data FramebufferObject = FramebufferObject { framebufferID :: GLuint }
-   deriving ( Eq, Ord, Show )
-
-instance ObjectName FramebufferObject where
-    isObjectName = fmap unmarshalGLboolean . glIsFramebuffer . framebufferID
-
-    deleteObjectNames objs =
-       withArrayLen (map framebufferID objs) $
-          glDeleteFramebuffers . fromIntegral
-
-instance GeneratableObjectName FramebufferObject where
-    genObjectNames n =
-       allocaArray n $ \buf -> do
-          glGenFramebuffers (fromIntegral n) buf
-          fmap (map FramebufferObject) $ peekArray n buf
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject+-- Copyright   :  (c) Sven Panne 2013+-- 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 Foreign.Marshal+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.Raw+       +--------------------------------------------------------------------------------++data FramebufferObject = FramebufferObject { framebufferID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName FramebufferObject where+    isObjectName = fmap unmarshalGLboolean . glIsFramebuffer . framebufferID++    deleteObjectNames objs =+       withArrayLen (map framebufferID objs) $+          glDeleteFramebuffers . fromIntegral++instance GeneratableObjectName FramebufferObject where+    genObjectNames n =+       allocaArray n $ \buf -> do+          glGenFramebuffers (fromIntegral n) buf+          fmap (map FramebufferObject) $ peekArray n buf
Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs view
@@ -1,105 +1,105 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment
--- Copyright   :  (c) Sven Panne 2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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 = alloca $ \buf -> do
-   glGetFramebufferAttachmentParameteriv (marshalFramebufferTarget fbt)
-      mfba p buf
-   peek1 f buf
-      where mfba = fromMaybe (error $ "invalid value" ++ show fba) (marshalAttachment fba)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment+-- Copyright   :  (c) Sven Panne 2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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 = alloca $ \buf -> do+   glGetFramebufferAttachmentParameteriv (marshalFramebufferTarget fbt)+      mfba p buf+   peek1 f buf+      where mfba = fromMaybe (error $ "invalid value" ++ show fba) (marshalAttachment fba)
Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs view
@@ -1,81 +1,81 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013
--- 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 Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
-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
-
------------------------------------------------------------------------------
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013+-- 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 Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++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++-----------------------------------------------------------------------------
Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs view
@@ -1,34 +1,34 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget
--- Copyright   :  (c) Sven Panne 2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget+-- Copyright   :  (c) Sven Panne 2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs view
@@ -1,232 +1,232 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013
--- 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 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.StateVar
-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.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
-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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013+-- 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 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.StateVar+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.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObject.hs view
@@ -1,40 +1,40 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject
--- Copyright   :  (c) Sven Panne 2013
--- 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 Foreign.Marshal
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.Raw
-       
---------------------------------------------------------------------------------
-
-data RenderbufferObject = RenderbufferObject { renderbufferID :: GLuint}
-
-instance ObjectName RenderbufferObject where
-   isObjectName = fmap unmarshalGLboolean . glIsRenderbuffer . renderbufferID
-
-   deleteObjectNames objs =
-      withArrayLen (map renderbufferID objs) $
-         glDeleteRenderbuffers . fromIntegral
-
-instance GeneratableObjectName RenderbufferObject where
-   genObjectNames n =
-      allocaArray n $ \buf -> do
-         glGenRenderbuffers (fromIntegral n) buf
-         fmap (map RenderbufferObject) $ peekArray n buf
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject+-- Copyright   :  (c) Sven Panne 2013+-- 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 Foreign.Marshal+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.Raw+       +--------------------------------------------------------------------------------++data RenderbufferObject = RenderbufferObject { renderbufferID :: GLuint}++instance ObjectName RenderbufferObject where+   isObjectName = fmap unmarshalGLboolean . glIsRenderbuffer . renderbufferID++   deleteObjectNames objs =+      withArrayLen (map renderbufferID objs) $+         glDeleteRenderbuffers . fromIntegral++instance GeneratableObjectName RenderbufferObject where+   genObjectNames n =+      allocaArray n $ \buf -> do+         glGenRenderbuffers (fromIntegral n) buf+         fmap (map RenderbufferObject) $ peekArray n buf
Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs view
@@ -1,73 +1,73 @@-{-# OPTIONS_HADDOCK hide #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RendebufferObjects
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013
--- 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 Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RendebufferObjects+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013+-- 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 Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject+import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferTarget.hs view
@@ -1,43 +1,43 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget
--- Copyright   :  (c) Sven Panne 2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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 =
-   alloca $ \buf -> do
-      glGetRenderbufferParameteriv (marshalRenderbufferTarget rbt) p buf
-      peek1 f buf
------------------------------------------------------------------------------
-
-newtype Samples = Samples GLsizei
-   deriving ( Eq, Ord, Show )
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget+-- Copyright   :  (c) Sven Panne 2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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 =+   alloca $ \buf -> do+      glGetRenderbufferParameteriv (marshalRenderbufferTarget rbt) p buf+      peek1 f buf+-----------------------------------------------------------------------------++newtype Samples = Samples GLsizei+   deriving ( Eq, Ord, Show )
Graphics/Rendering/OpenGL/GL/GLboolean.hs view
@@ -1,30 +1,30 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.GLboolean
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.GLboolean+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++marshalGLboolean :: Num a => Bool -> a+marshalGLboolean x = fromIntegral $ case x of+   False -> gl_FALSE+   True -> gl_TRUE++unmarshalGLboolean :: (Eq a, Num a) => a -> Bool+unmarshalGLboolean = (/= fromIntegral gl_FALSE)
Graphics/Rendering/OpenGL/GL/Hints.hs view
@@ -1,88 +1,88 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Hints
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data HintTarget =
-     PerspectiveCorrection
-   | PointSmooth
-   | LineSmooth
-   | PolygonSmooth
-   | Fog
-   | GenerateMipmap
-   | TextureCompression
-   | PackCMYK
-   | UnpackCMYK
-   deriving ( Eq, Ord, Show )
-
-marshalHintTarget :: HintTarget -> GLenum
-marshalHintTarget x = case x of
-   PerspectiveCorrection -> gl_PERSPECTIVE_CORRECTION_HINT
-   PointSmooth -> gl_POINT_SMOOTH_HINT
-   LineSmooth -> gl_LINE_SMOOTH_HINT
-   PolygonSmooth -> gl_POLYGON_SMOOTH_HINT
-   Fog -> gl_FOG_HINT
-   GenerateMipmap -> gl_GENERATE_MIPMAP_HINT
-   TextureCompression -> gl_TEXTURE_COMPRESSION_HINT
-   PackCMYK -> gl_PACK_CMYK_HINT
-   UnpackCMYK -> gl_UNPACK_CMYK_HINT
-
-hintTargetToGetPName :: HintTarget -> 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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Hints+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data HintTarget =+     PerspectiveCorrection+   | PointSmooth+   | LineSmooth+   | PolygonSmooth+   | Fog+   | GenerateMipmap+   | TextureCompression+   | PackCMYK+   | UnpackCMYK+   deriving ( Eq, Ord, Show )++marshalHintTarget :: HintTarget -> GLenum+marshalHintTarget x = case x of+   PerspectiveCorrection -> gl_PERSPECTIVE_CORRECTION_HINT+   PointSmooth -> gl_POINT_SMOOTH_HINT+   LineSmooth -> gl_LINE_SMOOTH_HINT+   PolygonSmooth -> gl_POLYGON_SMOOTH_HINT+   Fog -> gl_FOG_HINT+   GenerateMipmap -> gl_GENERATE_MIPMAP_HINT+   TextureCompression -> gl_TEXTURE_COMPRESSION_HINT+   PackCMYK -> gl_PACK_CMYK_HINT+   UnpackCMYK -> gl_UNPACK_CMYK_HINT++hintTargetToGetPName :: HintTarget -> 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)
Graphics/Rendering/OpenGL/GL/IOState.hs view
@@ -1,57 +1,57 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.IOState
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
-
-import Control.Monad(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 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 = replicateM (fromIntegral n)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.IOState+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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++import Control.Monad(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 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 = replicateM (fromIntegral n)
Graphics/Rendering/OpenGL/GL/LineSegments.hs view
@@ -1,150 +1,150 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.LineSegments
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | '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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.LineSegments+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 'lineWidth' contains the rasterized width of both aliased and antialiased+-- lines. The initial value is 1. Using a line width other than 1 has different+-- effects, depending on whether line antialiasing is enabled (see+-- 'lineSmooth'). Line antialiasing is initially disabled.+--+-- If line antialiasing is disabled, the actual width is determined by rounding+-- the supplied width to the nearest integer. (If the rounding results in the+-- value 0, it is as if the line width were 1.) If /delta x/ >= /delta y/, /i/+-- pixels are filled in each column that is rasterized, where /i/ is the+-- rounded value of 'lineWidth'. Otherwise, /i/ pixels are filled in each row+-- that is rasterized.+--+-- If antialiasing is enabled, line rasterization produces a fragment for each+-- pixel square that intersects the region lying within the rectangle having+-- width equal to the current line width, length equal to the actual length of+-- the line, and centered on the mathematical line segment. The coverage value+-- for each fragment is the window coordinate area of the intersection of the+-- rectangular region with the corresponding pixel square. This value is saved+-- and used in the final rasterization step.+--+-- Not all widths can be supported when line antialiasing is enabled. If an+-- unsupported width is requested, the nearest supported width is used. Only+-- width 1 is guaranteed to be supported; others depend on the implementation.+--  Likewise, there is a range for aliased line widths as well. To query the+-- range of supported widths of antialiased lines and the size difference+-- between supported widths within the range, query 'smoothLineWidthRange' and+-- 'smoothLineWidthGranularity', respectively. For aliased lines, query the+-- supported range with 'aliasedLineWidthRange'.+--+-- The line width specified when 'lineWidth' is set is always returned when it+-- is queried. Clamping and rounding for aliased and antialiased lines have no+-- effect on the specified value.+--+-- A non-antialiased line width may be clamped to an implementation-dependent+-- maximum.  Query 'aliasedLineWidthRange' to determine the maximum width.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if+-- 'lineWidth' is set to a value less than or equal to zero.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if+-- 'lineWidth' is set during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.++lineWidth :: StateVar GLfloat+lineWidth = makeStateVar (getFloat1 id GetLineWidth) glLineWidth++--------------------------------------------------------------------------------++-- | Line stippling masks out certain fragments produced by rasterization; those+-- fragments will not be drawn. The masking is achieved by using three+-- parameters: the repeat count (1st element of the 'lineStipple' pair, clamped+-- to the range [ 1 .. 256 ]), the 16-bit line stipple pattern (2nd element),+-- and an integer stipple counter /s/.+--+-- The counter /s/ is reset to 0 at before the first action during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is called and before+-- each line segment during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is generated. It is+-- incremented after each fragment of a unit width aliased line segment is+-- generated or after each /i/ fragments of an /i/ width line segment are+-- generated. The /i/ fragments associated with count /s/ are masked out if+-- @'Data.Bits.testBit' /pattern/ (( /s/ \/ /factor/ ) /mod/ 16)@ is 'False',+-- otherwise these fragments are sent to the frame buffer. Bit zero of the+-- pattern is the least significant bit, i.e. it is used first.+--+-- Antialiased lines are treated as a sequence of rectangles of height 1 for+-- purposes of stippling. Whether rectangle /s/ is rasterized or not depends on+-- the fragment rule described for aliased lines, counting rectangles rather+-- than groups of fragments.+--+-- The initial value of 'lineStipple' is 'Nothing', i.e. line stippling is+-- disabled.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if+-- 'lineStipple' is set during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.++lineStipple :: StateVar (Maybe (GLint, GLushort))+lineStipple =+   makeStateVarMaybe+      (return CapLineStipple)+      (liftM2 (,) (getInteger1 id GetLineStippleRepeat)+                  (getInteger1 fromIntegral GetLineStipplePattern))+      (uncurry glLineStipple)++--------------------------------------------------------------------------------++-- | Controls whether line antialiasing is enabled. The initial state is+-- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.++lineSmooth :: StateVar Capability+lineSmooth = makeCapability CapLineSmooth++--------------------------------------------------------------------------------++-- | The smallest and largest supported width of aliased lines.++aliasedLineWidthRange :: GettableStateVar (GLfloat, GLfloat)+aliasedLineWidthRange =+   makeGettableStateVar $ getFloat2 (,) GetAliasedLineWidthRange++-- | The smallest and largest supported width of antialiased lines.++smoothLineWidthRange :: GettableStateVar (GLfloat, GLfloat)+smoothLineWidthRange =+   makeGettableStateVar $ getFloat2 (,) GetSmoothLineWidthRange++-- | The antialiased line width granularity, i.e. the size difference between+-- supported widths.++smoothLineWidthGranularity :: GettableStateVar GLfloat+smoothLineWidthGranularity =+   makeGettableStateVar $ getFloat1 id GetSmoothLineWidthGranularity
Graphics/Rendering/OpenGL/GL/ObjectName.hs view
@@ -1,61 +1,61 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.ObjectName
--- Copyright   :  (c) Sven Panne 2013
--- License     :  BSD3
--- 
--- Maintainer  :  Sven Panne <svenpanne@gmail.com>
--- Stability   :  stable
--- Portability :  portable
---
--- This module corresponds to section 2.5 (Objects and the Object Model) of the
--- OpenGL 4.4 specs.
---
--- Object names are explicitly handled identifiers for API objects, e.g. a
--- texture object name in OpenGL or a buffer object name in OpenAL.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.ObjectName (
-   ObjectName(..), GeneratableObjectName(..)
-) where
-
-import Control.Monad
-
---------------------------------------------------------------------------------
-
--- | An 'ObjectName' is an explicitly handled identifier for API objects, e.g. a
--- texture object name in OpenGL or a buffer object name in OpenAL.
---
--- Minimal complete definition: 'isObjectName' plus one of 'deleteObjectName' or
--- 'deleteObjectNames'.
-
-class ObjectName a where
-   -- | Test if the given object name is currently in use, i.e. test if it has
-   -- been generated, but not been deleted so far.
-   isObjectName :: a -> IO Bool
-
-   -- | Make the given object name available again, declaring it as unused.
-   deleteObjectName:: a -> IO ()
-   deleteObjectName = deleteObjectNames . (:[])
-
-   -- | Bulk version of 'deleteObjectName'.
-   deleteObjectNames:: [a] -> IO ()
-   deleteObjectNames = mapM_ deleteObjectName
-
--- | A 'GeneratableObjectName' is an 'ObjectName' which can be generated without
--- creating an associated object at the same time, e.g. a buffer object name.
--- Note that e.g. program object names do not fall into this category, because
--- you can only create such a name together with a program object itself.
---
--- Minimal complete definition: One of 'genObjectName' or 'genObjectNames'.
-
-class ObjectName a => GeneratableObjectName  a where
-   -- | Generate a new unused object name. By generating the name, it becomes
-   -- used.
-   genObjectName :: IO a
-   genObjectName = fmap head $ genObjectNames 1
-
-   -- | Bulk version of 'genObjectName'.
-   genObjectNames :: Int -> IO [a]
-   genObjectNames = flip replicateM genObjectName
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ObjectName+-- Copyright   :  (c) Sven Panne 2013+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module corresponds to section 2.5 (Objects and the Object Model) of the+-- OpenGL 4.4 specs.+--+-- Object names are explicitly handled identifiers for API objects, e.g. a+-- texture object name in OpenGL or a buffer object name in OpenAL.+--+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.ObjectName (+   ObjectName(..), GeneratableObjectName(..)+) where++import Control.Monad++--------------------------------------------------------------------------------++-- | An 'ObjectName' is an explicitly handled identifier for API objects, e.g. a+-- texture object name in OpenGL or a buffer object name in OpenAL.+--+-- Minimal complete definition: 'isObjectName' plus one of 'deleteObjectName' or+-- 'deleteObjectNames'.++class ObjectName a where+   -- | Test if the given object name is currently in use, i.e. test if it has+   -- been generated, but not been deleted so far.+   isObjectName :: a -> IO Bool++   -- | Make the given object name available again, declaring it as unused.+   deleteObjectName:: a -> IO ()+   deleteObjectName = deleteObjectNames . (:[])++   -- | Bulk version of 'deleteObjectName'.+   deleteObjectNames:: [a] -> IO ()+   deleteObjectNames = mapM_ deleteObjectName++-- | A 'GeneratableObjectName' is an 'ObjectName' which can be generated without+-- creating an associated object at the same time, e.g. a buffer object name.+-- Note that e.g. program object names do not fall into this category, because+-- you can only create such a name together with a program object itself.+--+-- Minimal complete definition: One of 'genObjectName' or 'genObjectNames'.++class ObjectName a => GeneratableObjectName  a where+   -- | Generate a new unused object name. By generating the name, it becomes+   -- used.+   genObjectName :: IO a+   genObjectName = fmap head $ genObjectNames 1++   -- | Bulk version of 'genObjectName'.+   genObjectNames :: Int -> IO [a]+   genObjectNames = flip replicateM genObjectName
Graphics/Rendering/OpenGL/GL/PeekPoke.hs view
@@ -1,107 +1,107 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PeekPoke
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PeekPoke+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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
Graphics/Rendering/OpenGL/GL/PerFragment.hs view
@@ -1,375 +1,375 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PerFragment
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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 glDepthBounds)
-
---------------------------------------------------------------------------------
-
-alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))
-alphaFunc =
-   makeStateVarMaybe
-      (return CapAlphaTest)
-      (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc)
-                  (getClampf1 id GetAlphaTestRef))
-      (uncurry (glAlphaFunc . marshalComparisonFunction))
-
---------------------------------------------------------------------------------
-
-stencilTest :: StateVar Capability
-stencilTest = makeCapability CapStencilTest
-
---------------------------------------------------------------------------------
-
-stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint)
-stencilFunc =
-   makeStateVar
-      (liftM3 (,,) (getEnum1 unmarshalComparisonFunction GetStencilFunc)
-                   (getInteger1 id GetStencilRef)
-                   (getInteger1 fromIntegral GetStencilValueMask))
-      (\(func, ref, mask) ->
-         glStencilFunc (marshalComparisonFunction func) ref mask)
-
-stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint)
-stencilFuncSeparate face =
-   makeSettableStateVar $ \(func, ref, mask) ->
-      glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask
-
---------------------------------------------------------------------------------
-
-data StencilOp =
-     OpZero
-   | OpKeep
-   | OpReplace
-   | OpIncr
-   | OpIncrWrap
-   | OpDecr
-   | OpDecrWrap
-   | OpInvert
-   deriving ( Eq, Ord, Show )
-
-marshalStencilOp :: StencilOp -> GLenum
-marshalStencilOp x = case x of
-   OpZero -> gl_ZERO
-   OpKeep -> gl_KEEP
-   OpReplace -> gl_REPLACE
-   OpIncr -> gl_INCR
-   OpIncrWrap -> gl_INCR_WRAP
-   OpDecr -> gl_DECR
-   OpDecrWrap -> gl_DECR_WRAP
-   OpInvert -> gl_INVERT
-
-unmarshalStencilOp :: GLenum -> StencilOp
-unmarshalStencilOp x
-   | x == gl_ZERO = OpZero
-   | x == gl_KEEP = OpKeep
-   | x == gl_REPLACE = OpReplace
-   | x == gl_INCR = OpIncr
-   | x == gl_INCR_WRAP = OpIncrWrap
-   | x == gl_DECR = OpDecr
-   | x == gl_DECR_WRAP = OpDecrWrap
-   | x == gl_INVERT = OpInvert
-   | otherwise = error ("unmarshalStencilOp: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-stencilOp :: StateVar (StencilOp, StencilOp, StencilOp)
-stencilOp =
-   makeStateVar
-      (liftM3 (,,) (getEnum1 unmarshalStencilOp GetStencilFail)
-                   (getEnum1 unmarshalStencilOp GetStencilPassDepthFail)
-                   (getEnum1 unmarshalStencilOp GetStencilPassDepthPass))
-      (\(sf, spdf, spdp) -> glStencilOp (marshalStencilOp sf)
-                                        (marshalStencilOp spdf)
-                                        (marshalStencilOp spdp))
-
-stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp)
-stencilOpSeparate face =
-   makeSettableStateVar $ \(sf, spdf, spdp) ->
-      glStencilOpSeparate (marshalFace face)
-                          (marshalStencilOp sf)
-                          (marshalStencilOp spdf)
-                          (marshalStencilOp spdp)
-
---------------------------------------------------------------------------------
-
-activeStencilFace :: StateVar (Maybe Face)
-activeStencilFace =
-   makeStateVarMaybe
-      (return CapStencilTestTwoSide)
-      (getEnum1 unmarshalFace GetActiveStencilFace)
-      (glActiveStencilFace . marshalFace)
-
---------------------------------------------------------------------------------
-
-depthFunc :: StateVar (Maybe ComparisonFunction)
-depthFunc =
-   makeStateVarMaybe
-      (return CapDepthTest)
-      (getEnum1 unmarshalComparisonFunction GetDepthFunc)
-      (glDepthFunc . marshalComparisonFunction)
-
---------------------------------------------------------------------------------
-
-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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PerFragment+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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 glDepthBounds)++--------------------------------------------------------------------------------++alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))+alphaFunc =+   makeStateVarMaybe+      (return CapAlphaTest)+      (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc)+                  (getClampf1 id GetAlphaTestRef))+      (uncurry (glAlphaFunc . marshalComparisonFunction))++--------------------------------------------------------------------------------++stencilTest :: StateVar Capability+stencilTest = makeCapability CapStencilTest++--------------------------------------------------------------------------------++stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint)+stencilFunc =+   makeStateVar+      (liftM3 (,,) (getEnum1 unmarshalComparisonFunction GetStencilFunc)+                   (getInteger1 id GetStencilRef)+                   (getInteger1 fromIntegral GetStencilValueMask))+      (\(func, ref, mask) ->+         glStencilFunc (marshalComparisonFunction func) ref mask)++stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint)+stencilFuncSeparate face =+   makeSettableStateVar $ \(func, ref, mask) ->+      glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask++--------------------------------------------------------------------------------++data StencilOp =+     OpZero+   | OpKeep+   | OpReplace+   | OpIncr+   | OpIncrWrap+   | OpDecr+   | OpDecrWrap+   | OpInvert+   deriving ( Eq, Ord, Show )++marshalStencilOp :: StencilOp -> GLenum+marshalStencilOp x = case x of+   OpZero -> gl_ZERO+   OpKeep -> gl_KEEP+   OpReplace -> gl_REPLACE+   OpIncr -> gl_INCR+   OpIncrWrap -> gl_INCR_WRAP+   OpDecr -> gl_DECR+   OpDecrWrap -> gl_DECR_WRAP+   OpInvert -> gl_INVERT++unmarshalStencilOp :: GLenum -> StencilOp+unmarshalStencilOp x+   | x == gl_ZERO = OpZero+   | x == gl_KEEP = OpKeep+   | x == gl_REPLACE = OpReplace+   | x == gl_INCR = OpIncr+   | x == gl_INCR_WRAP = OpIncrWrap+   | x == gl_DECR = OpDecr+   | x == gl_DECR_WRAP = OpDecrWrap+   | x == gl_INVERT = OpInvert+   | otherwise = error ("unmarshalStencilOp: illegal value " ++ show x)++--------------------------------------------------------------------------------++stencilOp :: StateVar (StencilOp, StencilOp, StencilOp)+stencilOp =+   makeStateVar+      (liftM3 (,,) (getEnum1 unmarshalStencilOp GetStencilFail)+                   (getEnum1 unmarshalStencilOp GetStencilPassDepthFail)+                   (getEnum1 unmarshalStencilOp GetStencilPassDepthPass))+      (\(sf, spdf, spdp) -> glStencilOp (marshalStencilOp sf)+                                        (marshalStencilOp spdf)+                                        (marshalStencilOp spdp))++stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp)+stencilOpSeparate face =+   makeSettableStateVar $ \(sf, spdf, spdp) ->+      glStencilOpSeparate (marshalFace face)+                          (marshalStencilOp sf)+                          (marshalStencilOp spdf)+                          (marshalStencilOp spdp)++--------------------------------------------------------------------------------++activeStencilFace :: StateVar (Maybe Face)+activeStencilFace =+   makeStateVarMaybe+      (return CapStencilTestTwoSide)+      (getEnum1 unmarshalFace GetActiveStencilFace)+      (glActiveStencilFace . marshalFace)++--------------------------------------------------------------------------------++depthFunc :: StateVar (Maybe ComparisonFunction)+depthFunc =+   makeStateVarMaybe+      (return CapDepthTest)+      (getEnum1 unmarshalComparisonFunction GetDepthFunc)+      (glDepthFunc . marshalComparisonFunction)++--------------------------------------------------------------------------------++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)
Graphics/Rendering/OpenGL/GL/PixelData.hs view
@@ -1,32 +1,32 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelData
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelData+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data PixelData a = PixelData PixelFormat DataType (Ptr a)+   deriving ( Eq, Ord, Show )++withPixelData :: PixelData a -> (GLenum -> GLenum -> Ptr a -> b) -> b+withPixelData (PixelData pixelFormat dataType ptr) f =+   f (marshalPixelFormat pixelFormat) (marshalDataType dataType) ptr
Graphics/Rendering/OpenGL/GL/PixelFormat.hs view
@@ -1,130 +1,130 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelFormat
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
-   BGR -> gl_BGR
-   BGRA -> gl_BGRA
-   CMYK -> gl_CMYK
-   CMYKA -> gl_CMYKA
-   FourTwoTwo -> gl_422
-   FourTwoTwoRev -> gl_422_REV
-   FourTwoTwoAverage -> gl_422_AVERAGE
-   FourTwoTwoRevAverage -> gl_422_REV_AVERAGE
-   -- TODO: Use YCBCR_422_APPLE from APPLE_ycbcr_422 extension
-   YCBCR422 -> 0x85B9
-   DepthStencil -> gl_DEPTH_STENCIL
-
-unmarshalPixelFormat :: GLenum -> PixelFormat
-unmarshalPixelFormat x
-   | x == gl_COLOR_INDEX = ColorIndex
-   | x == gl_STENCIL_INDEX = StencilIndex
-   | x == gl_DEPTH_COMPONENT = DepthComponent
-   | x == gl_RED = Red
-   | x == gl_GREEN = Green
-   | x == gl_BLUE = Blue
-   | x == gl_ALPHA = Alpha
-   | x == gl_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 = ABGR
-   | x == gl_BGR = BGR
-   | x == gl_BGRA = BGRA
-   | x == gl_CMYK = CMYK
-   | x == gl_CMYKA = CMYKA
-   | x == gl_422 = FourTwoTwo
-   | x == gl_422_REV = FourTwoTwoRev
-   | x == gl_422_AVERAGE = FourTwoTwoAverage
-   | x == gl_422_REV_AVERAGE = FourTwoTwoRevAverage
-   -- TODO: Use YCBCR_422_APPLE from APPLE_ycbcr_422 extension
-   | x == 0x85B9 = YCBCR422
-   | x == gl_DEPTH_STENCIL = DepthStencil
-   | otherwise = error ("unmarshalPixelFormat: illegal value " ++ show x)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelFormat+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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+   BGR -> gl_BGR+   BGRA -> gl_BGRA+   CMYK -> gl_CMYK+   CMYKA -> gl_CMYKA+   FourTwoTwo -> gl_422+   FourTwoTwoRev -> gl_422_REV+   FourTwoTwoAverage -> gl_422_AVERAGE+   FourTwoTwoRevAverage -> gl_422_REV_AVERAGE+   -- TODO: Use YCBCR_422_APPLE from APPLE_ycbcr_422 extension+   YCBCR422 -> 0x85B9+   DepthStencil -> gl_DEPTH_STENCIL++unmarshalPixelFormat :: GLenum -> PixelFormat+unmarshalPixelFormat x+   | x == gl_COLOR_INDEX = ColorIndex+   | x == gl_STENCIL_INDEX = StencilIndex+   | x == gl_DEPTH_COMPONENT = DepthComponent+   | x == gl_RED = Red+   | x == gl_GREEN = Green+   | x == gl_BLUE = Blue+   | x == gl_ALPHA = Alpha+   | x == gl_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 = ABGR+   | x == gl_BGR = BGR+   | x == gl_BGRA = BGRA+   | x == gl_CMYK = CMYK+   | x == gl_CMYKA = CMYKA+   | x == gl_422 = FourTwoTwo+   | x == gl_422_REV = FourTwoTwoRev+   | x == gl_422_AVERAGE = FourTwoTwoAverage+   | x == gl_422_REV_AVERAGE = FourTwoTwoRevAverage+   -- TODO: Use YCBCR_422_APPLE from APPLE_ycbcr_422 extension+   | x == 0x85B9 = YCBCR422+   | x == gl_DEPTH_STENCIL = DepthStencil+   | otherwise = error ("unmarshalPixelFormat: illegal value " ++ show x)
Graphics/Rendering/OpenGL/GL/PixelRectangles.hs view
@@ -1,34 +1,34 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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
Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs view
@@ -1,249 +1,249 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data ColorTableStage =
-     ColorTableStage
-   | PostConvolutionColorTableStage
-   | PostColorMatrixColorTableStage
-   | TextureColorTableStage
-   deriving ( Eq, Ord, Show )
-
-colorTableStageToColorTable :: ColorTableStage -> ColorTable
-colorTableStageToColorTable x = case x of
-   ColorTableStage -> ColorTable
-   PostConvolutionColorTableStage -> PostConvolutionColorTable
-   PostColorMatrixColorTableStage -> PostColorMatrixColorTable
-   TextureColorTableStage -> TextureColorTable
-
-colorTableStageToEnableCap :: ColorTableStage -> EnableCap
-colorTableStageToEnableCap x = case x of
-   ColorTableStage -> CapColorTable
-   PostConvolutionColorTableStage -> CapPostConvolutionColorTable
-   PostColorMatrixColorTableStage -> CapPostColorMatrixColorTable
-   TextureColorTableStage -> CapTextureColorTable
-
---------------------------------------------------------------------------------
-
-colorTableStage :: ColorTableStage -> StateVar Capability
-colorTableStage = makeCapability . colorTableStageToEnableCap
-
---------------------------------------------------------------------------------
-
-data ColorTable =
-     ColorTable
-   | PostConvolutionColorTable
-   | PostColorMatrixColorTable
-   | Texture1DColorTable
-   | Texture2DColorTable
-   | Texture3DColorTable
-   | TextureCubeMapColorTable
-   | TextureColorTable
-   | SharedTexturePalette
-   deriving ( Eq, Ord, Show )
-
-marshalColorTable :: ColorTable -> GLenum
-marshalColorTable x = case x of
-   ColorTable -> gl_COLOR_TABLE
-   PostConvolutionColorTable -> gl_POST_CONVOLUTION_COLOR_TABLE
-   PostColorMatrixColorTable -> gl_POST_COLOR_MATRIX_COLOR_TABLE
-   Texture1DColorTable -> gl_TEXTURE_1D
-   Texture2DColorTable -> gl_TEXTURE_2D
-   Texture3DColorTable -> gl_TEXTURE_3D
-   TextureCubeMapColorTable -> gl_TEXTURE_CUBE_MAP
-   -- TODO: Use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension
-   TextureColorTable -> 0x80bc
-   SharedTexturePalette -> gl_SHARED_TEXTURE_PALETTE
-
---------------------------------------------------------------------------------
-
-data Proxy =
-     NoProxy
-   | Proxy
-   deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-marshalProxyColorTable :: Proxy -> ColorTable -> Maybe GLenum
-marshalProxyColorTable NoProxy x = Just (marshalColorTable x)
-marshalProxyColorTable Proxy   x = case x of
-   ColorTable -> Just gl_PROXY_COLOR_TABLE
-   PostConvolutionColorTable -> Just gl_PROXY_POST_CONVOLUTION_COLOR_TABLE
-   PostColorMatrixColorTable -> Just gl_PROXY_POST_COLOR_MATRIX_COLOR_TABLE
-   Texture1DColorTable -> Just gl_PROXY_TEXTURE_1D
-   Texture2DColorTable -> Just gl_PROXY_TEXTURE_2D
-   Texture3DColorTable -> Just gl_PROXY_TEXTURE_3D
-   TextureCubeMapColorTable -> Just gl_PROXY_TEXTURE_CUBE_MAP
-   -- TODO: Use PROXY_TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension
-   TextureColorTable -> Just 0x80bd
-   SharedTexturePalette -> Nothing
-
---------------------------------------------------------------------------------
-
-colorTable ::
-   Proxy -> ColorTable -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()
-colorTable proxy ct int w pd =
-   maybe recordInvalidEnum
-         (\target -> withPixelData pd $
-            glColorTable target (marshalPixelInternalFormat' int) w)
-         (marshalProxyColorTable proxy ct)
-
---------------------------------------------------------------------------------
-
-getColorTable :: ColorTable -> PixelData a -> IO ()
-getColorTable ct pd =
-   withPixelData pd $ glGetColorTable (marshalColorTable ct)
-
---------------------------------------------------------------------------------
-
-copyColorTable :: ColorTable -> PixelInternalFormat -> Position -> GLsizei -> IO ()
-copyColorTable ct int (Position x y) =
-   glCopyColorTable (marshalColorTable ct) (marshalPixelInternalFormat' int) x y
-
---------------------------------------------------------------------------------
-
-colorSubTable :: ColorTable -> GLsizei -> GLsizei -> PixelData a -> IO ()
-colorSubTable ct start count pd =
-   withPixelData pd $ glColorSubTable (marshalColorTable ct) start count
-
---------------------------------------------------------------------------------
-
-copyColorSubTable :: ColorTable -> GLsizei -> Position -> GLsizei -> IO ()
-copyColorSubTable ct start (Position x y) =
-   glCopyColorSubTable (marshalColorTable ct) start x y
-
---------------------------------------------------------------------------------
-
-data ColorTablePName =
-     ColorTableScale
-   | ColorTableBias
-   | ColorTableFormat
-   | ColorTableWidth
-   | ColorTableRedSize
-   | ColorTableGreenSize
-   | ColorTableBlueSize
-   | ColorTableAlphaSize
-   | ColorTableLuminanceSize
-   | ColorTableIntensitySize
-
-marshalColorTablePName :: ColorTablePName -> GLenum
-marshalColorTablePName x = case x of
-   ColorTableScale -> gl_COLOR_TABLE_SCALE
-   ColorTableBias -> gl_COLOR_TABLE_BIAS
-   ColorTableFormat -> gl_COLOR_TABLE_FORMAT
-   ColorTableWidth -> gl_COLOR_TABLE_WIDTH
-   ColorTableRedSize -> gl_COLOR_TABLE_RED_SIZE
-   ColorTableGreenSize -> gl_COLOR_TABLE_GREEN_SIZE
-   ColorTableBlueSize -> gl_COLOR_TABLE_BLUE_SIZE
-   ColorTableAlphaSize -> gl_COLOR_TABLE_ALPHA_SIZE
-   ColorTableLuminanceSize -> gl_COLOR_TABLE_LUMINANCE_SIZE
-   ColorTableIntensitySize -> gl_COLOR_TABLE_INTENSITY_SIZE
-
---------------------------------------------------------------------------------
-
-colorTableScale :: ColorTableStage -> StateVar (Color4 GLfloat)
-colorTableScale = colorTableScaleBias ColorTableScale
-
-colorTableBias :: ColorTableStage -> StateVar (Color4 GLfloat)
-colorTableBias = colorTableScaleBias ColorTableBias
-
-colorTableScaleBias ::
-   ColorTablePName -> ColorTableStage -> StateVar (Color4 GLfloat)
-colorTableScaleBias p s =
-   makeStateVar (getColorTableParameterC4f ct p) (colorTableParameterC4f ct p)
-   where ct = colorTableStageToColorTable s
-
-getColorTableParameterC4f ::
-   ColorTable -> ColorTablePName -> IO (Color4 GLfloat)
-getColorTableParameterC4f ct p =
-   alloca $ \buf -> do
-      glGetColorTableParameterfv
-         (marshalColorTable ct)
-         (marshalColorTablePName p)
-         (castPtr buf)
-      peek buf
-
-colorTableParameterC4f ::
-   ColorTable -> ColorTablePName -> Color4 GLfloat -> IO ()
-colorTableParameterC4f ct p c =
-   with c $ \ptr ->
-      glColorTableParameterfv (marshalColorTable ct) (marshalColorTablePName p) (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-colorTableFormat :: ColorTable -> GettableStateVar PixelInternalFormat
-colorTableFormat ct =
-   makeGettableStateVar $
-      getColorTableParameteri unmarshalPixelInternalFormat ct ColorTableFormat
-
-getColorTableParameteri :: (GLint -> a) -> ColorTable -> ColorTablePName -> IO a
-getColorTableParameteri f ct p =
-   alloca $ \buf -> do
-      glGetColorTableParameteriv
-         (marshalColorTable ct)
-         (marshalColorTablePName p)
-         buf
-      peek1 f buf
-
---------------------------------------------------------------------------------
-
-colorTableWidth :: ColorTable -> GettableStateVar GLsizei
-colorTableWidth ct =
-   makeGettableStateVar $
-      getColorTableParameteri fromIntegral ct ColorTableWidth
-
---------------------------------------------------------------------------------
-
-colorTableRGBASizes :: ColorTable -> GettableStateVar (Color4 GLsizei)
-colorTableRGBASizes ct =
-   makeGettableStateVar $ do
-      r <- getColorTableParameteri fromIntegral ct ColorTableRedSize
-      g <- getColorTableParameteri fromIntegral ct ColorTableGreenSize
-      b <- getColorTableParameteri fromIntegral ct ColorTableBlueSize
-      a <- getColorTableParameteri fromIntegral ct ColorTableAlphaSize
-      return $ Color4 r g b a
-
-colorTableLuminanceSize :: ColorTable -> GettableStateVar GLsizei
-colorTableLuminanceSize ct =
-   makeGettableStateVar $
-      getColorTableParameteri fromIntegral ct ColorTableLuminanceSize
-
-colorTableIntesitySize :: ColorTable -> GettableStateVar GLsizei
-colorTableIntesitySize ct =
-   makeGettableStateVar $
-      getColorTableParameteri fromIntegral ct ColorTableIntensitySize
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data ColorTableStage =+     ColorTableStage+   | PostConvolutionColorTableStage+   | PostColorMatrixColorTableStage+   | TextureColorTableStage+   deriving ( Eq, Ord, Show )++colorTableStageToColorTable :: ColorTableStage -> ColorTable+colorTableStageToColorTable x = case x of+   ColorTableStage -> ColorTable+   PostConvolutionColorTableStage -> PostConvolutionColorTable+   PostColorMatrixColorTableStage -> PostColorMatrixColorTable+   TextureColorTableStage -> TextureColorTable++colorTableStageToEnableCap :: ColorTableStage -> EnableCap+colorTableStageToEnableCap x = case x of+   ColorTableStage -> CapColorTable+   PostConvolutionColorTableStage -> CapPostConvolutionColorTable+   PostColorMatrixColorTableStage -> CapPostColorMatrixColorTable+   TextureColorTableStage -> CapTextureColorTable++--------------------------------------------------------------------------------++colorTableStage :: ColorTableStage -> StateVar Capability+colorTableStage = makeCapability . colorTableStageToEnableCap++--------------------------------------------------------------------------------++data ColorTable =+     ColorTable+   | PostConvolutionColorTable+   | PostColorMatrixColorTable+   | Texture1DColorTable+   | Texture2DColorTable+   | Texture3DColorTable+   | TextureCubeMapColorTable+   | TextureColorTable+   | SharedTexturePalette+   deriving ( Eq, Ord, Show )++marshalColorTable :: ColorTable -> GLenum+marshalColorTable x = case x of+   ColorTable -> gl_COLOR_TABLE+   PostConvolutionColorTable -> gl_POST_CONVOLUTION_COLOR_TABLE+   PostColorMatrixColorTable -> gl_POST_COLOR_MATRIX_COLOR_TABLE+   Texture1DColorTable -> gl_TEXTURE_1D+   Texture2DColorTable -> gl_TEXTURE_2D+   Texture3DColorTable -> gl_TEXTURE_3D+   TextureCubeMapColorTable -> gl_TEXTURE_CUBE_MAP+   -- TODO: Use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension+   TextureColorTable -> 0x80bc+   SharedTexturePalette -> gl_SHARED_TEXTURE_PALETTE++--------------------------------------------------------------------------------++data Proxy =+     NoProxy+   | Proxy+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++marshalProxyColorTable :: Proxy -> ColorTable -> Maybe GLenum+marshalProxyColorTable NoProxy x = Just (marshalColorTable x)+marshalProxyColorTable Proxy   x = case x of+   ColorTable -> Just gl_PROXY_COLOR_TABLE+   PostConvolutionColorTable -> Just gl_PROXY_POST_CONVOLUTION_COLOR_TABLE+   PostColorMatrixColorTable -> Just gl_PROXY_POST_COLOR_MATRIX_COLOR_TABLE+   Texture1DColorTable -> Just gl_PROXY_TEXTURE_1D+   Texture2DColorTable -> Just gl_PROXY_TEXTURE_2D+   Texture3DColorTable -> Just gl_PROXY_TEXTURE_3D+   TextureCubeMapColorTable -> Just gl_PROXY_TEXTURE_CUBE_MAP+   -- TODO: Use PROXY_TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension+   TextureColorTable -> Just 0x80bd+   SharedTexturePalette -> Nothing++--------------------------------------------------------------------------------++colorTable ::+   Proxy -> ColorTable -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()+colorTable proxy ct int w pd =+   maybe recordInvalidEnum+         (\target -> withPixelData pd $+            glColorTable target (marshalPixelInternalFormat' int) w)+         (marshalProxyColorTable proxy ct)++--------------------------------------------------------------------------------++getColorTable :: ColorTable -> PixelData a -> IO ()+getColorTable ct pd =+   withPixelData pd $ glGetColorTable (marshalColorTable ct)++--------------------------------------------------------------------------------++copyColorTable :: ColorTable -> PixelInternalFormat -> Position -> GLsizei -> IO ()+copyColorTable ct int (Position x y) =+   glCopyColorTable (marshalColorTable ct) (marshalPixelInternalFormat' int) x y++--------------------------------------------------------------------------------++colorSubTable :: ColorTable -> GLsizei -> GLsizei -> PixelData a -> IO ()+colorSubTable ct start count pd =+   withPixelData pd $ glColorSubTable (marshalColorTable ct) start count++--------------------------------------------------------------------------------++copyColorSubTable :: ColorTable -> GLsizei -> Position -> GLsizei -> IO ()+copyColorSubTable ct start (Position x y) =+   glCopyColorSubTable (marshalColorTable ct) start x y++--------------------------------------------------------------------------------++data ColorTablePName =+     ColorTableScale+   | ColorTableBias+   | ColorTableFormat+   | ColorTableWidth+   | ColorTableRedSize+   | ColorTableGreenSize+   | ColorTableBlueSize+   | ColorTableAlphaSize+   | ColorTableLuminanceSize+   | ColorTableIntensitySize++marshalColorTablePName :: ColorTablePName -> GLenum+marshalColorTablePName x = case x of+   ColorTableScale -> gl_COLOR_TABLE_SCALE+   ColorTableBias -> gl_COLOR_TABLE_BIAS+   ColorTableFormat -> gl_COLOR_TABLE_FORMAT+   ColorTableWidth -> gl_COLOR_TABLE_WIDTH+   ColorTableRedSize -> gl_COLOR_TABLE_RED_SIZE+   ColorTableGreenSize -> gl_COLOR_TABLE_GREEN_SIZE+   ColorTableBlueSize -> gl_COLOR_TABLE_BLUE_SIZE+   ColorTableAlphaSize -> gl_COLOR_TABLE_ALPHA_SIZE+   ColorTableLuminanceSize -> gl_COLOR_TABLE_LUMINANCE_SIZE+   ColorTableIntensitySize -> gl_COLOR_TABLE_INTENSITY_SIZE++--------------------------------------------------------------------------------++colorTableScale :: ColorTableStage -> StateVar (Color4 GLfloat)+colorTableScale = colorTableScaleBias ColorTableScale++colorTableBias :: ColorTableStage -> StateVar (Color4 GLfloat)+colorTableBias = colorTableScaleBias ColorTableBias++colorTableScaleBias ::+   ColorTablePName -> ColorTableStage -> StateVar (Color4 GLfloat)+colorTableScaleBias p s =+   makeStateVar (getColorTableParameterC4f ct p) (colorTableParameterC4f ct p)+   where ct = colorTableStageToColorTable s++getColorTableParameterC4f ::+   ColorTable -> ColorTablePName -> IO (Color4 GLfloat)+getColorTableParameterC4f ct p =+   alloca $ \buf -> do+      glGetColorTableParameterfv+         (marshalColorTable ct)+         (marshalColorTablePName p)+         (castPtr buf)+      peek buf++colorTableParameterC4f ::+   ColorTable -> ColorTablePName -> Color4 GLfloat -> IO ()+colorTableParameterC4f ct p c =+   with c $ \ptr ->+      glColorTableParameterfv (marshalColorTable ct) (marshalColorTablePName p) (castPtr ptr)++--------------------------------------------------------------------------------++colorTableFormat :: ColorTable -> GettableStateVar PixelInternalFormat+colorTableFormat ct =+   makeGettableStateVar $+      getColorTableParameteri unmarshalPixelInternalFormat ct ColorTableFormat++getColorTableParameteri :: (GLint -> a) -> ColorTable -> ColorTablePName -> IO a+getColorTableParameteri f ct p =+   alloca $ \buf -> do+      glGetColorTableParameteriv+         (marshalColorTable ct)+         (marshalColorTablePName p)+         buf+      peek1 f buf++--------------------------------------------------------------------------------++colorTableWidth :: ColorTable -> GettableStateVar GLsizei+colorTableWidth ct =+   makeGettableStateVar $+      getColorTableParameteri fromIntegral ct ColorTableWidth++--------------------------------------------------------------------------------++colorTableRGBASizes :: ColorTable -> GettableStateVar (Color4 GLsizei)+colorTableRGBASizes ct =+   makeGettableStateVar $ do+      r <- getColorTableParameteri fromIntegral ct ColorTableRedSize+      g <- getColorTableParameteri fromIntegral ct ColorTableGreenSize+      b <- getColorTableParameteri fromIntegral ct ColorTableBlueSize+      a <- getColorTableParameteri fromIntegral ct ColorTableAlphaSize+      return $ Color4 r g b a++colorTableLuminanceSize :: ColorTable -> GettableStateVar GLsizei+colorTableLuminanceSize ct =+   makeGettableStateVar $+      getColorTableParameteri fromIntegral ct ColorTableLuminanceSize++colorTableIntesitySize :: ColorTable -> GettableStateVar GLsizei+colorTableIntesitySize ct =+   makeGettableStateVar $+      getColorTableParameteri fromIntegral ct ColorTableIntensitySize
Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs view
@@ -1,281 +1,281 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data ConvolutionTarget =
-     Convolution1D
-   | Convolution2D
-   | Separable2D
-   deriving ( Eq, Ord, Show )
-
-marshalConvolutionTarget :: ConvolutionTarget -> GLenum
-marshalConvolutionTarget x = case x of
-   Convolution1D -> gl_CONVOLUTION_1D
-   Convolution2D -> gl_CONVOLUTION_2D
-   Separable2D -> gl_SEPARABLE_2D
-
-convolutionTargetToEnableCap :: ConvolutionTarget -> EnableCap
-convolutionTargetToEnableCap x = case x of
-   Convolution1D -> CapConvolution1D
-   Convolution2D -> CapConvolution2D
-   Separable2D -> CapSeparable2D
-
---------------------------------------------------------------------------------
-
-convolution :: ConvolutionTarget -> StateVar Capability
-convolution = makeCapability . convolutionTargetToEnableCap
-
---------------------------------------------------------------------------------
-
-convolutionFilter1D :: PixelInternalFormat -> GLsizei -> PixelData a -> IO ()
-convolutionFilter1D int w pd =
-   withPixelData pd $
-      glConvolutionFilter1D
-         (marshalConvolutionTarget Convolution1D)
-         (marshalPixelInternalFormat' int) w
-
---------------------------------------------------------------------------------
-
-getConvolutionFilter1D :: PixelData a -> IO ()
-getConvolutionFilter1D = getConvolutionFilter Convolution1D
-
-getConvolutionFilter :: ConvolutionTarget -> PixelData a -> IO ()
-getConvolutionFilter t pd =
-   withPixelData pd $ glGetConvolutionFilter (marshalConvolutionTarget t)
-
---------------------------------------------------------------------------------
-
-convolutionFilter2D :: PixelInternalFormat -> Size -> PixelData a -> IO ()
-convolutionFilter2D int (Size w h) pd =
-   withPixelData pd $
-      glConvolutionFilter2D
-         (marshalConvolutionTarget Convolution2D)
-         (marshalPixelInternalFormat' int) w h
-
---------------------------------------------------------------------------------
-
-getConvolutionFilter2D :: PixelData a -> IO ()
-getConvolutionFilter2D = getConvolutionFilter Convolution2D
-
---------------------------------------------------------------------------------
-
-separableFilter2D ::
-   PixelInternalFormat -> Size -> PixelData a -> PixelData a -> IO ()
-separableFilter2D int (Size w h) pdRow pdCol =
-   withPixelData pdRow $ \f1 d1 p1 ->
-      withPixelData pdCol $ \f2 d2 p2 ->
-         if f1 == f2 && d1 == d2
-            then glSeparableFilter2D
-                    (marshalConvolutionTarget Separable2D)
-                    (marshalPixelInternalFormat' int) w h f1 d1 p1 p2
-            else recordInvalidValue
-
---------------------------------------------------------------------------------
-
-getSeparableFilter2D :: PixelData a -> PixelData a -> IO ()
-getSeparableFilter2D pdRow pdCol =
-   withPixelData pdRow $ \f1 d1 p1 ->
-      withPixelData pdCol $ \f2 d2 p2 ->
-         if f1 == f2 && d1 == d2
-            then glGetSeparableFilter
-                    (marshalConvolutionTarget Separable2D) f1 d1 p1 p2 nullPtr
-            else recordInvalidValue
-
---------------------------------------------------------------------------------
-
-copyConvolutionFilter1D :: PixelInternalFormat -> Position -> GLsizei -> IO ()
-copyConvolutionFilter1D int (Position x y) =
-   glCopyConvolutionFilter1D
-      (marshalConvolutionTarget Convolution1D) (marshalPixelInternalFormat' int)
-      x y
-
---------------------------------------------------------------------------------
-
-copyConvolutionFilter2D :: PixelInternalFormat -> Position -> Size -> IO ()
-copyConvolutionFilter2D int (Position x y) (Size w h) =
-   glCopyConvolutionFilter2D
-      (marshalConvolutionTarget Convolution2D) (marshalPixelInternalFormat' int)
-      x y w h
-
---------------------------------------------------------------------------------
-
-data ConvolutionParameter =
-     ConvolutionBorderColor
-   | ConvolutionBorderMode
-   | ConvolutionFilterScale
-   | ConvolutionFilterBias
-   | ConvolutionFormat
-   | ConvolutionWidth
-   | ConvolutionHeight
-   | MaxConvolutionWidth
-   | MaxConvolutionHeight
-   deriving ( Eq, Ord, Show )
-
-marshalConvolutionParameter :: ConvolutionParameter -> GLenum
-marshalConvolutionParameter x = case x of
-   ConvolutionBorderColor -> gl_CONVOLUTION_BORDER_COLOR
-   ConvolutionBorderMode -> gl_CONVOLUTION_BORDER_MODE
-   ConvolutionFilterScale -> gl_CONVOLUTION_FILTER_SCALE
-   ConvolutionFilterBias -> gl_CONVOLUTION_FILTER_BIAS
-   ConvolutionFormat -> gl_CONVOLUTION_FORMAT
-   ConvolutionWidth -> gl_CONVOLUTION_WIDTH
-   ConvolutionHeight -> gl_CONVOLUTION_HEIGHT
-   MaxConvolutionWidth -> gl_MAX_CONVOLUTION_WIDTH
-   MaxConvolutionHeight -> gl_MAX_CONVOLUTION_HEIGHT
-
---------------------------------------------------------------------------------
-
-convolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei
-convolutionWidth t = convolutionParameteri t ConvolutionWidth
-
-convolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei
-convolutionHeight t = convolutionParameteri t ConvolutionHeight
-
-maxConvolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei
-maxConvolutionWidth t = convolutionParameteri t MaxConvolutionWidth
-
-maxConvolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei
-maxConvolutionHeight t = convolutionParameteri t MaxConvolutionHeight
-
-convolutionParameteri ::
-   ConvolutionTarget -> ConvolutionParameter -> GettableStateVar GLsizei
-convolutionParameteri t p =
-   makeGettableStateVar (getConvolutionParameteri fromIntegral t p)
-
-getConvolutionParameteri ::
-   (GLint -> a) -> ConvolutionTarget -> ConvolutionParameter -> IO a
-getConvolutionParameteri f t p =
-   alloca $ \buf -> do
-      glGetConvolutionParameteriv
-         (marshalConvolutionTarget t) (marshalConvolutionParameter p) buf
-      peek1 f buf
-
---------------------------------------------------------------------------------
-
-data ConvolutionBorderMode' =
-     Reduce'
-   | ConstantBorder'
-   | ReplicateBorder'
-
-marshalConvolutionBorderMode' :: ConvolutionBorderMode' -> GLint
-marshalConvolutionBorderMode' x = fromIntegral $ case x of
-   Reduce' -> gl_REDUCE
-   ConstantBorder' -> gl_CONSTANT_BORDER
-   ReplicateBorder' -> gl_REPLICATE_BORDER
-
-unmarshalConvolutionBorderMode' :: GLint -> ConvolutionBorderMode'
-unmarshalConvolutionBorderMode' x
-   | y == gl_REDUCE = Reduce'
-   | y == gl_CONSTANT_BORDER = ConstantBorder'
-   | y == gl_REPLICATE_BORDER = ReplicateBorder'
-   | otherwise = error ("unmarshalConvolutionBorderMode': illegal value " ++ show x)
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-data ConvolutionBorderMode =
-     Reduce
-   | ConstantBorder (Color4 GLfloat)
-   | ReplicateBorder
-   deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-convolutionBorderMode :: ConvolutionTarget -> StateVar ConvolutionBorderMode
-convolutionBorderMode t =
-   makeStateVar (getConvolutionBorderMode t) (setConvolutionBorderMode t)
-
-getConvolutionBorderMode :: ConvolutionTarget -> IO ConvolutionBorderMode
-getConvolutionBorderMode t = do
-   mode <- getConvolutionParameteri
-              unmarshalConvolutionBorderMode' t ConvolutionBorderMode
-   case mode of
-      Reduce' -> return Reduce
-      ConstantBorder' -> do
-         c <- getConvolutionParameterC4f t ConvolutionBorderColor
-         return $ ConstantBorder c
-      ReplicateBorder' -> return ReplicateBorder
-
-setConvolutionBorderMode :: ConvolutionTarget -> ConvolutionBorderMode -> IO ()
-setConvolutionBorderMode t mode = do
-   let setBM = setConvolutionParameteri
-                  marshalConvolutionBorderMode' t ConvolutionBorderMode
-   case mode of
-      Reduce -> setBM Reduce'
-      ConstantBorder c -> do
-         setBM ConstantBorder'
-         convolutionParameterC4f t ConvolutionBorderColor c
-      ReplicateBorder -> setBM ReplicateBorder'
-
-setConvolutionParameteri ::
-   (a -> GLint) -> ConvolutionTarget -> ConvolutionParameter -> a -> IO ()
-setConvolutionParameteri f t p x =
-   glConvolutionParameteri
-      (marshalConvolutionTarget t) (marshalConvolutionParameter p) (f x)
-
---------------------------------------------------------------------------------
-
-convolutionFilterScale :: ConvolutionTarget -> StateVar (Color4 GLfloat)
-convolutionFilterScale = convolutionC4f ConvolutionFilterScale
-
-convolutionFilterBias :: ConvolutionTarget -> StateVar (Color4 GLfloat)
-convolutionFilterBias = convolutionC4f ConvolutionFilterBias
-
-convolutionC4f ::
-   ConvolutionParameter -> ConvolutionTarget -> StateVar (Color4 GLfloat)
-convolutionC4f p t =
-   makeStateVar (getConvolutionParameterC4f t p) (convolutionParameterC4f t p)
-
-getConvolutionParameterC4f ::
-   ConvolutionTarget -> ConvolutionParameter -> IO (Color4 GLfloat)
-getConvolutionParameterC4f t p =
-   alloca $ \buf -> do
-      glGetConvolutionParameterfv
-         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr buf)
-      peek buf
-
-convolutionParameterC4f ::
-   ConvolutionTarget -> ConvolutionParameter -> Color4 GLfloat -> IO ()
-convolutionParameterC4f t p c =
-   with c $ \ptr ->
-      glConvolutionParameterfv
-         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr ptr)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data ConvolutionTarget =+     Convolution1D+   | Convolution2D+   | Separable2D+   deriving ( Eq, Ord, Show )++marshalConvolutionTarget :: ConvolutionTarget -> GLenum+marshalConvolutionTarget x = case x of+   Convolution1D -> gl_CONVOLUTION_1D+   Convolution2D -> gl_CONVOLUTION_2D+   Separable2D -> gl_SEPARABLE_2D++convolutionTargetToEnableCap :: ConvolutionTarget -> EnableCap+convolutionTargetToEnableCap x = case x of+   Convolution1D -> CapConvolution1D+   Convolution2D -> CapConvolution2D+   Separable2D -> CapSeparable2D++--------------------------------------------------------------------------------++convolution :: ConvolutionTarget -> StateVar Capability+convolution = makeCapability . convolutionTargetToEnableCap++--------------------------------------------------------------------------------++convolutionFilter1D :: PixelInternalFormat -> GLsizei -> PixelData a -> IO ()+convolutionFilter1D int w pd =+   withPixelData pd $+      glConvolutionFilter1D+         (marshalConvolutionTarget Convolution1D)+         (marshalPixelInternalFormat' int) w++--------------------------------------------------------------------------------++getConvolutionFilter1D :: PixelData a -> IO ()+getConvolutionFilter1D = getConvolutionFilter Convolution1D++getConvolutionFilter :: ConvolutionTarget -> PixelData a -> IO ()+getConvolutionFilter t pd =+   withPixelData pd $ glGetConvolutionFilter (marshalConvolutionTarget t)++--------------------------------------------------------------------------------++convolutionFilter2D :: PixelInternalFormat -> Size -> PixelData a -> IO ()+convolutionFilter2D int (Size w h) pd =+   withPixelData pd $+      glConvolutionFilter2D+         (marshalConvolutionTarget Convolution2D)+         (marshalPixelInternalFormat' int) w h++--------------------------------------------------------------------------------++getConvolutionFilter2D :: PixelData a -> IO ()+getConvolutionFilter2D = getConvolutionFilter Convolution2D++--------------------------------------------------------------------------------++separableFilter2D ::+   PixelInternalFormat -> Size -> PixelData a -> PixelData a -> IO ()+separableFilter2D int (Size w h) pdRow pdCol =+   withPixelData pdRow $ \f1 d1 p1 ->+      withPixelData pdCol $ \f2 d2 p2 ->+         if f1 == f2 && d1 == d2+            then glSeparableFilter2D+                    (marshalConvolutionTarget Separable2D)+                    (marshalPixelInternalFormat' int) w h f1 d1 p1 p2+            else recordInvalidValue++--------------------------------------------------------------------------------++getSeparableFilter2D :: PixelData a -> PixelData a -> IO ()+getSeparableFilter2D pdRow pdCol =+   withPixelData pdRow $ \f1 d1 p1 ->+      withPixelData pdCol $ \f2 d2 p2 ->+         if f1 == f2 && d1 == d2+            then glGetSeparableFilter+                    (marshalConvolutionTarget Separable2D) f1 d1 p1 p2 nullPtr+            else recordInvalidValue++--------------------------------------------------------------------------------++copyConvolutionFilter1D :: PixelInternalFormat -> Position -> GLsizei -> IO ()+copyConvolutionFilter1D int (Position x y) =+   glCopyConvolutionFilter1D+      (marshalConvolutionTarget Convolution1D) (marshalPixelInternalFormat' int)+      x y++--------------------------------------------------------------------------------++copyConvolutionFilter2D :: PixelInternalFormat -> Position -> Size -> IO ()+copyConvolutionFilter2D int (Position x y) (Size w h) =+   glCopyConvolutionFilter2D+      (marshalConvolutionTarget Convolution2D) (marshalPixelInternalFormat' int)+      x y w h++--------------------------------------------------------------------------------++data ConvolutionParameter =+     ConvolutionBorderColor+   | ConvolutionBorderMode+   | ConvolutionFilterScale+   | ConvolutionFilterBias+   | ConvolutionFormat+   | ConvolutionWidth+   | ConvolutionHeight+   | MaxConvolutionWidth+   | MaxConvolutionHeight+   deriving ( Eq, Ord, Show )++marshalConvolutionParameter :: ConvolutionParameter -> GLenum+marshalConvolutionParameter x = case x of+   ConvolutionBorderColor -> gl_CONVOLUTION_BORDER_COLOR+   ConvolutionBorderMode -> gl_CONVOLUTION_BORDER_MODE+   ConvolutionFilterScale -> gl_CONVOLUTION_FILTER_SCALE+   ConvolutionFilterBias -> gl_CONVOLUTION_FILTER_BIAS+   ConvolutionFormat -> gl_CONVOLUTION_FORMAT+   ConvolutionWidth -> gl_CONVOLUTION_WIDTH+   ConvolutionHeight -> gl_CONVOLUTION_HEIGHT+   MaxConvolutionWidth -> gl_MAX_CONVOLUTION_WIDTH+   MaxConvolutionHeight -> gl_MAX_CONVOLUTION_HEIGHT++--------------------------------------------------------------------------------++convolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei+convolutionWidth t = convolutionParameteri t ConvolutionWidth++convolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei+convolutionHeight t = convolutionParameteri t ConvolutionHeight++maxConvolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei+maxConvolutionWidth t = convolutionParameteri t MaxConvolutionWidth++maxConvolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei+maxConvolutionHeight t = convolutionParameteri t MaxConvolutionHeight++convolutionParameteri ::+   ConvolutionTarget -> ConvolutionParameter -> GettableStateVar GLsizei+convolutionParameteri t p =+   makeGettableStateVar (getConvolutionParameteri fromIntegral t p)++getConvolutionParameteri ::+   (GLint -> a) -> ConvolutionTarget -> ConvolutionParameter -> IO a+getConvolutionParameteri f t p =+   alloca $ \buf -> do+      glGetConvolutionParameteriv+         (marshalConvolutionTarget t) (marshalConvolutionParameter p) buf+      peek1 f buf++--------------------------------------------------------------------------------++data ConvolutionBorderMode' =+     Reduce'+   | ConstantBorder'+   | ReplicateBorder'++marshalConvolutionBorderMode' :: ConvolutionBorderMode' -> GLint+marshalConvolutionBorderMode' x = fromIntegral $ case x of+   Reduce' -> gl_REDUCE+   ConstantBorder' -> gl_CONSTANT_BORDER+   ReplicateBorder' -> gl_REPLICATE_BORDER++unmarshalConvolutionBorderMode' :: GLint -> ConvolutionBorderMode'+unmarshalConvolutionBorderMode' x+   | y == gl_REDUCE = Reduce'+   | y == gl_CONSTANT_BORDER = ConstantBorder'+   | y == gl_REPLICATE_BORDER = ReplicateBorder'+   | otherwise = error ("unmarshalConvolutionBorderMode': illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++data ConvolutionBorderMode =+     Reduce+   | ConstantBorder (Color4 GLfloat)+   | ReplicateBorder+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++convolutionBorderMode :: ConvolutionTarget -> StateVar ConvolutionBorderMode+convolutionBorderMode t =+   makeStateVar (getConvolutionBorderMode t) (setConvolutionBorderMode t)++getConvolutionBorderMode :: ConvolutionTarget -> IO ConvolutionBorderMode+getConvolutionBorderMode t = do+   mode <- getConvolutionParameteri+              unmarshalConvolutionBorderMode' t ConvolutionBorderMode+   case mode of+      Reduce' -> return Reduce+      ConstantBorder' -> do+         c <- getConvolutionParameterC4f t ConvolutionBorderColor+         return $ ConstantBorder c+      ReplicateBorder' -> return ReplicateBorder++setConvolutionBorderMode :: ConvolutionTarget -> ConvolutionBorderMode -> IO ()+setConvolutionBorderMode t mode = do+   let setBM = setConvolutionParameteri+                  marshalConvolutionBorderMode' t ConvolutionBorderMode+   case mode of+      Reduce -> setBM Reduce'+      ConstantBorder c -> do+         setBM ConstantBorder'+         convolutionParameterC4f t ConvolutionBorderColor c+      ReplicateBorder -> setBM ReplicateBorder'++setConvolutionParameteri ::+   (a -> GLint) -> ConvolutionTarget -> ConvolutionParameter -> a -> IO ()+setConvolutionParameteri f t p x =+   glConvolutionParameteri+      (marshalConvolutionTarget t) (marshalConvolutionParameter p) (f x)++--------------------------------------------------------------------------------++convolutionFilterScale :: ConvolutionTarget -> StateVar (Color4 GLfloat)+convolutionFilterScale = convolutionC4f ConvolutionFilterScale++convolutionFilterBias :: ConvolutionTarget -> StateVar (Color4 GLfloat)+convolutionFilterBias = convolutionC4f ConvolutionFilterBias++convolutionC4f ::+   ConvolutionParameter -> ConvolutionTarget -> StateVar (Color4 GLfloat)+convolutionC4f p t =+   makeStateVar (getConvolutionParameterC4f t p) (convolutionParameterC4f t p)++getConvolutionParameterC4f ::+   ConvolutionTarget -> ConvolutionParameter -> IO (Color4 GLfloat)+getConvolutionParameterC4f t p =+   alloca $ \buf -> do+      glGetConvolutionParameterfv+         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr buf)+      peek buf++convolutionParameterC4f ::+   ConvolutionTarget -> ConvolutionParameter -> Color4 GLfloat -> IO ()+convolutionParameterC4f t p c =+   with c $ \ptr ->+      glConvolutionParameterfv+         (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr ptr)
Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs view
@@ -1,132 +1,132 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Alloc
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data HistogramTarget =
-     Histogram
-   | ProxyHistogram
-
-marshalHistogramTarget :: HistogramTarget -> GLenum
-marshalHistogramTarget x = case x of
-   Histogram -> gl_HISTOGRAM
-   ProxyHistogram -> gl_PROXY_HISTOGRAM
-
-proxyToHistogramTarget :: Proxy -> HistogramTarget
-proxyToHistogramTarget x = case x of
-   NoProxy -> Histogram
-   Proxy -> ProxyHistogram
-
---------------------------------------------------------------------------------
-
-histogram :: Proxy -> StateVar (Maybe (GLsizei, PixelInternalFormat, Sink))
-histogram proxy =
-   makeStateVarMaybe
-      (return CapHistogram) (getHistogram' proxy) (setHistogram proxy)
-
-getHistogram' :: Proxy -> IO (GLsizei, PixelInternalFormat, Sink)
-getHistogram' proxy = do
-   w <- getHistogramParameteri fromIntegral proxy HistogramWidth
-   f <- getHistogramParameteri unmarshalPixelInternalFormat proxy HistogramFormat
-   s <- getHistogramParameteri unmarshalSink proxy HistogramSink
-   return (w, f, s)
-
-getHistogramParameteri ::
-   (GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
-getHistogramParameteri f proxy p =
-   alloca $ \buf -> do
-      glGetHistogramParameteriv
-         (marshalHistogramTarget (proxyToHistogramTarget proxy))
-         (marshalGetHistogramParameterPName p)
-         buf
-      peek1 f buf
-
-setHistogram :: Proxy -> (GLsizei, PixelInternalFormat, Sink) -> IO ()
-setHistogram proxy (w, int, sink) =
-   glHistogram
-      (marshalHistogramTarget (proxyToHistogramTarget proxy))
-      w
-      (marshalPixelInternalFormat' int)
-      (marshalSink sink)
-
---------------------------------------------------------------------------------
-
-getHistogram :: Reset -> PixelData a -> IO ()
-getHistogram reset pd =
-   withPixelData pd $
-      glGetHistogram
-         (marshalHistogramTarget Histogram)
-         (marshalReset reset)
-
---------------------------------------------------------------------------------
-
-resetHistogram :: IO ()
-resetHistogram = glResetHistogram (marshalHistogramTarget Histogram)
-
---------------------------------------------------------------------------------
-
-data GetHistogramParameterPName =
-     HistogramWidth
-   | HistogramFormat
-   | HistogramRedSize
-   | HistogramGreenSize
-   | HistogramBlueSize
-   | HistogramAlphaSize
-   | HistogramLuminanceSize
-   | HistogramSink
-
-marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum
-marshalGetHistogramParameterPName x = case x of
-   HistogramWidth -> gl_HISTOGRAM_WIDTH
-   HistogramFormat -> gl_HISTOGRAM_FORMAT
-   HistogramRedSize -> gl_HISTOGRAM_RED_SIZE
-   HistogramGreenSize -> gl_HISTOGRAM_GREEN_SIZE
-   HistogramBlueSize -> gl_HISTOGRAM_BLUE_SIZE
-   HistogramAlphaSize -> gl_HISTOGRAM_ALPHA_SIZE
-   HistogramLuminanceSize -> gl_HISTOGRAM_LUMINANCE_SIZE
-   HistogramSink -> gl_HISTOGRAM_SINK
-
---------------------------------------------------------------------------------
-
-histogramRGBASizes :: Proxy -> GettableStateVar (Color4 GLsizei)
-histogramRGBASizes proxy =
-   makeGettableStateVar $ do
-      r <- getHistogramParameteri fromIntegral proxy HistogramRedSize
-      g <- getHistogramParameteri fromIntegral proxy HistogramGreenSize
-      b <- getHistogramParameteri fromIntegral proxy HistogramBlueSize
-      a <- getHistogramParameteri fromIntegral proxy HistogramAlphaSize
-      return $ Color4 r g b a
-
-histogramLuminanceSize :: Proxy -> GettableStateVar GLsizei
-histogramLuminanceSize proxy =
-   makeGettableStateVar $
-      getHistogramParameteri fromIntegral proxy HistogramLuminanceSize
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Alloc+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data HistogramTarget =+     Histogram+   | ProxyHistogram++marshalHistogramTarget :: HistogramTarget -> GLenum+marshalHistogramTarget x = case x of+   Histogram -> gl_HISTOGRAM+   ProxyHistogram -> gl_PROXY_HISTOGRAM++proxyToHistogramTarget :: Proxy -> HistogramTarget+proxyToHistogramTarget x = case x of+   NoProxy -> Histogram+   Proxy -> ProxyHistogram++--------------------------------------------------------------------------------++histogram :: Proxy -> StateVar (Maybe (GLsizei, PixelInternalFormat, Sink))+histogram proxy =+   makeStateVarMaybe+      (return CapHistogram) (getHistogram' proxy) (setHistogram proxy)++getHistogram' :: Proxy -> IO (GLsizei, PixelInternalFormat, Sink)+getHistogram' proxy = do+   w <- getHistogramParameteri fromIntegral proxy HistogramWidth+   f <- getHistogramParameteri unmarshalPixelInternalFormat proxy HistogramFormat+   s <- getHistogramParameteri unmarshalSink proxy HistogramSink+   return (w, f, s)++getHistogramParameteri ::+   (GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a+getHistogramParameteri f proxy p =+   alloca $ \buf -> do+      glGetHistogramParameteriv+         (marshalHistogramTarget (proxyToHistogramTarget proxy))+         (marshalGetHistogramParameterPName p)+         buf+      peek1 f buf++setHistogram :: Proxy -> (GLsizei, PixelInternalFormat, Sink) -> IO ()+setHistogram proxy (w, int, sink) =+   glHistogram+      (marshalHistogramTarget (proxyToHistogramTarget proxy))+      w+      (marshalPixelInternalFormat' int)+      (marshalSink sink)++--------------------------------------------------------------------------------++getHistogram :: Reset -> PixelData a -> IO ()+getHistogram reset pd =+   withPixelData pd $+      glGetHistogram+         (marshalHistogramTarget Histogram)+         (marshalReset reset)++--------------------------------------------------------------------------------++resetHistogram :: IO ()+resetHistogram = glResetHistogram (marshalHistogramTarget Histogram)++--------------------------------------------------------------------------------++data GetHistogramParameterPName =+     HistogramWidth+   | HistogramFormat+   | HistogramRedSize+   | HistogramGreenSize+   | HistogramBlueSize+   | HistogramAlphaSize+   | HistogramLuminanceSize+   | HistogramSink++marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum+marshalGetHistogramParameterPName x = case x of+   HistogramWidth -> gl_HISTOGRAM_WIDTH+   HistogramFormat -> gl_HISTOGRAM_FORMAT+   HistogramRedSize -> gl_HISTOGRAM_RED_SIZE+   HistogramGreenSize -> gl_HISTOGRAM_GREEN_SIZE+   HistogramBlueSize -> gl_HISTOGRAM_BLUE_SIZE+   HistogramAlphaSize -> gl_HISTOGRAM_ALPHA_SIZE+   HistogramLuminanceSize -> gl_HISTOGRAM_LUMINANCE_SIZE+   HistogramSink -> gl_HISTOGRAM_SINK++--------------------------------------------------------------------------------++histogramRGBASizes :: Proxy -> GettableStateVar (Color4 GLsizei)+histogramRGBASizes proxy =+   makeGettableStateVar $ do+      r <- getHistogramParameteri fromIntegral proxy HistogramRedSize+      g <- getHistogramParameteri fromIntegral proxy HistogramGreenSize+      b <- getHistogramParameteri fromIntegral proxy HistogramBlueSize+      a <- getHistogramParameteri fromIntegral proxy HistogramAlphaSize+      return $ Color4 r g b a++histogramLuminanceSize :: Proxy -> GettableStateVar GLsizei+histogramLuminanceSize proxy =+   makeGettableStateVar $+      getHistogramParameteri fromIntegral proxy HistogramLuminanceSize
Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs view
@@ -1,89 +1,89 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Alloc
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data MinmaxTarget =
-     Minmax
-
-marshalMinmaxTarget :: MinmaxTarget -> GLenum
-marshalMinmaxTarget x = case x of
-   Minmax -> gl_MINMAX
-
---------------------------------------------------------------------------------
-
-minmax :: StateVar (Maybe (PixelInternalFormat, Sink))
-minmax = makeStateVarMaybe (return CapMinmax) getMinmax' setMinmax
-
-getMinmax' :: IO (PixelInternalFormat, Sink)
-getMinmax' = do
-   f <- getMinmaxParameteri unmarshalPixelInternalFormat MinmaxFormat
-   s <- getMinmaxParameteri unmarshalSink MinmaxSink
-   return (f, s)
-
-setMinmax :: (PixelInternalFormat, Sink) -> IO ()
-setMinmax (int, sink) =
-   glMinmax
-      (marshalMinmaxTarget Minmax)
-      (marshalPixelInternalFormat' int)
-      (marshalSink sink)
-
---------------------------------------------------------------------------------
-
-getMinmax :: Reset -> PixelData a -> IO ()
-getMinmax reset pd =
-   withPixelData pd $
-      glGetMinmax (marshalMinmaxTarget Minmax) (marshalReset reset)
-
---------------------------------------------------------------------------------
-
-resetMinmax :: IO ()
-resetMinmax = glResetMinmax (marshalMinmaxTarget Minmax)
-
---------------------------------------------------------------------------------
-
-data GetMinmaxParameterPName =
-     MinmaxFormat
-   | MinmaxSink
-
-marshalGetMinmaxParameterPName :: GetMinmaxParameterPName -> GLenum
-marshalGetMinmaxParameterPName x = case x of
-   MinmaxFormat -> gl_MINMAX_FORMAT
-   MinmaxSink -> gl_MINMAX_SINK
-
---------------------------------------------------------------------------------
-
-getMinmaxParameteri :: (GLint -> a) -> GetMinmaxParameterPName -> IO a
-getMinmaxParameteri f p =
-   alloca $ \buf -> do
-      glGetMinmaxParameteriv
-         (marshalMinmaxTarget Minmax)
-         (marshalGetMinmaxParameterPName p)
-         buf
-      peek1 f buf
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Alloc+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset+import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data MinmaxTarget =+     Minmax++marshalMinmaxTarget :: MinmaxTarget -> GLenum+marshalMinmaxTarget x = case x of+   Minmax -> gl_MINMAX++--------------------------------------------------------------------------------++minmax :: StateVar (Maybe (PixelInternalFormat, Sink))+minmax = makeStateVarMaybe (return CapMinmax) getMinmax' setMinmax++getMinmax' :: IO (PixelInternalFormat, Sink)+getMinmax' = do+   f <- getMinmaxParameteri unmarshalPixelInternalFormat MinmaxFormat+   s <- getMinmaxParameteri unmarshalSink MinmaxSink+   return (f, s)++setMinmax :: (PixelInternalFormat, Sink) -> IO ()+setMinmax (int, sink) =+   glMinmax+      (marshalMinmaxTarget Minmax)+      (marshalPixelInternalFormat' int)+      (marshalSink sink)++--------------------------------------------------------------------------------++getMinmax :: Reset -> PixelData a -> IO ()+getMinmax reset pd =+   withPixelData pd $+      glGetMinmax (marshalMinmaxTarget Minmax) (marshalReset reset)++--------------------------------------------------------------------------------++resetMinmax :: IO ()+resetMinmax = glResetMinmax (marshalMinmaxTarget Minmax)++--------------------------------------------------------------------------------++data GetMinmaxParameterPName =+     MinmaxFormat+   | MinmaxSink++marshalGetMinmaxParameterPName :: GetMinmaxParameterPName -> GLenum+marshalGetMinmaxParameterPName x = case x of+   MinmaxFormat -> gl_MINMAX_FORMAT+   MinmaxSink -> gl_MINMAX_SINK++--------------------------------------------------------------------------------++getMinmaxParameteri :: (GLint -> a) -> GetMinmaxParameterPName -> IO a+getMinmaxParameteri f p =+   alloca $ \buf -> do+      glGetMinmaxParameteriv+         (marshalMinmaxTarget Minmax)+         (marshalGetMinmaxParameterPName p)+         buf+      peek1 f buf
Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs view
@@ -1,208 +1,208 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.ForeignPtr
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data PixelMapTarget =
-     IToI
-   | SToS
-   | IToR
-   | IToG
-   | IToB
-   | IToA
-   | RToR
-   | GToG
-   | BToB
-   | AToA
-
-marshalPixelMapTarget :: PixelMapTarget -> GLenum
-marshalPixelMapTarget x = case x of
-   IToI -> gl_PIXEL_MAP_I_TO_I
-   SToS -> gl_PIXEL_MAP_S_TO_S
-   IToR -> gl_PIXEL_MAP_I_TO_R
-   IToG -> gl_PIXEL_MAP_I_TO_G
-   IToB -> gl_PIXEL_MAP_I_TO_B
-   IToA -> gl_PIXEL_MAP_I_TO_A
-   RToR -> gl_PIXEL_MAP_R_TO_R
-   GToG -> gl_PIXEL_MAP_G_TO_G
-   BToB -> gl_PIXEL_MAP_B_TO_B
-   AToA -> gl_PIXEL_MAP_A_TO_A
-
-pixelMapTargetToGetPName :: PixelMapTarget -> 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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.ForeignPtr+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data PixelMapTarget =+     IToI+   | SToS+   | IToR+   | IToG+   | IToB+   | IToA+   | RToR+   | GToG+   | BToB+   | AToA++marshalPixelMapTarget :: PixelMapTarget -> GLenum+marshalPixelMapTarget x = case x of+   IToI -> gl_PIXEL_MAP_I_TO_I+   SToS -> gl_PIXEL_MAP_S_TO_S+   IToR -> gl_PIXEL_MAP_I_TO_R+   IToG -> gl_PIXEL_MAP_I_TO_G+   IToB -> gl_PIXEL_MAP_I_TO_B+   IToA -> gl_PIXEL_MAP_I_TO_A+   RToR -> gl_PIXEL_MAP_R_TO_R+   GToG -> gl_PIXEL_MAP_G_TO_G+   BToB -> gl_PIXEL_MAP_B_TO_B+   AToA -> gl_PIXEL_MAP_A_TO_A++pixelMapTargetToGetPName :: PixelMapTarget -> 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
Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs view
@@ -1,118 +1,118 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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))
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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))
Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs view
@@ -1,233 +1,233 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs view
@@ -1,39 +1,39 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.PixelFormat
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.CoordTrans+import Graphics.Rendering.OpenGL.GL.PixelData+import Graphics.Rendering.OpenGL.GL.PixelFormat+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++drawPixels :: Size -> PixelData a -> IO ()+drawPixels (Size w h) pd = withPixelData pd $ glDrawPixels w h++--------------------------------------------------------------------------------++pixelZoom :: StateVar (GLfloat, GLfloat)+pixelZoom =+   makeStateVar+      (liftM2 (,) (getFloat1 id GetZoomX) (getFloat1 id GetZoomY))+      (uncurry glPixelZoom)
Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs view
@@ -1,31 +1,31 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data Reset =
-     NoReset
-   | Reset
-   deriving ( Eq, Ord, Show )
-
-marshalReset :: Reset -> GLboolean
-marshalReset x = marshalGLboolean (x == Reset)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data Reset =+     NoReset+   | Reset+   deriving ( Eq, Ord, Show )++marshalReset :: Reset -> GLboolean+marshalReset x = marshalGLboolean (x == Reset)
Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs view
@@ -1,34 +1,34 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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/PixellikeObject.hs view
@@ -1,82 +1,82 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PixellikeObject
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013
--- License     :  BSD3
---
--- Maintainer  :  Sven Panne <svenpanne@gmail.com>
--- Stability   :  stable
--- Portability :  portable
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixellikeObject (
-  PixellikeObjectGetPName(..),
-  PixellikeObjectTarget(pixellikeObjTarParam),
-) where
-
-import Foreign.Marshal.Alloc
-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.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
-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 =
-      alloca $ \buf -> do
-      glGetTexLevelParameteriv (marshalQueryableTextureTarget t) level p buf
-      peek1 id buf
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PixellikeObject+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.PixellikeObject (+  PixellikeObjectGetPName(..),+  PixellikeObjectTarget(pixellikeObjTarParam),+) where++import Foreign.Marshal.Alloc+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.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.Specification+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++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 =+      alloca $ \buf -> do+      glGetTexLevelParameteriv (marshalQueryableTextureTarget t) level p buf+      peek1 id buf
Graphics/Rendering/OpenGL/GL/PointParameter.hs view
@@ -1,44 +1,44 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PointParameter
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PointParameter+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data PointParameter =+     PointSizeMin+   | PointSizeMax+   | PointFadeThresholdSize+   | PointDistanceAttenuation++marshalPointParameter :: PointParameter -> GLenum+marshalPointParameter x = case x of+   PointSizeMin -> gl_POINT_SIZE_MIN+   PointSizeMax -> gl_POINT_SIZE_MAX+   PointFadeThresholdSize -> gl_POINT_FADE_THRESHOLD_SIZE+   PointDistanceAttenuation -> gl_POINT_DISTANCE_ATTENUATION++--------------------------------------------------------------------------------++pointParameterf :: PointParameter -> GLfloat -> IO ()+pointParameterf = glPointParameterf . marshalPointParameter++pointParameterfv :: PointParameter -> Ptr GLfloat -> IO ()+pointParameterfv = glPointParameterfv . marshalPointParameter
Graphics/Rendering/OpenGL/GL/Points.hs view
@@ -1,217 +1,217 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Points
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.PointParameter
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | '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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Points+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.PointParameter+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 'pointSize' contains the rasterized diameter of both aliased and+-- antialiased points. The initial value is 1. Using a point size other than 1+-- has different effects, depending on whether point antialiasing is enabled+-- (see 'pointSmooth') or point sprites are enabled (see 'pointSprite'). Both+-- are initially disabled.+--+-- The specified point size is multiplied with a distance attenuation factor+-- and clamped to the specified 'pointSizeRange', and further clamped to the+-- implementation-dependent point size range to produce the derived point size+-- using+--+-- @   /derivedSize/ = /clamp/ (/size/ * /sqrt/ (1 \/ (/a/ + /b/ * /d/ + /c/ * /d/^2)))@+--+-- where /d/ is the eye-coordinate distance from the eye to the vertex, and /a/,+-- /b/, and /c/ are the distance attenuation coefficients (see+-- 'pointDistanceAttenuation').+--+-- If multisampling is disabled, the computed point size is used as the point\'s+-- width.+--+-- If multisampling is enabled, the point may be faded by modifying the point+-- alpha value (see 'Graphics.Rendering.OpenGL.GL.PerFragment.sampleCoverage')+-- instead of allowing the point width to go below a given+-- 'pointFadeThresholdSize'. In this case, the width is further modified in+-- the following manner:+--+-- @   /width/ = if /derivedSize/ >= /threshold/ then /derivedSize/ else /threshold/@+--+-- The point alpha value is modified by computing:+--+-- @   /alpha/ = if /derivedSize/ >= /threshold/ then 1 else (/derivedSize/ \/ /threshold/)^2@+--+-- If point antialiasing is disabled, the actual size is determined by rounding+-- the supplied size to the nearest integer. (If the rounding results in the+-- value 0, it is as if the point size were 1.) If the rounded size is odd,+-- then the center point (/x/, /y/) of the pixel fragment that represents+-- the point is computed as+--+-- @   (/x/, /y/) = (/floor/ /xw/ + 0.5, /floor/ /yw/ + 0.5)@+--+-- where /xw/ and /yw/ indicate window coordinates. All pixels that lie within+-- the square grid of the rounded size centered at (/x/, /y/) make up the+-- fragment. If the size is even, the center point is+--+-- @   (/x/, /y/) = (/floor/ (/xw/ + 0.5), /floor/ (/yw/ + 0.5))@+--+-- and the rasterized fragment\'s centers are the half-integer window+-- coordinates within the square of the rounded size centered at (/x/, /y/). All+-- pixel fragments produced in rasterizing a nonantialiased point are assigned+-- the same associated data, that of the vertex corresponding to the point.+--+-- If antialiasing is enabled, then point rasterization produces a fragment for+-- each pixel square that intersects the region lying within the circle having+-- diameter equal to the current point size and centered at the point\'s+-- (/xw/, /yw/). The coverage value for each fragment is the window coordinate+-- area of the intersection of the circular region with the corresponding pixel+-- square. This value is saved and used in the final rasterization step. The+-- data associated with each fragment is the data associated with the point+-- being rasterized.+--+-- Not all sizes are supported when point antialiasing is enabled. If an+-- unsupported size is requested, the nearest supported size is used.  Only size+-- 1 is guaranteed to be supported; others depend on the implementation. To+-- query the range of supported sizes for antialiased points and the size+-- difference between supported sizes within the range, query+-- 'smoothPointSizeRange' and 'smoothPointSizeGranularity', respectively. For+-- aliased points, query the supported range with 'aliasedPointSizeRange'.+--+-- The point size specified when 'pointSize' is set is always returned when it+-- is queried. Clamping and rounding for aliased and antialiased points have no+-- effect on the specified value.+--+-- A non-antialiased point size may be clamped to an implementation-dependent+-- maximum. Although this maximum cannot be queried, it must be no less than the+-- maximum value for antialiased points, rounded to the nearest integer value.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if+-- 'pointSize' is set to a value less than or equal to zero.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if+-- 'pointSize' is set during+-- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.++pointSize :: StateVar GLfloat+pointSize = makeStateVar (getFloat1 id GetPointSize) glPointSize++--------------------------------------------------------------------------------++vertexProgramPointSize :: StateVar Capability+vertexProgramPointSize = makeCapability CapVertexProgramPointSize++--------------------------------------------------------------------------------++-- | The range to which the derived point size is clamped, see 'pointSize'. Note+-- that the size is further clamped to the implementation-dependent limits, see+-- 'aliasedPointSizeRange' and 'smoothPointSizeRange'. The initial range is+-- (0, 1).+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the+-- lower or upper bound of the range is set to a value less than zero. If the+-- lower bound is greater than the upper bound, the point size after clamping is+-- undefined, but no error is generated.++pointSizeRange :: StateVar (GLfloat, GLfloat)+pointSizeRange =+   makeStateVar+   (liftM2 (,) (getFloat1 id GetPointSizeMin) (getFloat1 id GetPointSizeMax))+   (\(sizeMin, sizeMax) -> do pointParameterf PointSizeMin sizeMin+                              pointParameterf PointSizeMax sizeMax)++--------------------------------------------------------------------------------++-- | The  constant, linear, and quadratic distance attenuation coefficients, see+-- 'pointSize'. The initial coefficients are (1, 0, 0).++pointDistanceAttenuation :: StateVar (GLfloat, GLfloat, GLfloat)+pointDistanceAttenuation =+   makeStateVar+      (getFloat3 (,,) GetPointDistanceAttenuation)+      (\(a, b, c) -> withArray [a, b, c] $+                        pointParameterfv PointDistanceAttenuation)++--------------------------------------------------------------------------------++-- | The threshold for alpha attenuation of points when multisampling is used,+-- see 'pointSize'. The initial threshold is 1.+--+-- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the+-- threshold is set to a value less than zero.++pointFadeThresholdSize :: StateVar GLfloat+pointFadeThresholdSize =+   makeStateVar+      (getFloat1 id GetPointFadeThresholdSize)+      (pointParameterf PointFadeThresholdSize)++--------------------------------------------------------------------------------++-- | Controls whether point antialiasing is enabled. The initial state is+-- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.++pointSmooth :: StateVar Capability+pointSmooth = makeCapability CapPointSmooth++--------------------------------------------------------------------------------++-- | Controls whether point sprites are enabled. The initial state is+-- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'. When point sprites are+-- enabled, the state of point antialiasing (i.e. 'pointSmooth') is ignored.++pointSprite :: StateVar Capability+pointSprite = makeCapability CapPointSprite++--------------------------------------------------------------------------------++-- | The smallest and largest supported size of aliased points.++aliasedPointSizeRange :: GettableStateVar (GLfloat, GLfloat)+aliasedPointSizeRange =+   makeGettableStateVar $ getFloat2 (,) GetAliasedPointSizeRange++-- | The smallest and largest supported size of antialiased points.++smoothPointSizeRange :: GettableStateVar (GLfloat, GLfloat)+smoothPointSizeRange =+   makeGettableStateVar $ getFloat2 (,) GetSmoothPointSizeRange++-- | The antialiased point size granularity, i.e. the size difference between+-- supported sizes.++smoothPointSizeGranularity :: GettableStateVar GLfloat+smoothPointSizeGranularity =+   makeGettableStateVar $ getFloat1 id GetSmoothPointSizeGranularity
Graphics/Rendering/OpenGL/GL/PolygonMode.hs view
@@ -1,41 +1,41 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PolygonMode
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PolygonMode+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data PolygonMode =+     Point+   | Line+   | Fill+   deriving ( Eq, Ord, Show )++marshalPolygonMode :: PolygonMode -> GLenum+marshalPolygonMode x = case x of+   Point -> gl_POINT+   Line -> gl_LINE+   Fill -> gl_FILL++unmarshalPolygonMode :: GLenum -> PolygonMode+unmarshalPolygonMode x+   | x == gl_POINT = Point+   | x == gl_LINE = Line+   | x == gl_FILL = Fill+   | otherwise = error ("unmarshalPolygonMode: illegal value " ++ show x)
Graphics/Rendering/OpenGL/GL/Polygons.hs view
@@ -1,139 +1,139 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Polygons
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.ForeignPtr
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.Face
-import Graphics.Rendering.OpenGL.GL.PixelRectangles
-import Graphics.Rendering.OpenGL.GL.PolygonMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.SavingState
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Polygons+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.ForeignPtr+import Foreign.Marshal.Array+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Face+import Graphics.Rendering.OpenGL.GL.PixelRectangles+import Graphics.Rendering.OpenGL.GL.PolygonMode+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.SavingState+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs view
@@ -1,96 +1,96 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.PrimitiveMode
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.PrimitiveMode (
-   PrimitiveMode(..), marshalPrimitiveMode, unmarshalPrimitiveMode
-) where
-
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | Specification of the way the vertices given during 'renderPrimitive' are
--- interpreted. In the description of the constructors, /n/ is an integer count
--- starting at one, and /N/ is the total number of vertices specified.
-
-data PrimitiveMode =
-     Points
-     -- ^ Treats each vertex as a single point. Vertex /n/ defines point /n/.
-     -- /N/ points are drawn.
-   | Lines
-     -- ^ Treats each pair of vertices as an independent line segment. Vertices
-     -- 2/n/-1 and 2/n/ define line /n/. /N/\/2 lines are drawn.
-   | LineLoop
-     -- ^ Draws a connected group of line segments from the first vertex to the
-     -- last, then back to the first. Vertices /n/ and /n/+1 define line /n/.
-     -- The last line, however, is defined by vertices /N/ and 1. /N/ lines
-     -- are drawn.
-   | LineStrip
-     -- ^ Draws a connected group of line  segments from the first vertex to the
-     -- last. Vertices /n/ and /n/+1 define line /n/. /N/-1 lines are drawn.
-   | Triangles
-     -- ^ Treats each triplet of vertices as an independent triangle. Vertices
-     -- /3n-2/, /3n-1/, and /3n/ define triangle /n/. /N\/3/ triangles are drawn.
-   | TriangleStrip
-     -- ^ Draws a connected group of triangles. One triangle is defined for each
-     -- vertex presented after the first two vertices. For odd /n/, vertices
-     -- /n/, /n/+1, and /n/+2 define triangle /n/. For even /n/, vertices /n/+1,
-     -- /n/, and /n/+2 define triangle /n/. /N/-2 triangles are drawn.
-   | TriangleFan
-     -- ^ Draws a connected group of triangles. One triangle is defined for each
-     -- vertex presented after the first two vertices. Vertices 1, /n/+1, and
-     -- /n/+2 define triangle /n/. /N/-2 triangles are drawn.
-   | Quads
-     -- ^ Treats each group of four vertices as an independent quadrilateral.
-     -- Vertices 4/n/-3, 4/n/-2, 4/n/-1, and 4/n/ define quadrilateral /n/.
-     -- /N/\/4 quadrilaterals are drawn.
-   | QuadStrip
-     -- ^ Draws a connected group of quadrilaterals. One quadrilateral is
-     --defined for each pair of vertices presented after the first pair.
-     -- Vertices 2/n/-1, 2/n/, 2/n/+2, and 2/n/+1 define quadrilateral /n/.
-     -- /N/\/2-1 quadrilaterals are drawn. Note that the order in which vertices
-     -- are used to construct a quadrilateral from strip data is different from
-     -- that used with independent data.
-   | Polygon
-     -- ^ Draws a single, convex polygon. Vertices 1 through /N/ define this
-     -- polygon.
-   deriving ( Eq, Ord, Show )
-
-marshalPrimitiveMode :: PrimitiveMode -> GLenum
-marshalPrimitiveMode x = case x of
-   Points -> gl_POINTS
-   Lines -> gl_LINES
-   LineLoop -> gl_LINE_LOOP
-   LineStrip -> gl_LINE_STRIP
-   Triangles -> gl_TRIANGLES
-   TriangleStrip -> gl_TRIANGLE_STRIP
-   TriangleFan -> gl_TRIANGLE_FAN
-   Quads -> gl_QUADS
-   QuadStrip -> gl_QUAD_STRIP
-   Polygon -> gl_POLYGON
-
-unmarshalPrimitiveMode :: GLenum -> PrimitiveMode
-unmarshalPrimitiveMode x
-   | x == gl_POINTS = Points
-   | x == gl_LINES = Lines
-   | x == gl_LINE_LOOP = LineLoop
-   | x == gl_LINE_STRIP = LineStrip
-   | x == gl_TRIANGLES = Triangles
-   | x == gl_TRIANGLE_STRIP = TriangleStrip
-   | x == gl_TRIANGLE_FAN = TriangleFan
-   | x == gl_QUADS = Quads
-   | x == gl_QUAD_STRIP = QuadStrip
-   | x == gl_POLYGON = Polygon
-   | otherwise = error ("unmarshalPrimitiveMode: illegal value " ++ show x)
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.PrimitiveMode+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.PrimitiveMode (+   PrimitiveMode(..), marshalPrimitiveMode, unmarshalPrimitiveMode+) where++import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | Specification of the way the vertices given during 'renderPrimitive' are+-- interpreted. In the description of the constructors, /n/ is an integer count+-- starting at one, and /N/ is the total number of vertices specified.++data PrimitiveMode =+     Points+     -- ^ Treats each vertex as a single point. Vertex /n/ defines point /n/.+     -- /N/ points are drawn.+   | Lines+     -- ^ Treats each pair of vertices as an independent line segment. Vertices+     -- 2/n/-1 and 2/n/ define line /n/. /N/\/2 lines are drawn.+   | LineLoop+     -- ^ Draws a connected group of line segments from the first vertex to the+     -- last, then back to the first. Vertices /n/ and /n/+1 define line /n/.+     -- The last line, however, is defined by vertices /N/ and 1. /N/ lines+     -- are drawn.+   | LineStrip+     -- ^ Draws a connected group of line  segments from the first vertex to the+     -- last. Vertices /n/ and /n/+1 define line /n/. /N/-1 lines are drawn.+   | Triangles+     -- ^ Treats each triplet of vertices as an independent triangle. Vertices+     -- /3n-2/, /3n-1/, and /3n/ define triangle /n/. /N\/3/ triangles are drawn.+   | TriangleStrip+     -- ^ Draws a connected group of triangles. One triangle is defined for each+     -- vertex presented after the first two vertices. For odd /n/, vertices+     -- /n/, /n/+1, and /n/+2 define triangle /n/. For even /n/, vertices /n/+1,+     -- /n/, and /n/+2 define triangle /n/. /N/-2 triangles are drawn.+   | TriangleFan+     -- ^ Draws a connected group of triangles. One triangle is defined for each+     -- vertex presented after the first two vertices. Vertices 1, /n/+1, and+     -- /n/+2 define triangle /n/. /N/-2 triangles are drawn.+   | Quads+     -- ^ Treats each group of four vertices as an independent quadrilateral.+     -- Vertices 4/n/-3, 4/n/-2, 4/n/-1, and 4/n/ define quadrilateral /n/.+     -- /N/\/4 quadrilaterals are drawn.+   | QuadStrip+     -- ^ Draws a connected group of quadrilaterals. One quadrilateral is+     --defined for each pair of vertices presented after the first pair.+     -- Vertices 2/n/-1, 2/n/, 2/n/+2, and 2/n/+1 define quadrilateral /n/.+     -- /N/\/2-1 quadrilaterals are drawn. Note that the order in which vertices+     -- are used to construct a quadrilateral from strip data is different from+     -- that used with independent data.+   | Polygon+     -- ^ Draws a single, convex polygon. Vertices 1 through /N/ define this+     -- polygon.+   deriving ( Eq, Ord, Show )++marshalPrimitiveMode :: PrimitiveMode -> GLenum+marshalPrimitiveMode x = case x of+   Points -> gl_POINTS+   Lines -> gl_LINES+   LineLoop -> gl_LINE_LOOP+   LineStrip -> gl_LINE_STRIP+   Triangles -> gl_TRIANGLES+   TriangleStrip -> gl_TRIANGLE_STRIP+   TriangleFan -> gl_TRIANGLE_FAN+   Quads -> gl_QUADS+   QuadStrip -> gl_QUAD_STRIP+   Polygon -> gl_POLYGON++unmarshalPrimitiveMode :: GLenum -> PrimitiveMode+unmarshalPrimitiveMode x+   | x == gl_POINTS = Points+   | x == gl_LINES = Lines+   | x == gl_LINE_LOOP = LineLoop+   | x == gl_LINE_STRIP = LineStrip+   | x == gl_TRIANGLES = Triangles+   | x == gl_TRIANGLE_STRIP = TriangleStrip+   | x == gl_TRIANGLE_FAN = TriangleFan+   | x == gl_QUADS = Quads+   | x == gl_QUAD_STRIP = QuadStrip+   | x == gl_POLYGON = Polygon+   | otherwise = error ("unmarshalPrimitiveMode: illegal value " ++ show x)
Graphics/Rendering/OpenGL/GL/QueryObject.hs view
@@ -1,46 +1,46 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.QueryObject
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype QueryObject = QueryObject { queryID :: GLuint }
-   deriving ( Eq, Ord, Show )
-
-noQueryObject :: QueryObject
-noQueryObject = QueryObject 0
-
---------------------------------------------------------------------------------
-
-instance ObjectName QueryObject where
-   isObjectName = fmap unmarshalGLboolean . glIsQuery . queryID
-
-   deleteObjectNames queryObjects =
-      withArrayLen (map queryID queryObjects) $
-         glDeleteQueries . fromIntegral
-
-instance GeneratableObjectName QueryObject where
-   genObjectNames n =
-      allocaArray n $ \buf -> do
-        glGenQueries (fromIntegral n) buf
-        fmap (map QueryObject) $ peekArray n buf
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryObject+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype QueryObject = QueryObject { queryID :: GLuint }+   deriving ( Eq, Ord, Show )++noQueryObject :: QueryObject+noQueryObject = QueryObject 0++--------------------------------------------------------------------------------++instance ObjectName QueryObject where+   isObjectName = fmap unmarshalGLboolean . glIsQuery . queryID++   deleteObjectNames queryObjects =+      withArrayLen (map queryID queryObjects) $+         glDeleteQueries . fromIntegral++instance GeneratableObjectName QueryObject where+   genObjectNames n =+      allocaArray n $ \buf -> do+        glGenQueries (fromIntegral n) buf+        fmap (map QueryObject) $ peekArray n buf
Graphics/Rendering/OpenGL/GL/QueryObjects.hs view
@@ -1,174 +1,174 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.QueryObjects
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2004-2013
--- 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 Foreign.Marshal.Alloc
-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.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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 $
-      alloca $ \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)
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryObjects+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2004-2013+-- 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 Foreign.Marshal.Alloc+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.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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 $+      alloca $ \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)
Graphics/Rendering/OpenGL/GL/QueryUtils.hs view
@@ -1,65 +1,65 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
-) where
-
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.QueryUtils.PName
-import Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- 0x4000 through 0x4FFF are reserved for light numbers
-
-lightIndexToEnum :: GLsizei -> Maybe GLenum
-lightIndexToEnum i
-   | 0 <= i && i <= maxLightIndex = Just (gl_LIGHT0 + fromIntegral i)
-   | otherwise = Nothing
-
-maxLightIndex :: GLsizei
-maxLightIndex = 0xFFF
-
---------------------------------------------------------------------------------
-
--- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices
-
-modelviewIndexToEnum :: GLsizei -> Maybe GLenum
-modelviewIndexToEnum 0 = Just gl_MODELVIEW
-modelviewIndexToEnum 1 = Just gl_MODELVIEW1
-modelviewIndexToEnum i
-   | 2 <= i && i <= 31 = Just (gl_MODELVIEW2 - 2 + fromIntegral i)
-   | otherwise = Nothing
-
-modelviewEnumToIndex :: GLenum -> Maybe GLsizei
-modelviewEnumToIndex x
-   | x == gl_MODELVIEW = Just 0
-   | x == gl_MODELVIEW1 = Just 1
-   | gl_MODELVIEW2 <= x && x <= gl_MODELVIEW31 = Just (fromIntegral (x - (gl_MODELVIEW2 - 2)))
-   | otherwise = Nothing
-
---------------------------------------------------------------------------------
-
-maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b
-maybeNullPtr n f ptr | ptr == nullPtr = n
-                     | otherwise      = f ptr
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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+) where++import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.QueryUtils.PName+import Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- 0x4000 through 0x4FFF are reserved for light numbers++lightIndexToEnum :: GLsizei -> Maybe GLenum+lightIndexToEnum i+   | 0 <= i && i <= maxLightIndex = Just (gl_LIGHT0 + fromIntegral i)+   | otherwise = Nothing++maxLightIndex :: GLsizei+maxLightIndex = 0xFFF++--------------------------------------------------------------------------------++-- 0x1700, 0x850a, and 0x8722 through 0x873f are reserved for modelview matrices++modelviewIndexToEnum :: GLsizei -> Maybe GLenum+modelviewIndexToEnum 0 = Just gl_MODELVIEW+modelviewIndexToEnum 1 = Just gl_MODELVIEW1+modelviewIndexToEnum i+   | 2 <= i && i <= 31 = Just (gl_MODELVIEW2 - 2 + fromIntegral i)+   | otherwise = Nothing++modelviewEnumToIndex :: GLenum -> Maybe GLsizei+modelviewEnumToIndex x+   | x == gl_MODELVIEW = Just 0+   | x == gl_MODELVIEW1 = Just 1+   | gl_MODELVIEW2 <= x && x <= gl_MODELVIEW31 = Just (fromIntegral (x - (gl_MODELVIEW2 - 2)))+   | otherwise = Nothing++--------------------------------------------------------------------------------++maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b+maybeNullPtr n f ptr | ptr == nullPtr = n+                     | otherwise      = f ptr
Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs view
@@ -1,1157 +1,1157 @@-{-# OPTIONS_HADDOCK hide #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils.PName
--- Copyright   :  (c) Sven Panne 2002-2009, 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
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
-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
-
------------------------------------------------------------------------------
-
-{-# 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, GetPName p)
-    => (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
-
--- Indexed helper
-get1i :: (Storable b, Storable c, GetPName p)
-    => (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, GetPName p)
-    => (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, GetPName p)
-    => (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, GetPName p)
-    => (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, GetPName p)
-    => (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
-    -- 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
-    | 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
-    | GetStencilValueMask           -- ^ int
-    | GetStencilRef                 -- ^ int
-    | GetStencilFail                -- ^ enum
-    | GetStencilPassDepthFail       -- ^ enum
-    | GetStencilPassDepthPass       -- ^ 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
-
-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
-        GetUnpackCMYKHint -> Just gl_UNPACK_CMYK_HINT
-        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
-        -- 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
-        GetCurrentMatrixStackDepth -> Just gl_CURRENT_MATRIX_STACK_DEPTH
-        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
-        GetArrayElementLockFirst -> Just gl_ARRAY_ELEMENT_LOCK_FIRST
-        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
-        -- 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
-        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
-        GetStencilValueMask -> Just gl_STENCIL_VALUE_MASK
-        GetStencilRef -> Just gl_STENCIL_REF
-        GetStencilFail -> Just gl_STENCIL_FAIL
-        GetStencilPassDepthFail -> Just gl_STENCIL_PASS_DEPTH_FAIL
-        GetStencilPassDepthPass -> Just gl_STENCIL_PASS_DEPTH_PASS
-        GetActiveStencilFace -> Just gl_ACTIVE_STENCIL_FACE
-        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
-
--- 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
-        GetMaxSpotExponent -> Just gl_MAX_SPOT_EXPONENT
-        -- 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
-        GetMaxTextureLODBias -> Just gl_MAX_TEXTURE_LOD_BIAS
-
------------------------------------------------------------------------------
-
-data IPName1I
-    =  GetTransformFeedbackBuffer
-    | GetTransformFeedbackBufferStart
-    | GetTransformFeedbackBufferSize
-
-instance GetIPName1I IPName1I where
-
-instance GetPName IPName1I where
-    marshalGetPName pn = case pn of
-        GetTransformFeedbackBuffer -> Just gl_TRANSFORM_FEEDBACK_BUFFER
-        GetTransformFeedbackBufferSize -> Just gl_TRANSFORM_FEEDBACK_BUFFER_SIZE
-        GetTransformFeedbackBufferStart -> Just gl_TRANSFORM_FEEDBACK_BUFFER_START
-
------------------------------------------------------------------------------
-
-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
-
-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
-
------------------------------------------------------------------------------
-
-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
-        -- 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
-    | GetBlendColor                     -- ^ clampf
-
-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
-
-
-
--- 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
+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils.PName+-- Copyright   :  (c) Sven Panne 2002-2009, 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+) where++import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++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++-----------------------------------------------------------------------------++{-# 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, GetPName p)+    => (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++-- Indexed helper+get1i :: (Storable b, Storable c, GetPName p)+    => (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, GetPName p)+    => (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, GetPName p)+    => (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, GetPName p)+    => (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, GetPName p)+    => (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+    -- 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+    | 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+    | GetStencilValueMask           -- ^ int+    | GetStencilRef                 -- ^ int+    | GetStencilFail                -- ^ enum+    | GetStencilPassDepthFail       -- ^ enum+    | GetStencilPassDepthPass       -- ^ 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++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+        GetUnpackCMYKHint -> Just gl_UNPACK_CMYK_HINT+        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+        -- 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+        GetCurrentMatrixStackDepth -> Just gl_CURRENT_MATRIX_STACK_DEPTH+        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+        GetArrayElementLockFirst -> Just gl_ARRAY_ELEMENT_LOCK_FIRST+        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+        -- 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+        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+        GetStencilValueMask -> Just gl_STENCIL_VALUE_MASK+        GetStencilRef -> Just gl_STENCIL_REF+        GetStencilFail -> Just gl_STENCIL_FAIL+        GetStencilPassDepthFail -> Just gl_STENCIL_PASS_DEPTH_FAIL+        GetStencilPassDepthPass -> Just gl_STENCIL_PASS_DEPTH_PASS+        GetActiveStencilFace -> Just gl_ACTIVE_STENCIL_FACE+        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++-- 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+        GetMaxSpotExponent -> Just gl_MAX_SPOT_EXPONENT+        -- 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+        GetMaxTextureLODBias -> Just gl_MAX_TEXTURE_LOD_BIAS++-----------------------------------------------------------------------------++data IPName1I+    =  GetTransformFeedbackBuffer+    | GetTransformFeedbackBufferStart+    | GetTransformFeedbackBufferSize++instance GetIPName1I IPName1I where++instance GetPName IPName1I where+    marshalGetPName pn = case pn of+        GetTransformFeedbackBuffer -> Just gl_TRANSFORM_FEEDBACK_BUFFER+        GetTransformFeedbackBufferSize -> Just gl_TRANSFORM_FEEDBACK_BUFFER_SIZE+        GetTransformFeedbackBufferStart -> Just gl_TRANSFORM_FEEDBACK_BUFFER_START++-----------------------------------------------------------------------------++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++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++-----------------------------------------------------------------------------++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+        -- 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+    | GetBlendColor                     -- ^ clampf++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++++-- 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
Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs view
@@ -1,97 +1,97 @@-{-# OPTIONS_HADDOCK hide #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2009-2013
--- 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.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype AttribLocation = AttribLocation GLuint
-   deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-data GetVertexAttribPName =
-     GetVertexAttribArrayEnabled
-   | GetVertexAttribArraySize
-   | GetVertexAttribArrayStride
-   | GetVertexAttribArrayType
-   | GetVertexAttribArrayNormalized
-   | GetCurrentVertexAttrib
-   | GetVertexAttribArrayBufferBinding
-   | GetVertexAttribArrayInteger
-
-marshalGetVertexAttribPName :: GetVertexAttribPName -> GLenum
-marshalGetVertexAttribPName x = case x of
-   GetVertexAttribArrayEnabled -> gl_VERTEX_ATTRIB_ARRAY_ENABLED
-   GetVertexAttribArraySize -> gl_VERTEX_ATTRIB_ARRAY_SIZE
-   GetVertexAttribArrayStride -> gl_VERTEX_ATTRIB_ARRAY_STRIDE
-   GetVertexAttribArrayType -> gl_VERTEX_ATTRIB_ARRAY_TYPE
-   GetVertexAttribArrayNormalized -> gl_VERTEX_ATTRIB_ARRAY_NORMALIZED
-   GetCurrentVertexAttrib -> gl_CURRENT_VERTEX_ATTRIB
-   GetVertexAttribArrayBufferBinding -> gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING
-   GetVertexAttribArrayInteger -> gl_VERTEX_ATTRIB_ARRAY_INTEGER
-
---------------------------------------------------------------------------------
-
-getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
-getVertexAttribInteger1 f (AttribLocation location) n = alloca $ \buf -> do
-   glGetVertexAttribiv location (marshalGetVertexAttribPName n) buf
-   peek1 f buf
-
-getVertexAttribEnum1 :: (GLenum -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
-getVertexAttribEnum1 f = getVertexAttribInteger1 (f . fromIntegral)
-
-getVertexAttribBoolean1 :: (GLboolean -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
-getVertexAttribBoolean1 f = getVertexAttribInteger1 (f . fromIntegral)
-
-getVertexAttribFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
-getVertexAttribFloat4 f (AttribLocation location) n = alloca $ \buf -> do
-   glGetVertexAttribfv location (marshalGetVertexAttribPName n) buf
-   peek4 f buf
-
-getVertexAttribIInteger4 :: (GLint -> GLint -> GLint -> GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
-getVertexAttribIInteger4 f (AttribLocation location) n = alloca $ \buf -> do
-   glGetVertexAttribIiv location (marshalGetVertexAttribPName n) buf
-   peek4 f buf
-
-getVertexAttribIuInteger4 :: (GLuint -> GLuint -> GLuint -> GLuint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b
-getVertexAttribIuInteger4 f (AttribLocation location) n = alloca $ \buf -> do
-   glGetVertexAttribIuiv location (marshalGetVertexAttribPName n) buf
-   peek4 f buf
-
---------------------------------------------------------------------------------
-
-data GetVertexAttribPointerPName =
-   VertexAttribArrayPointer
-
-marshalGetVertexAttribPointerPName :: GetVertexAttribPointerPName -> GLenum
-marshalGetVertexAttribPointerPName x = case x of
-   VertexAttribArrayPointer -> gl_VERTEX_ATTRIB_ARRAY_POINTER
-
---------------------------------------------------------------------------------
-
-getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a)
-getVertexAttribPointer (AttribLocation location) n = alloca $ \buf -> do
-   glGetVertexAttribPointerv location (marshalGetVertexAttribPointerPName n) buf
-   peek buf
+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2009-2013+-- 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.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype AttribLocation = AttribLocation GLuint+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data GetVertexAttribPName =+     GetVertexAttribArrayEnabled+   | GetVertexAttribArraySize+   | GetVertexAttribArrayStride+   | GetVertexAttribArrayType+   | GetVertexAttribArrayNormalized+   | GetCurrentVertexAttrib+   | GetVertexAttribArrayBufferBinding+   | GetVertexAttribArrayInteger++marshalGetVertexAttribPName :: GetVertexAttribPName -> GLenum+marshalGetVertexAttribPName x = case x of+   GetVertexAttribArrayEnabled -> gl_VERTEX_ATTRIB_ARRAY_ENABLED+   GetVertexAttribArraySize -> gl_VERTEX_ATTRIB_ARRAY_SIZE+   GetVertexAttribArrayStride -> gl_VERTEX_ATTRIB_ARRAY_STRIDE+   GetVertexAttribArrayType -> gl_VERTEX_ATTRIB_ARRAY_TYPE+   GetVertexAttribArrayNormalized -> gl_VERTEX_ATTRIB_ARRAY_NORMALIZED+   GetCurrentVertexAttrib -> gl_CURRENT_VERTEX_ATTRIB+   GetVertexAttribArrayBufferBinding -> gl_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING+   GetVertexAttribArrayInteger -> gl_VERTEX_ATTRIB_ARRAY_INTEGER++--------------------------------------------------------------------------------++getVertexAttribInteger1 :: (GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribInteger1 f (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribiv location (marshalGetVertexAttribPName n) buf+   peek1 f buf++getVertexAttribEnum1 :: (GLenum -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribEnum1 f = getVertexAttribInteger1 (f . fromIntegral)++getVertexAttribBoolean1 :: (GLboolean -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribBoolean1 f = getVertexAttribInteger1 (f . fromIntegral)++getVertexAttribFloat4 :: (GLfloat -> GLfloat -> GLfloat -> GLfloat -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribFloat4 f (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribfv location (marshalGetVertexAttribPName n) buf+   peek4 f buf++getVertexAttribIInteger4 :: (GLint -> GLint -> GLint -> GLint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribIInteger4 f (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribIiv location (marshalGetVertexAttribPName n) buf+   peek4 f buf++getVertexAttribIuInteger4 :: (GLuint -> GLuint -> GLuint -> GLuint -> b) -> AttribLocation -> GetVertexAttribPName -> IO b+getVertexAttribIuInteger4 f (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribIuiv location (marshalGetVertexAttribPName n) buf+   peek4 f buf++--------------------------------------------------------------------------------++data GetVertexAttribPointerPName =+   VertexAttribArrayPointer++marshalGetVertexAttribPointerPName :: GetVertexAttribPointerPName -> GLenum+marshalGetVertexAttribPointerPName x = case x of+   VertexAttribArrayPointer -> gl_VERTEX_ATTRIB_ARRAY_POINTER++--------------------------------------------------------------------------------++getVertexAttribPointer :: AttribLocation -> GetVertexAttribPointerPName -> IO (Ptr a)+getVertexAttribPointer (AttribLocation location) n = alloca $ \buf -> do+   glGetVertexAttribPointerv location (marshalGetVertexAttribPointerPName n) buf+   peek buf
Graphics/Rendering/OpenGL/GL/RasterPos.hs view
@@ -1,187 +1,187 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.RasterPos
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.RasterPos+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++currentRasterPosition :: StateVar (Vertex4 GLfloat)+currentRasterPosition =+   makeStateVar (getFloat4 Vertex4 GetCurrentRasterPosition) rasterPos++--------------------------------------------------------------------------------++class RasterPosComponent a where+   rasterPos2 :: a -> a -> IO ()+   rasterPos3 :: a -> a -> a -> IO ()+   rasterPos4 :: a -> a -> a -> a -> IO ()++   rasterPos2v :: Ptr a -> IO ()+   rasterPos3v :: Ptr a -> IO ()+   rasterPos4v :: Ptr a -> IO ()++instance RasterPosComponent GLshort where+   rasterPos2 = glRasterPos2s+   rasterPos3 = glRasterPos3s+   rasterPos4 = glRasterPos4s++   rasterPos2v = glRasterPos2sv+   rasterPos3v = glRasterPos3sv+   rasterPos4v = glRasterPos4sv++instance RasterPosComponent GLint where+   rasterPos2 = glRasterPos2i+   rasterPos3 = glRasterPos3i+   rasterPos4 = glRasterPos4i++   rasterPos2v = glRasterPos2iv+   rasterPos3v = glRasterPos3iv+   rasterPos4v = glRasterPos4iv++instance RasterPosComponent GLfloat where+   rasterPos2 = glRasterPos2f+   rasterPos3 = glRasterPos3f+   rasterPos4 = glRasterPos4f++   rasterPos2v = glRasterPos2fv+   rasterPos3v = glRasterPos3fv+   rasterPos4v = glRasterPos4fv++instance RasterPosComponent GLdouble where+   rasterPos2 = glRasterPos2d+   rasterPos3 = glRasterPos3d+   rasterPos4 = glRasterPos4d++   rasterPos2v = glRasterPos2dv+   rasterPos3v = glRasterPos3dv+   rasterPos4v = glRasterPos4dv++--------------------------------------------------------------------------------++class RasterPos a where+   rasterPos  ::     a -> IO ()+   rasterPosv :: Ptr a -> IO ()++instance RasterPosComponent a => RasterPos (Vertex2 a) where+   rasterPos (Vertex2 x y) = rasterPos2 x y+   rasterPosv = rasterPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)++instance RasterPosComponent a => RasterPos (Vertex3 a) where+   rasterPos (Vertex3 x y z) = rasterPos3 x y z+   rasterPosv = rasterPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)++instance RasterPosComponent a => RasterPos (Vertex4 a) where+   rasterPos (Vertex4 x y z w) = rasterPos4 x y z w+   rasterPosv = rasterPos4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)++--------------------------------------------------------------------------------++class WindowPosComponent a where+   windowPos2 :: a -> a -> IO ()+   windowPos3 :: a -> a -> a -> IO ()++   windowPos2v :: Ptr a -> IO ()+   windowPos3v :: Ptr a -> IO ()++instance WindowPosComponent GLshort where+   windowPos2 = glWindowPos2s+   windowPos3 = glWindowPos3s++   windowPos2v = glWindowPos2sv+   windowPos3v = glWindowPos3sv++instance WindowPosComponent GLint where+   windowPos2 = glWindowPos2i+   windowPos3 = glWindowPos3i++   windowPos2v = glWindowPos2iv+   windowPos3v = glWindowPos3iv++instance WindowPosComponent GLfloat where+   windowPos2 = glWindowPos2f+   windowPos3 = glWindowPos3f++   windowPos2v = glWindowPos2fv+   windowPos3v = glWindowPos3fv++instance WindowPosComponent GLdouble where+   windowPos2 = glWindowPos2d+   windowPos3 = glWindowPos3d++   windowPos2v = glWindowPos2dv+   windowPos3v = glWindowPos3dv++--------------------------------------------------------------------------------++class WindowPos a where+   windowPos  ::     a -> IO ()+   windowPosv :: Ptr a -> IO ()++instance WindowPosComponent a => WindowPos (Vertex2 a) where+   windowPos (Vertex2 x y) = windowPos2 x y+   windowPosv = windowPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)++instance WindowPosComponent a => WindowPos (Vertex3 a) where+   windowPos (Vertex3 x y z) = windowPos3 x y z+   windowPosv = windowPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)++--------------------------------------------------------------------------------++currentRasterDistance :: GettableStateVar GLfloat+currentRasterDistance =+   makeGettableStateVar (getFloat1 id GetCurrentRasterDistance)++currentRasterColor :: GettableStateVar (Color4 GLfloat)+currentRasterColor =+   makeGettableStateVar (getFloat4 Color4 GetCurrentRasterColor)++currentRasterSecondaryColor :: GettableStateVar (Color4 GLfloat)+currentRasterSecondaryColor =+   makeGettableStateVar (getFloat4 Color4 GetCurrentRasterSecondaryColor)++currentRasterIndex :: GettableStateVar (Index1 GLint)+currentRasterIndex =+   makeGettableStateVar (getInteger1 Index1 GetCurrentRasterIndex)++currentRasterTexCoords :: GettableStateVar (TexCoord4 GLfloat)+currentRasterTexCoords =+   makeGettableStateVar (getFloat4 TexCoord4 GetCurrentRasterTextureCoords)++currentRasterPositionValid :: GettableStateVar Bool+currentRasterPositionValid =+   makeGettableStateVar+      (getBoolean1 unmarshalGLboolean GetCurrentRasterPositionValid)++--------------------------------------------------------------------------------++rasterPositionUnclipped :: StateVar Capability+rasterPositionUnclipped = makeCapability CapRasterPositionUnclipped
Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs view
@@ -1,103 +1,103 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.ReadCopyPixels
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.Filter
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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))
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.ReadCopyPixels+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.Filter+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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))
Graphics/Rendering/OpenGL/GL/Rectangles.hs view
@@ -1,65 +1,65 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Rectangles
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | '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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Rectangles+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 'rect' and 'rectv' support efficient specification of rectangles as two+-- corner points. Each rectangle command takes four arguments, organized either+-- as two consecutive pairs of (/x/, /y/) coordinates, or as two pointers to+-- arrays, each containing an (/x/, /y/) pair. The resulting rectangle is+-- defined in the /z/ = 0 plane.+--+-- @'rect' ('Vertex2' x1 y1) ('Vertex2' x2, y2)@ is exactly equivalent to the+-- following sequence:+--+-- @+--    'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' 'Graphics.Rendering.OpenGL.GL.BeginEnd.Polygon' $ do+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y1)+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y1)+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y2)+--        'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y2)+-- @+--+-- Note that if the second vertex is above and to the right of the first vertex,+-- the rectangle is constructed with a counterclockwise winding.++class Rect a where+   rect  :: Vertex2 a -> Vertex2 a -> IO ()+   rectv :: Ptr     a -> Ptr     a -> IO ()++instance Rect GLshort where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRects x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectsv ptr1 ptr2++instance Rect GLint where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRecti x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectiv ptr1 ptr2++instance Rect GLfloat where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectf x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectfv ptr1 ptr2++instance Rect GLdouble where+   rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectd x1 y1 x2 y2+   rectv ptr1 ptr2 = glRectdv ptr1 ptr2
Graphics/Rendering/OpenGL/GL/RenderMode.hs view
@@ -1,60 +1,60 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.RenderMode
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.RenderMode+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data RenderMode =+     Render+   | Feedback+   | Select+   deriving ( Eq, Ord, Show )++marshalRenderMode :: RenderMode -> GLenum+marshalRenderMode x = case x of+   Render -> gl_RENDER+   Feedback -> gl_FEEDBACK+   Select -> gl_SELECT++unmarshalRenderMode :: GLenum -> RenderMode+unmarshalRenderMode x+   | x == gl_RENDER = Render+   | x == gl_FEEDBACK = Feedback+   | x == gl_SELECT = Select+   | otherwise = error ("unmarshalRenderMode: illegal value " ++ show x)++--------------------------------------------------------------------------------++withRenderMode :: RenderMode -> IO a -> IO (a, GLint)+withRenderMode newMode action = do+   oldMode <- get renderMode+   _ <- setRenderMode newMode+   action `finallyRet` setRenderMode oldMode++setRenderMode :: RenderMode -> IO GLint+setRenderMode = glRenderMode . marshalRenderMode++--------------------------------------------------------------------------------++renderMode :: GettableStateVar RenderMode+renderMode = makeGettableStateVar $ getEnum1 unmarshalRenderMode GetRenderMode
Graphics/Rendering/OpenGL/GL/SavingState.hs view
@@ -1,105 +1,105 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.SavingState
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.SavingState+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Selection.hs view
@@ -1,88 +1,88 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Selection
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Array
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.IOState
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.RenderMode
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Selection+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Array+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.Exception+import Graphics.Rendering.OpenGL.GL.IOState+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.RenderMode+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data HitRecord = HitRecord GLfloat GLfloat [Name]+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++getHitRecords :: GLsizei -> IO a -> IO (a, Maybe [HitRecord])+getHitRecords bufSize action =+   allocaArray (fromIntegral bufSize) $ \buf -> do+      glSelectBuffer bufSize buf+      (value, numHits) <- withRenderMode Select $ do+         glInitNames+         action+      hits <- parseSelectionBuffer numHits buf+      return (value, hits)++--------------------------------------------------------------------------------++parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])+parseSelectionBuffer numHits buf+   | numHits < 0 = return Nothing+   | otherwise = fmap Just $ evalIOState (nTimes numHits parseSelectionHit) buf++type Parser a = IOState GLuint a++parseSelectionHit :: Parser HitRecord+parseSelectionHit = do+   numNames <- parseGLuint+   minZ <- parseGLfloat+   maxZ <- parseGLfloat+   nameStack <- nTimes numNames parseName+   return $ HitRecord minZ maxZ nameStack++parseGLuint :: Parser GLuint+parseGLuint = peekIOState++parseGLfloat :: Parser GLfloat+parseGLfloat = fmap (\x -> fromIntegral x / 0xffffffff) parseGLuint++parseName :: Parser Name+parseName = fmap Name parseGLuint++--------------------------------------------------------------------------------++newtype Name = Name GLuint+   deriving ( Eq, Ord, Show )++withName :: Name -> IO a -> IO a+withName (Name name) = bracket_ (glPushName name) glPopName++loadName :: Name -> IO ()+loadName (Name n) = glLoadName n++maxNameStackDepth :: GettableStateVar GLsizei+maxNameStackDepth = makeGettableStateVar (getSizei1 id GetMaxNameStackDepth)++nameStackDepth :: GettableStateVar GLsizei+nameStackDepth = makeGettableStateVar (getSizei1 id GetNameStackDepth)
Graphics/Rendering/OpenGL/GL/Shaders.hs view
@@ -1,32 +1,32 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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
Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs view
@@ -1,61 +1,61 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Attribs
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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 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.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Attribs+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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 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.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs view
@@ -1,80 +1,80 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Limits
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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 Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
--- | 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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Limits+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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 Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++-- | 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
Graphics/Rendering/OpenGL/GL/Shaders/Program.hs view
@@ -1,114 +1,114 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Program
--- Copyright   :  (c) Sven Panne 2013
--- 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 Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype Program = Program { programID :: GLuint }
-   deriving ( Eq, Ord, Show )
-
-instance ObjectName Program where
-   isObjectName = fmap unmarshalGLboolean . glIsProgram . programID
-   deleteObjectName = glDeleteProgram . 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
-   | ComputeLocalWorkSize  -- 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
-   ComputeLocalWorkSize -> gl_COMPUTE_LOCAL_WORK_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 $
-      alloca $ \buf -> do
-         glGetProgramiv (programID program) (marshalGetProgramPName p) buf
-         f buf
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Program+-- Copyright   :  (c) Sven Panne 2013+-- 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 Foreign.Marshal.Alloc+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype Program = Program { programID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName Program where+   isObjectName = fmap unmarshalGLboolean . glIsProgram . programID+   deleteObjectName = glDeleteProgram . 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+   | ComputeLocalWorkSize  -- 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+   ComputeLocalWorkSize -> gl_COMPUTE_LOCAL_WORK_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 $+      alloca $ \buf -> do+         glGetProgramiv (programID program) (marshalGetProgramPName p) buf+         f buf
Graphics/Rendering/OpenGL/GL/Shaders/ProgramBinaries.hs view
@@ -1,63 +1,63 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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 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.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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 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.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Shaders/ProgramObjects.hs view
@@ -1,163 +1,163 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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 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.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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 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.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Shaders/Shader.hs view
@@ -1,31 +1,31 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Shader
--- Copyright   :  (c) Sven Panne 2013
--- 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 Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype Shader = Shader { shaderID :: GLuint }
-   deriving ( Eq, Ord, Show )
-
-instance ObjectName Shader where
-   isObjectName = fmap unmarshalGLboolean . glIsShader . shaderID
-   deleteObjectName = glDeleteShader . shaderID
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Shader+-- Copyright   :  (c) Sven Panne 2013+-- 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 Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype Shader = Shader { shaderID :: GLuint }+   deriving ( Eq, Ord, Show )++instance ObjectName Shader where+   isObjectName = fmap unmarshalGLboolean . glIsShader . shaderID+   deleteObjectName = glDeleteShader . shaderID
Graphics/Rendering/OpenGL/GL/Shaders/ShaderBinaries.hs view
@@ -1,47 +1,47 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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 Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.ByteString
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Shaders.Shader
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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 Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.ByteString+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Shader+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Shaders/ShaderObjects.hs view
@@ -1,194 +1,194 @@-{-# LANGUAGE FlexibleInstances #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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
-) where
-
-import Control.Monad
-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.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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 'shaderSourceBS' 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 $
-      alloca $ \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)
+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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+) where++import Control.Monad+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.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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 'shaderSourceBS' 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 $+      alloca $ \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)
Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs view
@@ -1,210 +1,210 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Uniform
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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).
---
------------------------------------------------------------------------------
-
-{-# LANGUAGE TypeSynonymInstances #-}
-
-module Graphics.Rendering.OpenGL.GL.Shaders.Uniform (
-   -- * Uniform variables
-   UniformLocation(..), uniformLocation, activeUniforms, Uniform(..),
-   UniformComponent,
-
-   -- TODO: glGetUniformSubroutineuiv
-) where
-
-import Data.Maybe
-import Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.ByteString
-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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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) => Program -> UniformLocation -> Ptr (b a) -> IO ()
-
-   uniform1v :: UniformLocation -> GLsizei -> Ptr a -> IO ()
-   uniform2v :: UniformLocation -> GLsizei -> Ptr a -> IO ()
-   uniform3v :: UniformLocation -> GLsizei -> Ptr a -> IO ()
-   uniform4v :: UniformLocation -> GLsizei -> Ptr a -> IO ()
-
-instance UniformComponent GLint where
-   uniform1 (UniformLocation ul) = glUniform1i ul
-   uniform2 (UniformLocation ul) = glUniform2i ul
-   uniform3 (UniformLocation ul) = glUniform3i ul
-   uniform4 (UniformLocation ul) = glUniform4i ul
-
-   getUniform (Program p) (UniformLocation ul) = glGetUniformiv p ul . castPtr
-
-   uniform1v (UniformLocation ul) = glUniform1iv ul
-   uniform2v (UniformLocation ul) = glUniform2iv ul
-   uniform3v (UniformLocation ul) = glUniform3iv ul
-   uniform4v (UniformLocation ul) = glUniform4iv ul
-
-instance UniformComponent GLuint where
-   uniform1 (UniformLocation ul) = glUniform1ui ul
-   uniform2 (UniformLocation ul) = glUniform2ui ul
-   uniform3 (UniformLocation ul) = glUniform3ui ul
-   uniform4 (UniformLocation ul) = glUniform4ui ul
-
-   getUniform (Program p) (UniformLocation ul) = glGetUniformuiv p ul . castPtr
-
-   uniform1v (UniformLocation ul) = glUniform1uiv ul
-   uniform2v (UniformLocation ul) = glUniform2uiv ul
-   uniform3v (UniformLocation ul) = glUniform3uiv ul
-   uniform4v (UniformLocation ul) = glUniform4uiv ul
-
-instance UniformComponent GLfloat where
-   uniform1 (UniformLocation ul) = glUniform1f ul
-   uniform2 (UniformLocation ul) = glUniform2f ul
-   uniform3 (UniformLocation ul) = glUniform3f ul
-   uniform4 (UniformLocation ul) = glUniform4f ul
-
-   getUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr
-
-   uniform1v (UniformLocation ul) = glUniform1fv ul
-   uniform2v (UniformLocation ul) = glUniform2fv ul
-   uniform3v (UniformLocation ul) = glUniform3fv ul
-   uniform4v (UniformLocation ul) = glUniform4fv ul
-
---------------------------------------------------------------------------------
-
-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 <- fmap fromJust $ get currentProgram
-            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)
-
--- 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@(UniformLocation ul)  = makeStateVar getter setter
-        where setter (TextureUnit tu) = uniform1 loc (fromIntegral tu :: GLint)
-              getter = do
-                 program <- fmap fromJust $ get currentProgram
-                 allocaBytes (sizeOf (undefined :: GLint))  $ \buf -> do
-                 glGetUniformiv (programID program) ul buf
-                 tuID <- peek buf
-                 return . TextureUnit $ fromIntegral tuID
-    uniformv location count = uniform1v location count . (castPtr :: Ptr TextureUnit -> Ptr GLint)
-
---------------------------------------------------------------------------------
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Uniform+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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).+--+-----------------------------------------------------------------------------++{-# LANGUAGE TypeSynonymInstances #-}++module Graphics.Rendering.OpenGL.GL.Shaders.Uniform (+   -- * Uniform variables+   UniformLocation(..), uniformLocation, activeUniforms, Uniform(..),+   UniformComponent,++   -- TODO: glGetUniformSubroutineuiv+) where++import Data.Maybe+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.ByteString+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.StateVar+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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) => Program -> UniformLocation -> Ptr (b a) -> IO ()++   uniform1v :: UniformLocation -> GLsizei -> Ptr a -> IO ()+   uniform2v :: UniformLocation -> GLsizei -> Ptr a -> IO ()+   uniform3v :: UniformLocation -> GLsizei -> Ptr a -> IO ()+   uniform4v :: UniformLocation -> GLsizei -> Ptr a -> IO ()++instance UniformComponent GLint where+   uniform1 (UniformLocation ul) = glUniform1i ul+   uniform2 (UniformLocation ul) = glUniform2i ul+   uniform3 (UniformLocation ul) = glUniform3i ul+   uniform4 (UniformLocation ul) = glUniform4i ul++   getUniform (Program p) (UniformLocation ul) = glGetUniformiv p ul . castPtr++   uniform1v (UniformLocation ul) = glUniform1iv ul+   uniform2v (UniformLocation ul) = glUniform2iv ul+   uniform3v (UniformLocation ul) = glUniform3iv ul+   uniform4v (UniformLocation ul) = glUniform4iv ul++instance UniformComponent GLuint where+   uniform1 (UniformLocation ul) = glUniform1ui ul+   uniform2 (UniformLocation ul) = glUniform2ui ul+   uniform3 (UniformLocation ul) = glUniform3ui ul+   uniform4 (UniformLocation ul) = glUniform4ui ul++   getUniform (Program p) (UniformLocation ul) = glGetUniformuiv p ul . castPtr++   uniform1v (UniformLocation ul) = glUniform1uiv ul+   uniform2v (UniformLocation ul) = glUniform2uiv ul+   uniform3v (UniformLocation ul) = glUniform3uiv ul+   uniform4v (UniformLocation ul) = glUniform4uiv ul++instance UniformComponent GLfloat where+   uniform1 (UniformLocation ul) = glUniform1f ul+   uniform2 (UniformLocation ul) = glUniform2f ul+   uniform3 (UniformLocation ul) = glUniform3f ul+   uniform4 (UniformLocation ul) = glUniform4f ul++   getUniform (Program p) (UniformLocation ul) = glGetUniformfv p ul . castPtr++   uniform1v (UniformLocation ul) = glUniform1fv ul+   uniform2v (UniformLocation ul) = glUniform2fv ul+   uniform3v (UniformLocation ul) = glUniform3fv ul+   uniform4v (UniformLocation ul) = glUniform4fv ul++--------------------------------------------------------------------------------++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 <- fmap fromJust $ get currentProgram+            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)++-- 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@(UniformLocation ul)  = makeStateVar getter setter+        where setter (TextureUnit tu) = uniform1 loc (fromIntegral tu :: GLint)+              getter = do+                 program <- fmap fromJust $ get currentProgram+                 allocaBytes (sizeOf (undefined :: GLint))  $ \buf -> do+                 glGetUniformiv (programID program) ul buf+                 tuID <- peek buf+                 return . TextureUnit $ fromIntegral tuID+    uniformv location count = uniform1v location count . (castPtr :: Ptr TextureUnit -> Ptr GLint)++--------------------------------------------------------------------------------
Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs view
@@ -1,163 +1,163 @@-{-# OPTIONS_HADDOCK hide #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Variables
--- Copyright   :  (c) Sven Panne 2006-2013
--- 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 Foreign.Marshal.Alloc
-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.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- 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)
-      alloca $ \nameLengthBuf ->
-         alloca $ \sizeBuf ->
-            alloca $ \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)
+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Shaders.Variables+-- Copyright   :  (c) Sven Panne 2006-2013+-- 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 Foreign.Marshal.Alloc+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.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- 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)+      alloca $ \nameLengthBuf ->+         alloca $ \sizeBuf ->+            alloca $ \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)
Graphics/Rendering/OpenGL/GL/StateVar.hs view
@@ -1,145 +1,145 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.StateVar
--- Copyright   :  (c) Sven Panne 2013
--- License     :  BSD3
--- 
--- Maintainer  :  Sven Panne <svenpanne@gmail.com>
--- Stability   :  stable
--- Portability :  portable
---
--- State variables are references in the IO monad, like 'IORef's or parts of
--- the OpenGL state. Note that state variables are not neccessarily writable or
--- readable, they may come in read-only or write-only flavours, too. As a very
--- simple example for a state variable, consider an explicitly allocated memory
--- buffer. This buffer can easily be converted into a 'StateVar':
---
--- @
--- makeStateVarFromPtr :: Storable a => Ptr a -> StateVar a
--- makeStateVarFromPtr p = makeStateVar (peek p) (poke p)
--- @
---
--- The example below puts 11 into a state variable (i.e. into the buffer),
--- increments the contents of the state variable by 22, and finally prints the
--- resulting content:
---
--- @
---   do p <- malloc :: IO (Ptr Int)
---      let v = makeStateVarFromPtr p
---      v $= 11
---      v $~ (+ 22)
---      x <- get v
---      print x
--- @
---
--- 'IORef's are state variables, too, so an example with them looks extremely
--- similiar:
---
--- @
---   do v <- newIORef (0 :: Int)
---      v $= 11
---      v $~ (+ 22)
---      x <- get v
---      print x
--- @
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.StateVar (
-   -- * Readable State Variables
-   HasGetter(..),
-   GettableStateVar, makeGettableStateVar,
-   -- * Writable State Variables
-   HasSetter(..),
-   SettableStateVar, makeSettableStateVar,
-   -- * General State Variables
-   StateVar, makeStateVar,
-   -- * Utility Functions
-   ($~), ($=!), ($~!)
-) where
-
-import Data.IORef ( IORef, readIORef, writeIORef )
-
---------------------------------------------------------------------------------
-
-infixr 2 $=
-
---------------------------------------------------------------------------------
-
--- | The class of all readable state variables.
-class HasGetter g where
-   -- | Read the value of a state variable.
-   get :: g a -> IO a
-
-instance HasGetter IORef where
-   get = readIORef
-
--- | A concrete implementation of a read-only state variable, carrying an IO
--- action to read the value.
-newtype GettableStateVar a = GettableStateVar (IO a)
-
-instance HasGetter GettableStateVar where
-   get (GettableStateVar g) = g
-
--- | Construct a 'GettableStateVar' from an IO action.
-makeGettableStateVar :: IO a -> GettableStateVar a
-makeGettableStateVar = GettableStateVar
-
---------------------------------------------------------------------------------
-
--- | The class of all writable state variables.
-class HasSetter s where
-   -- | Write a new value into a state variable.
-   ($=) :: s a -> a -> IO ()
-
-instance HasSetter IORef where
-   ($=) = writeIORef
-
--- | A concrete implementation of a write-only state variable, carrying an IO
--- action to write the new value.
-newtype SettableStateVar a = SettableStateVar (a -> IO ())
-
-instance HasSetter SettableStateVar where
-   ($=) (SettableStateVar s) a = s a
-
--- | Construct a 'SettableStateVar' from an IO action.
-makeSettableStateVar :: (a -> IO ()) -> SettableStateVar a
-makeSettableStateVar = SettableStateVar
-
---------------------------------------------------------------------------------
-
--- | A concrete implementation of a readable and writable state variable,
--- carrying one IO action to read the value and another IO action to write the
--- new value.
-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
-
--- | Construct a 'StateVar' from two IO actions, one for reading and one for
--- writing.
-makeStateVar :: IO a -> (a -> IO ()) -> StateVar a
-makeStateVar g s = StateVar (makeGettableStateVar g) (makeSettableStateVar s)
-
---------------------------------------------------------------------------------
-
--- | A modificator convenience function, transforming the contents of a state
--- variable with a given funtion.
-
-($~) :: (HasGetter v, HasSetter v) => v a -> (a -> a) -> IO ()
-v $~ f = do
-   x <- get v
-   v $= f x
-
--- | A variant of '$=' which is strict in the value to be set.
-($=!) :: HasSetter s => s a -> a -> IO ()
-v $=! x = x `seq` v $= x
-
--- | A variant of '$~' which is strict in the transformed value.
-($~!) :: (HasGetter v, HasSetter v) => v a -> (a -> a) -> IO ()
-v $~! f = do
-   x <- get v
-   v $=! f x
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.StateVar+-- Copyright   :  (c) Sven Panne 2013+-- License     :  BSD3+-- +-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- State variables are references in the IO monad, like 'IORef's or parts of+-- the OpenGL state. Note that state variables are not neccessarily writable or+-- readable, they may come in read-only or write-only flavours, too. As a very+-- simple example for a state variable, consider an explicitly allocated memory+-- buffer. This buffer can easily be converted into a 'StateVar':+--+-- @+-- makeStateVarFromPtr :: Storable a => Ptr a -> StateVar a+-- makeStateVarFromPtr p = makeStateVar (peek p) (poke p)+-- @+--+-- The example below puts 11 into a state variable (i.e. into the buffer),+-- increments the contents of the state variable by 22, and finally prints the+-- resulting content:+--+-- @+--   do p <- malloc :: IO (Ptr Int)+--      let v = makeStateVarFromPtr p+--      v $= 11+--      v $~ (+ 22)+--      x <- get v+--      print x+-- @+--+-- 'IORef's are state variables, too, so an example with them looks extremely+-- similiar:+--+-- @+--   do v <- newIORef (0 :: Int)+--      v $= 11+--      v $~ (+ 22)+--      x <- get v+--      print x+-- @+--------------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.StateVar (+   -- * Readable State Variables+   HasGetter(..),+   GettableStateVar, makeGettableStateVar,+   -- * Writable State Variables+   HasSetter(..),+   SettableStateVar, makeSettableStateVar,+   -- * General State Variables+   StateVar, makeStateVar,+   -- * Utility Functions+   ($~), ($=!), ($~!)+) where++import Data.IORef ( IORef, readIORef, writeIORef )++--------------------------------------------------------------------------------++infixr 2 $=++--------------------------------------------------------------------------------++-- | The class of all readable state variables.+class HasGetter g where+   -- | Read the value of a state variable.+   get :: g a -> IO a++instance HasGetter IORef where+   get = readIORef++-- | A concrete implementation of a read-only state variable, carrying an IO+-- action to read the value.+newtype GettableStateVar a = GettableStateVar (IO a)++instance HasGetter GettableStateVar where+   get (GettableStateVar g) = g++-- | Construct a 'GettableStateVar' from an IO action.+makeGettableStateVar :: IO a -> GettableStateVar a+makeGettableStateVar = GettableStateVar++--------------------------------------------------------------------------------++-- | The class of all writable state variables.+class HasSetter s where+   -- | Write a new value into a state variable.+   ($=) :: s a -> a -> IO ()++instance HasSetter IORef where+   ($=) = writeIORef++-- | A concrete implementation of a write-only state variable, carrying an IO+-- action to write the new value.+newtype SettableStateVar a = SettableStateVar (a -> IO ())++instance HasSetter SettableStateVar where+   ($=) (SettableStateVar s) a = s a++-- | Construct a 'SettableStateVar' from an IO action.+makeSettableStateVar :: (a -> IO ()) -> SettableStateVar a+makeSettableStateVar = SettableStateVar++--------------------------------------------------------------------------------++-- | A concrete implementation of a readable and writable state variable,+-- carrying one IO action to read the value and another IO action to write the+-- new value.+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++-- | Construct a 'StateVar' from two IO actions, one for reading and one for+-- writing.+makeStateVar :: IO a -> (a -> IO ()) -> StateVar a+makeStateVar g s = StateVar (makeGettableStateVar g) (makeSettableStateVar s)++--------------------------------------------------------------------------------++-- | A modificator convenience function, transforming the contents of a state+-- variable with a given funtion.++($~) :: (HasGetter v, HasSetter v) => v a -> (a -> a) -> IO ()+v $~ f = do+   x <- get v+   v $= f x++-- | A variant of '$=' which is strict in the value to be set.+($=!) :: HasSetter s => s a -> a -> IO ()+v $=! x = x `seq` v $= x++-- | A variant of '$~' which is strict in the transformed value.+($~!) :: (HasGetter v, HasSetter v) => v a -> (a -> a) -> IO ()+v $~! f = do+   x <- get v+   v $=! f x
Graphics/Rendering/OpenGL/GL/StringQueries.hs view
@@ -1,88 +1,88 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.StringQueries
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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, shadingLanguageVersion,
-   majorMinor, ContextProfile'(..), contextProfile
-) where
-
-import Data.Bits
-import Data.Char
-import Foreign.C.String
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-vendor :: GettableStateVar String
-vendor = makeGettableStateVar (getString gl_VENDOR)
-
-renderer :: GettableStateVar String
-renderer = makeGettableStateVar (getString gl_RENDERER)
-
-glVersion :: GettableStateVar String
-glVersion = makeGettableStateVar (getString gl_VERSION)
-
-glExtensions :: GettableStateVar [String]
-glExtensions = makeGettableStateVar (fmap words $ getString gl_EXTENSIONS)
-
-shadingLanguageVersion :: GettableStateVar String
-shadingLanguageVersion = makeGettableStateVar (getString gl_SHADING_LANGUAGE_VERSION)
-
---------------------------------------------------------------------------------
-
-data ContextProfile'
-   = CoreProfile'
-   | CompatibilityProfile'
-   deriving ( Eq, Ord, Show )
-
-marshalContextProfile' :: ContextProfile' -> 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 ]
-
---------------------------------------------------------------------------------
-
-getString :: GLenum -> IO String
-getString n = glGetString n >>= maybeNullPtr (return "") (peekCString . castPtr)
-
---------------------------------------------------------------------------------
-
--- | A utility function to be used with e.g. 'glVersion' or
--- 'shadingLanguageVersion', transforming a variable containing a string of the
--- form /major.minor[optional rest]/ into a variable containing a numeric
--- major\/minor version. If the string is malformed, which should never happen
--- with a sane OpenGL implementation, it is transformed to @(-1,-1)@.
-
-majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)
-majorMinor = makeGettableStateVar . fmap parse . get
-   where defaultVersion = (-1, -1)
-         parse str =
-            case span isDigit str of
-               (major@(_:_), '.':rest) ->
-                  case span isDigit rest of
-                     (minor@(_:_), _) -> (read major, read minor)
-                     _ -> defaultVersion
-               _ -> defaultVersion
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.StringQueries+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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, shadingLanguageVersion,+   majorMinor, ContextProfile'(..), contextProfile+) where++import Data.Bits+import Data.Char+import Foreign.C.String+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++vendor :: GettableStateVar String+vendor = makeGettableStateVar (getString gl_VENDOR)++renderer :: GettableStateVar String+renderer = makeGettableStateVar (getString gl_RENDERER)++glVersion :: GettableStateVar String+glVersion = makeGettableStateVar (getString gl_VERSION)++glExtensions :: GettableStateVar [String]+glExtensions = makeGettableStateVar (fmap words $ getString gl_EXTENSIONS)++shadingLanguageVersion :: GettableStateVar String+shadingLanguageVersion = makeGettableStateVar (getString gl_SHADING_LANGUAGE_VERSION)++--------------------------------------------------------------------------------++data ContextProfile'+   = CoreProfile'+   | CompatibilityProfile'+   deriving ( Eq, Ord, Show )++marshalContextProfile' :: ContextProfile' -> 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 ]++--------------------------------------------------------------------------------++getString :: GLenum -> IO String+getString n = glGetString n >>= maybeNullPtr (return "") (peekCString . castPtr)++--------------------------------------------------------------------------------++-- | A utility function to be used with e.g. 'glVersion' or+-- 'shadingLanguageVersion', transforming a variable containing a string of the+-- form /major.minor[optional rest]/ into a variable containing a numeric+-- major\/minor version. If the string is malformed, which should never happen+-- with a sane OpenGL implementation, it is transformed to @(-1,-1)@.++majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)+majorMinor = makeGettableStateVar . fmap parse . get+   where defaultVersion = (-1, -1)+         parse str =+            case span isDigit str of+               (major@(_:_), '.':rest) ->+                  case span isDigit rest of+                     (minor@(_:_), _) -> (read major, read minor)+                     _ -> defaultVersion+               _ -> defaultVersion
Graphics/Rendering/OpenGL/GL/SyncObjects.hs view
@@ -1,113 +1,113 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.SyncObjects
--- Copyright   :  (c) Sven Panne 2013
--- 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 Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype SyncObject = SyncObject { syncID :: GLsync }
-   deriving ( Eq, Ord, Show )
-
-instance ObjectName SyncObject where
-   isObjectName = fmap unmarshalGLboolean . glIsSync . syncID
-   deleteObjectName = glDeleteSync . 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 $
-      alloca $ \buf -> do
-         glGetSynciv (syncID syncObject) gl_SYNC_STATUS 1 nullPtr buf
-         peek1 (unmarshalSyncStatus . fromIntegral) buf
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.SyncObjects+-- Copyright   :  (c) Sven Panne 2013+-- 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 Foreign.Marshal.Alloc+import Foreign.Ptr+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype SyncObject = SyncObject { syncID :: GLsync }+   deriving ( Eq, Ord, Show )++instance ObjectName SyncObject where+   isObjectName = fmap unmarshalGLboolean . glIsSync . syncID+   deleteObjectName = glDeleteSync . 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 $+      alloca $ \buf -> do+         glGetSynciv (syncID syncObject) gl_SYNC_STATUS 1 nullPtr buf+         peek1 (unmarshalSyncStatus . fromIntegral) buf
Graphics/Rendering/OpenGL/GL/Tensor.hs view
@@ -1,299 +1,299 @@-{-# LANGUAGE DeriveDataTypeable #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Tensor
--- Copyright   :  (c) Sven Panne 2013
--- 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
-
-import Control.Applicative
-import Control.Monad
-import Data.Foldable
-import Data.Ix
-import Data.Traversable
-import Data.Typeable
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-
---------------------------------------------------------------------------------
-
--- | 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
+{-# LANGUAGE DeriveDataTypeable #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Tensor+-- Copyright   :  (c) Sven Panne 2013+-- 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++import Control.Applicative+import Control.Monad+import Data.Foldable+import Data.Ix+import Data.Traversable+import Data.Typeable+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable++--------------------------------------------------------------------------------++-- | 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
Graphics/Rendering/OpenGL/GL/Texturing.hs view
@@ -1,29 +1,29 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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
Graphics/Rendering/OpenGL/GL/Texturing/Application.hs view
@@ -1,27 +1,27 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Application
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-
---------------------------------------------------------------------------------
-
-texture :: ParameterizedTextureTarget t => t -> StateVar Capability
-texture = makeCapability . marshalParameterizedTextureTargetEnableCap
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Application+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget++--------------------------------------------------------------------------------++texture :: ParameterizedTextureTarget t => t -> StateVar Capability+texture = makeCapability . marshalParameterizedTextureTargetEnableCap
Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs view
@@ -1,353 +1,353 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Environments
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.Parameters
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data TextureEnvTarget =
-     TextureEnv
-   | TextureFilterControl   -- GL_TEXTURE_LOD_BIAS_EXT
-   | PointSprite            -- GL_COORD_REPLACE_NV
-
-marshalTextureEnvTarget :: TextureEnvTarget -> GLenum
-marshalTextureEnvTarget x = case x of
-   TextureEnv -> gl_TEXTURE_ENV
-   TextureFilterControl -> gl_TEXTURE_FILTER_CONTROL
-   PointSprite -> gl_POINT_SPRITE
-
---------------------------------------------------------------------------------
-
-data TextureEnvParameter =
-     TexEnvParamTextureEnvMode
-   | TexEnvParamTextureEnvColor
-   | TexEnvParamCombineRGB
-   | TexEnvParamCombineAlpha
-   | TexEnvParamSrc0RGB
-   | TexEnvParamSrc1RGB
-   | TexEnvParamSrc2RGB
-   | TexEnvParamSrc3RGB
-   | TexEnvParamSrc0Alpha
-   | TexEnvParamSrc1Alpha
-   | TexEnvParamSrc2Alpha
-   | TexEnvParamSrc3Alpha
-   | TexEnvParamOperand0RGB
-   | TexEnvParamOperand1RGB
-   | TexEnvParamOperand2RGB
-   | TexEnvParamOperand3RGB
-   | TexEnvParamOperand0Alpha
-   | TexEnvParamOperand1Alpha
-   | TexEnvParamOperand2Alpha
-   | TexEnvParamOperand3Alpha
-   | TexEnvParamRGBScale
-   | TexEnvParamAlphaScale
-   | TexEnvParamLODBias
-
-marshalTextureEnvParameter :: TextureEnvParameter -> GLenum
-marshalTextureEnvParameter x = case x of
-   TexEnvParamTextureEnvMode -> gl_TEXTURE_ENV_MODE
-   TexEnvParamTextureEnvColor -> gl_TEXTURE_ENV_COLOR
-   TexEnvParamCombineRGB -> gl_COMBINE_RGB
-   TexEnvParamCombineAlpha -> gl_COMBINE_ALPHA
-   TexEnvParamSrc0RGB -> gl_SRC0_RGB
-   TexEnvParamSrc1RGB -> gl_SRC1_RGB
-   TexEnvParamSrc2RGB -> gl_SRC2_RGB
-   TexEnvParamSrc3RGB -> gl_SOURCE3_RGB
-   TexEnvParamSrc0Alpha -> gl_SRC0_ALPHA
-   TexEnvParamSrc1Alpha -> gl_SRC1_ALPHA
-   TexEnvParamSrc2Alpha -> gl_SRC2_ALPHA
-   TexEnvParamSrc3Alpha -> gl_SOURCE3_ALPHA
-   TexEnvParamOperand0RGB -> gl_OPERAND0_RGB
-   TexEnvParamOperand1RGB -> gl_OPERAND1_RGB
-   TexEnvParamOperand2RGB -> gl_OPERAND2_RGB
-   TexEnvParamOperand3RGB -> gl_OPERAND3_RGB
-   TexEnvParamOperand0Alpha -> gl_OPERAND0_ALPHA
-   TexEnvParamOperand1Alpha -> gl_OPERAND1_ALPHA
-   TexEnvParamOperand2Alpha -> gl_OPERAND2_ALPHA
-   TexEnvParamOperand3Alpha -> gl_OPERAND3_ALPHA
-   TexEnvParamRGBScale -> gl_RGB_SCALE
-   TexEnvParamAlphaScale -> gl_ALPHA_SCALE
-   TexEnvParamLODBias -> gl_TEXTURE_LOD_BIAS
-
---------------------------------------------------------------------------------
-
-texEnv :: (GLenum -> GLenum -> b -> IO ())
-       -> (a -> (b -> IO ()) -> IO ())
-       -> TextureEnvTarget -> TextureEnvParameter -> a -> IO ()
-texEnv glTexEnv marshalAct t p x =
-   marshalAct x $
-      glTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p)
-
-glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glTexEnvC4f t p ptr = glTexEnvfv t p (castPtr ptr)
-
-
---------------------------------------------------------------------------------
-
-getTexEnv :: Storable b
-          => (GLenum -> GLenum -> Ptr b -> IO ())
-          -> (b -> a)
-          -> TextureEnvTarget -> TextureEnvParameter -> IO a
-getTexEnv glGetTexEnv unmarshal t p =
-   alloca $ \buf -> do
-     glGetTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p) buf
-     peek1 unmarshal buf
-
-glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glGetTexEnvC4f t p ptr = glGetTexEnvfv t p (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()
-m2a marshal x act = act (marshal x)
-
-texEnvi ::
-   (GLint -> a) -> (a -> GLint) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a
-texEnvi unmarshal marshal t p =
-   makeStateVar
-      (getTexEnv glGetTexEnviv unmarshal     t p)
-      (texEnv    glTexEnvi     (m2a marshal) t p)
-
-texEnvf ::
-   (GLfloat -> a) -> (a -> GLfloat) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a
-texEnvf unmarshal marshal t p =
-   makeStateVar
-      (getTexEnv glGetTexEnvfv unmarshal     t p)
-      (texEnv    glTexEnvf     (m2a marshal) t p)
-
-texEnvC4f :: TextureEnvTarget -> TextureEnvParameter -> StateVar (Color4 GLfloat)
-texEnvC4f t p =
-   makeStateVar
-      (getTexEnv glGetTexEnvC4f id   t p)
-      (texEnv    glTexEnvC4f    with t p)
-
---------------------------------------------------------------------------------
-
-data TextureFunction =
-     Modulate
-   | Decal
-   | Blend
-   | Replace
-   | AddUnsigned
-   | Combine
-   | Combine4
-   deriving ( Eq, Ord, Show )
-
-marshalTextureFunction :: TextureFunction -> GLint
-marshalTextureFunction x = fromIntegral $ case x of
-   Modulate -> gl_MODULATE
-   Decal -> gl_DECAL
-   Blend -> gl_BLEND
-   Replace -> gl_REPLACE
-   AddUnsigned -> gl_ADD
-   Combine -> gl_COMBINE
-   Combine4 -> gl_COMBINE4
-
-unmarshalTextureFunction :: GLint -> TextureFunction
-unmarshalTextureFunction x
-   | y == gl_MODULATE = Modulate
-   | y == gl_DECAL = Decal
-   | y == gl_BLEND = Blend
-   | y == gl_REPLACE = Replace
-   | y == gl_ADD = AddUnsigned
-   | y == gl_COMBINE = Combine
-   | y == gl_COMBINE4 = Combine4
-   | otherwise = error ("unmarshalTextureFunction: illegal value " ++ show x)
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-textureFunction :: StateVar TextureFunction
-textureFunction =
-   texEnvi unmarshalTextureFunction marshalTextureFunction TextureEnv TexEnvParamTextureEnvMode
-
---------------------------------------------------------------------------------
-
-data TextureCombineFunction =
-     Replace'
-   | Modulate'
-   | AddUnsigned'
-   | AddSigned
-   | Interpolate
-   | Subtract
-   | Dot3RGB
-   | Dot3RGBA
-   deriving ( Eq, Ord, Show )
-
-marshalTextureCombineFunction :: TextureCombineFunction -> GLint
-marshalTextureCombineFunction x = fromIntegral $ case x of
-   Replace' -> gl_REPLACE
-   Modulate' -> gl_MODULATE
-   AddUnsigned' -> gl_ADD
-   AddSigned -> gl_ADD_SIGNED
-   Interpolate -> gl_INTERPOLATE
-   Subtract -> gl_SUBTRACT
-   Dot3RGB -> gl_DOT3_RGB
-   Dot3RGBA -> gl_DOT3_RGBA
-
-unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction
-unmarshalTextureCombineFunction x
-   | y == gl_REPLACE = Replace'
-   | y == gl_MODULATE = Modulate'
-   | y == gl_ADD = AddUnsigned'
-   | y == gl_ADD_SIGNED = AddSigned
-   | y == gl_INTERPOLATE = Interpolate
-   | y == gl_SUBTRACT = Subtract
-   | y == gl_DOT3_RGB = Dot3RGB
-   | y == gl_DOT3_RGBA = Dot3RGBA
-   | otherwise = error ("unmarshalTextureCombineFunction: illegal value " ++ show x)
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-combineRGB :: StateVar TextureCombineFunction
-combineRGB = combine TexEnvParamCombineRGB
-
-combineAlpha :: StateVar TextureCombineFunction
-combineAlpha = combine TexEnvParamCombineAlpha
-
-combine :: TextureEnvParameter -> StateVar TextureCombineFunction
-combine =
-   texEnvi unmarshalTextureCombineFunction marshalTextureCombineFunction TextureEnv
-
---------------------------------------------------------------------------------
-
-data ArgNum =
-     Arg0
-   | Arg1
-   | Arg2
-   | Arg3
-   deriving ( Eq, Ord, Show )
-
-argNumToOperandRGB :: ArgNum -> TextureEnvParameter
-argNumToOperandRGB x = case x of
-   Arg0 -> TexEnvParamOperand0RGB
-   Arg1 -> TexEnvParamOperand1RGB
-   Arg2 -> TexEnvParamOperand2RGB
-   Arg3 -> TexEnvParamOperand3RGB
-
-argNumToOperandAlpha :: ArgNum -> TextureEnvParameter
-argNumToOperandAlpha x = case x of
-   Arg0 -> TexEnvParamOperand0Alpha
-   Arg1 -> TexEnvParamOperand1Alpha
-   Arg2 -> TexEnvParamOperand2Alpha
-   Arg3 -> TexEnvParamOperand3Alpha
-
-argNumToSrcRGB :: ArgNum -> TextureEnvParameter
-argNumToSrcRGB x = case x of
-   Arg0 -> TexEnvParamSrc0RGB
-   Arg1 -> TexEnvParamSrc1RGB
-   Arg2 -> TexEnvParamSrc2RGB
-   Arg3 -> TexEnvParamSrc3RGB
-
-argNumToSrcAlpha :: ArgNum -> TextureEnvParameter
-argNumToSrcAlpha x = case x of
-   Arg0 -> TexEnvParamSrc0Alpha
-   Arg1 -> TexEnvParamSrc1Alpha
-   Arg2 -> TexEnvParamSrc2Alpha
-   Arg3 -> TexEnvParamSrc3Alpha
-
---------------------------------------------------------------------------------
-
-data Arg = Arg BlendingFactor Src
-   deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-data Src =
-     CurrentUnit
-   | Previous
-   | Crossbar TextureUnit
-   | Constant
-   | PrimaryColor
-   deriving ( Eq, Ord, Show )
-
-marshalSrc :: Src -> GLint
-marshalSrc x = fromIntegral $ case x of
-   CurrentUnit -> gl_TEXTURE
-   Previous -> gl_PREVIOUS
-   Crossbar u -> fromIntegral (marshalTextureUnit u)
-   Constant -> gl_CONSTANT
-   PrimaryColor -> gl_PRIMARY_COLOR
-
-unmarshalSrc :: GLint -> Src
-unmarshalSrc x
-   | y == gl_TEXTURE = CurrentUnit
-   | y == gl_PREVIOUS = Previous
-   | y == gl_CONSTANT = Constant
-   | y == gl_PRIMARY_COLOR = PrimaryColor
-   | otherwise = Crossbar (unmarshalTextureUnit (fromIntegral x))
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-argRGB :: ArgNum -> StateVar Arg
-argRGB n = arg (argNumToOperandRGB n) (argNumToSrcRGB n)
-
-argAlpha :: ArgNum -> StateVar Arg
-argAlpha n = arg (argNumToOperandAlpha n) (argNumToSrcAlpha n)
-
-arg :: TextureEnvParameter -> TextureEnvParameter -> StateVar Arg
-arg op src = combineArg (textureEnvOperand op) (textureEnvSrc src)
-   where combineArg v w = makeStateVar
-                             (liftM2 Arg (get v) (get w))
-                             (\(Arg x y) -> do v $= x; w $= y)
-
-textureEnvOperand :: TextureEnvParameter -> StateVar BlendingFactor
-textureEnvOperand =
-   texEnvi (unmarshalBlendingFactor . fromIntegral) (fromIntegral . marshalBlendingFactor) TextureEnv
-
-textureEnvSrc :: TextureEnvParameter -> StateVar Src
-textureEnvSrc = texEnvi unmarshalSrc marshalSrc TextureEnv
-
---------------------------------------------------------------------------------
-
-rgbScale :: StateVar GLfloat
-rgbScale = scale TexEnvParamRGBScale
-
-alphaScale :: StateVar GLfloat
-alphaScale = scale TexEnvParamAlphaScale
-
-scale :: TextureEnvParameter -> StateVar GLfloat
-scale = texEnvf id id TextureEnv
-
---------------------------------------------------------------------------------
-
-constantColor :: StateVar (Color4 GLfloat)
-constantColor = texEnvC4f TextureEnv TexEnvParamTextureEnvColor
-
---------------------------------------------------------------------------------
-
-textureUnitLODBias :: StateVar LOD
-textureUnitLODBias = texEnvf id id TextureFilterControl TexEnvParamLODBias
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Environments+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.Parameters+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data TextureEnvTarget =+     TextureEnv+   | TextureFilterControl   -- GL_TEXTURE_LOD_BIAS_EXT+   | PointSprite            -- GL_COORD_REPLACE_NV++marshalTextureEnvTarget :: TextureEnvTarget -> GLenum+marshalTextureEnvTarget x = case x of+   TextureEnv -> gl_TEXTURE_ENV+   TextureFilterControl -> gl_TEXTURE_FILTER_CONTROL+   PointSprite -> gl_POINT_SPRITE++--------------------------------------------------------------------------------++data TextureEnvParameter =+     TexEnvParamTextureEnvMode+   | TexEnvParamTextureEnvColor+   | TexEnvParamCombineRGB+   | TexEnvParamCombineAlpha+   | TexEnvParamSrc0RGB+   | TexEnvParamSrc1RGB+   | TexEnvParamSrc2RGB+   | TexEnvParamSrc3RGB+   | TexEnvParamSrc0Alpha+   | TexEnvParamSrc1Alpha+   | TexEnvParamSrc2Alpha+   | TexEnvParamSrc3Alpha+   | TexEnvParamOperand0RGB+   | TexEnvParamOperand1RGB+   | TexEnvParamOperand2RGB+   | TexEnvParamOperand3RGB+   | TexEnvParamOperand0Alpha+   | TexEnvParamOperand1Alpha+   | TexEnvParamOperand2Alpha+   | TexEnvParamOperand3Alpha+   | TexEnvParamRGBScale+   | TexEnvParamAlphaScale+   | TexEnvParamLODBias++marshalTextureEnvParameter :: TextureEnvParameter -> GLenum+marshalTextureEnvParameter x = case x of+   TexEnvParamTextureEnvMode -> gl_TEXTURE_ENV_MODE+   TexEnvParamTextureEnvColor -> gl_TEXTURE_ENV_COLOR+   TexEnvParamCombineRGB -> gl_COMBINE_RGB+   TexEnvParamCombineAlpha -> gl_COMBINE_ALPHA+   TexEnvParamSrc0RGB -> gl_SRC0_RGB+   TexEnvParamSrc1RGB -> gl_SRC1_RGB+   TexEnvParamSrc2RGB -> gl_SRC2_RGB+   TexEnvParamSrc3RGB -> gl_SOURCE3_RGB+   TexEnvParamSrc0Alpha -> gl_SRC0_ALPHA+   TexEnvParamSrc1Alpha -> gl_SRC1_ALPHA+   TexEnvParamSrc2Alpha -> gl_SRC2_ALPHA+   TexEnvParamSrc3Alpha -> gl_SOURCE3_ALPHA+   TexEnvParamOperand0RGB -> gl_OPERAND0_RGB+   TexEnvParamOperand1RGB -> gl_OPERAND1_RGB+   TexEnvParamOperand2RGB -> gl_OPERAND2_RGB+   TexEnvParamOperand3RGB -> gl_OPERAND3_RGB+   TexEnvParamOperand0Alpha -> gl_OPERAND0_ALPHA+   TexEnvParamOperand1Alpha -> gl_OPERAND1_ALPHA+   TexEnvParamOperand2Alpha -> gl_OPERAND2_ALPHA+   TexEnvParamOperand3Alpha -> gl_OPERAND3_ALPHA+   TexEnvParamRGBScale -> gl_RGB_SCALE+   TexEnvParamAlphaScale -> gl_ALPHA_SCALE+   TexEnvParamLODBias -> gl_TEXTURE_LOD_BIAS++--------------------------------------------------------------------------------++texEnv :: (GLenum -> GLenum -> b -> IO ())+       -> (a -> (b -> IO ()) -> IO ())+       -> TextureEnvTarget -> TextureEnvParameter -> a -> IO ()+texEnv glTexEnv marshalAct t p x =+   marshalAct x $+      glTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p)++glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glTexEnvC4f t p ptr = glTexEnvfv t p (castPtr ptr)+++--------------------------------------------------------------------------------++getTexEnv :: Storable b+          => (GLenum -> GLenum -> Ptr b -> IO ())+          -> (b -> a)+          -> TextureEnvTarget -> TextureEnvParameter -> IO a+getTexEnv glGetTexEnv unmarshal t p =+   alloca $ \buf -> do+     glGetTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p) buf+     peek1 unmarshal buf++glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()+glGetTexEnvC4f t p ptr = glGetTexEnvfv t p (castPtr ptr)++--------------------------------------------------------------------------------++m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()+m2a marshal x act = act (marshal x)++texEnvi ::+   (GLint -> a) -> (a -> GLint) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a+texEnvi unmarshal marshal t p =+   makeStateVar+      (getTexEnv glGetTexEnviv unmarshal     t p)+      (texEnv    glTexEnvi     (m2a marshal) t p)++texEnvf ::+   (GLfloat -> a) -> (a -> GLfloat) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a+texEnvf unmarshal marshal t p =+   makeStateVar+      (getTexEnv glGetTexEnvfv unmarshal     t p)+      (texEnv    glTexEnvf     (m2a marshal) t p)++texEnvC4f :: TextureEnvTarget -> TextureEnvParameter -> StateVar (Color4 GLfloat)+texEnvC4f t p =+   makeStateVar+      (getTexEnv glGetTexEnvC4f id   t p)+      (texEnv    glTexEnvC4f    with t p)++--------------------------------------------------------------------------------++data TextureFunction =+     Modulate+   | Decal+   | Blend+   | Replace+   | AddUnsigned+   | Combine+   | Combine4+   deriving ( Eq, Ord, Show )++marshalTextureFunction :: TextureFunction -> GLint+marshalTextureFunction x = fromIntegral $ case x of+   Modulate -> gl_MODULATE+   Decal -> gl_DECAL+   Blend -> gl_BLEND+   Replace -> gl_REPLACE+   AddUnsigned -> gl_ADD+   Combine -> gl_COMBINE+   Combine4 -> gl_COMBINE4++unmarshalTextureFunction :: GLint -> TextureFunction+unmarshalTextureFunction x+   | y == gl_MODULATE = Modulate+   | y == gl_DECAL = Decal+   | y == gl_BLEND = Blend+   | y == gl_REPLACE = Replace+   | y == gl_ADD = AddUnsigned+   | y == gl_COMBINE = Combine+   | y == gl_COMBINE4 = Combine4+   | otherwise = error ("unmarshalTextureFunction: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++textureFunction :: StateVar TextureFunction+textureFunction =+   texEnvi unmarshalTextureFunction marshalTextureFunction TextureEnv TexEnvParamTextureEnvMode++--------------------------------------------------------------------------------++data TextureCombineFunction =+     Replace'+   | Modulate'+   | AddUnsigned'+   | AddSigned+   | Interpolate+   | Subtract+   | Dot3RGB+   | Dot3RGBA+   deriving ( Eq, Ord, Show )++marshalTextureCombineFunction :: TextureCombineFunction -> GLint+marshalTextureCombineFunction x = fromIntegral $ case x of+   Replace' -> gl_REPLACE+   Modulate' -> gl_MODULATE+   AddUnsigned' -> gl_ADD+   AddSigned -> gl_ADD_SIGNED+   Interpolate -> gl_INTERPOLATE+   Subtract -> gl_SUBTRACT+   Dot3RGB -> gl_DOT3_RGB+   Dot3RGBA -> gl_DOT3_RGBA++unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction+unmarshalTextureCombineFunction x+   | y == gl_REPLACE = Replace'+   | y == gl_MODULATE = Modulate'+   | y == gl_ADD = AddUnsigned'+   | y == gl_ADD_SIGNED = AddSigned+   | y == gl_INTERPOLATE = Interpolate+   | y == gl_SUBTRACT = Subtract+   | y == gl_DOT3_RGB = Dot3RGB+   | y == gl_DOT3_RGBA = Dot3RGBA+   | otherwise = error ("unmarshalTextureCombineFunction: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++combineRGB :: StateVar TextureCombineFunction+combineRGB = combine TexEnvParamCombineRGB++combineAlpha :: StateVar TextureCombineFunction+combineAlpha = combine TexEnvParamCombineAlpha++combine :: TextureEnvParameter -> StateVar TextureCombineFunction+combine =+   texEnvi unmarshalTextureCombineFunction marshalTextureCombineFunction TextureEnv++--------------------------------------------------------------------------------++data ArgNum =+     Arg0+   | Arg1+   | Arg2+   | Arg3+   deriving ( Eq, Ord, Show )++argNumToOperandRGB :: ArgNum -> TextureEnvParameter+argNumToOperandRGB x = case x of+   Arg0 -> TexEnvParamOperand0RGB+   Arg1 -> TexEnvParamOperand1RGB+   Arg2 -> TexEnvParamOperand2RGB+   Arg3 -> TexEnvParamOperand3RGB++argNumToOperandAlpha :: ArgNum -> TextureEnvParameter+argNumToOperandAlpha x = case x of+   Arg0 -> TexEnvParamOperand0Alpha+   Arg1 -> TexEnvParamOperand1Alpha+   Arg2 -> TexEnvParamOperand2Alpha+   Arg3 -> TexEnvParamOperand3Alpha++argNumToSrcRGB :: ArgNum -> TextureEnvParameter+argNumToSrcRGB x = case x of+   Arg0 -> TexEnvParamSrc0RGB+   Arg1 -> TexEnvParamSrc1RGB+   Arg2 -> TexEnvParamSrc2RGB+   Arg3 -> TexEnvParamSrc3RGB++argNumToSrcAlpha :: ArgNum -> TextureEnvParameter+argNumToSrcAlpha x = case x of+   Arg0 -> TexEnvParamSrc0Alpha+   Arg1 -> TexEnvParamSrc1Alpha+   Arg2 -> TexEnvParamSrc2Alpha+   Arg3 -> TexEnvParamSrc3Alpha++--------------------------------------------------------------------------------++data Arg = Arg BlendingFactor Src+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++data Src =+     CurrentUnit+   | Previous+   | Crossbar TextureUnit+   | Constant+   | PrimaryColor+   deriving ( Eq, Ord, Show )++marshalSrc :: Src -> GLint+marshalSrc x = fromIntegral $ case x of+   CurrentUnit -> gl_TEXTURE+   Previous -> gl_PREVIOUS+   Crossbar u -> fromIntegral (marshalTextureUnit u)+   Constant -> gl_CONSTANT+   PrimaryColor -> gl_PRIMARY_COLOR++unmarshalSrc :: GLint -> Src+unmarshalSrc x+   | y == gl_TEXTURE = CurrentUnit+   | y == gl_PREVIOUS = Previous+   | y == gl_CONSTANT = Constant+   | y == gl_PRIMARY_COLOR = PrimaryColor+   | otherwise = Crossbar (unmarshalTextureUnit (fromIntegral x))+   where y = fromIntegral x++--------------------------------------------------------------------------------++argRGB :: ArgNum -> StateVar Arg+argRGB n = arg (argNumToOperandRGB n) (argNumToSrcRGB n)++argAlpha :: ArgNum -> StateVar Arg+argAlpha n = arg (argNumToOperandAlpha n) (argNumToSrcAlpha n)++arg :: TextureEnvParameter -> TextureEnvParameter -> StateVar Arg+arg op src = combineArg (textureEnvOperand op) (textureEnvSrc src)+   where combineArg v w = makeStateVar+                             (liftM2 Arg (get v) (get w))+                             (\(Arg x y) -> do v $= x; w $= y)++textureEnvOperand :: TextureEnvParameter -> StateVar BlendingFactor+textureEnvOperand =+   texEnvi (unmarshalBlendingFactor . fromIntegral) (fromIntegral . marshalBlendingFactor) TextureEnv++textureEnvSrc :: TextureEnvParameter -> StateVar Src+textureEnvSrc = texEnvi unmarshalSrc marshalSrc TextureEnv++--------------------------------------------------------------------------------++rgbScale :: StateVar GLfloat+rgbScale = scale TexEnvParamRGBScale++alphaScale :: StateVar GLfloat+alphaScale = scale TexEnvParamAlphaScale++scale :: TextureEnvParameter -> StateVar GLfloat+scale = texEnvf id id TextureEnv++--------------------------------------------------------------------------------++constantColor :: StateVar (Color4 GLfloat)+constantColor = texEnvC4f TextureEnv TexEnvParamTextureEnvColor++--------------------------------------------------------------------------------++textureUnitLODBias :: StateVar LOD+textureUnitLODBias = texEnvf id id TextureFilterControl TexEnvParamLODBias
Graphics/Rendering/OpenGL/GL/Texturing/Filter.hs view
@@ -1,67 +1,67 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Filter
--- Copyright   :  (c) Sven Panne 2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Filter+-- Copyright   :  (c) Sven Panne 2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs view
@@ -1,76 +1,76 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Objects
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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, textureBinding,
-   textureResident, areTexturesResident,
-   TexturePriority, texturePriority, prioritizeTextures
-) where
-
-import Data.List
-import Data.Maybe (fromMaybe)
-import Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureObject
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Objects+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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+) where++import Data.List+import Data.Maybe (fromMaybe)+import Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter+import Graphics.Rendering.OpenGL.GL.Texturing.TextureObject+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs view
@@ -1,233 +1,233 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Parameters
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
-   (Mirrored, Repeat) -> gl_MIRRORED_REPEAT
-   (Mirrored, ClampToEdge) -> gl_MIRROR_CLAMP_TO_EDGE
-   (Mirrored, ClampToBorder) -> gl_MIRROR_CLAMP_TO_BORDER
-
-unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)
-unmarshalTextureWrapMode x
-   | y == gl_CLAMP = (Repeated, Clamp)
-   | y == gl_REPEAT = (Repeated, Repeat)
-   | y == gl_CLAMP_TO_EDGE = (Repeated, ClampToEdge)
-   | y == gl_CLAMP_TO_BORDER = (Repeated, ClampToBorder)
-   | y == gl_MIRROR_CLAMP = (Mirrored, Clamp)
-   | y == gl_MIRRORED_REPEAT = (Mirrored, Repeat)
-   | y == gl_MIRROR_CLAMP_TO_EDGE = (Mirrored, ClampToEdge)
-   | y == gl_MIRROR_CLAMP_TO_BORDER = (Mirrored, ClampToBorder)
-   | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show x)
-   where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-textureWrapMode :: 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)
-
---------------------------------------------------------------------------------
-
-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 -> 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 :: ParameterizedTextureTarget t => t -> StateVar (Maybe TextureCompareOperator)
-textureCompareOperator =
-   combineTexParamsMaybe
-      (texParami (unmarshalCapability . fromIntegral) (fromIntegral. marshalCapability) TextureCompare)
-      (texParami unmarshalTextureCompareOperator marshalTextureCompareOperator TextureCompareOperator)
-
---------------------------------------------------------------------------------
-
-combineTexParams :: ParameterizedTextureTarget t
-                 => (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 :: ParameterizedTextureTarget t
-                      => (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))
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Parameters+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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+   (Mirrored, Repeat) -> gl_MIRRORED_REPEAT+   (Mirrored, ClampToEdge) -> gl_MIRROR_CLAMP_TO_EDGE+   (Mirrored, ClampToBorder) -> gl_MIRROR_CLAMP_TO_BORDER++unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)+unmarshalTextureWrapMode x+   | y == gl_CLAMP = (Repeated, Clamp)+   | y == gl_REPEAT = (Repeated, Repeat)+   | y == gl_CLAMP_TO_EDGE = (Repeated, ClampToEdge)+   | y == gl_CLAMP_TO_BORDER = (Repeated, ClampToBorder)+   | y == gl_MIRROR_CLAMP = (Mirrored, Clamp)+   | y == gl_MIRRORED_REPEAT = (Mirrored, Repeat)+   | y == gl_MIRROR_CLAMP_TO_EDGE = (Mirrored, ClampToEdge)+   | y == gl_MIRROR_CLAMP_TO_BORDER = (Mirrored, ClampToBorder)+   | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show x)+   where y = fromIntegral x++--------------------------------------------------------------------------------++textureWrapMode :: 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)++--------------------------------------------------------------------------------++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 -> 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 :: ParameterizedTextureTarget t => t -> StateVar (Maybe TextureCompareOperator)+textureCompareOperator =+   combineTexParamsMaybe+      (texParami (unmarshalCapability . fromIntegral) (fromIntegral. marshalCapability) TextureCompare)+      (texParami unmarshalTextureCompareOperator marshalTextureCompareOperator TextureCompareOperator)++--------------------------------------------------------------------------------++combineTexParams :: ParameterizedTextureTarget t+                 => (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 :: ParameterizedTextureTarget t+                      => (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))
Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs view
@@ -1,380 +1,380 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
-   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
-
--- *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
-   -- 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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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+   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++-- *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+   -- legacy values+   | y == 1 = Luminance'+   | y == 2 = LuminanceAlpha'+   | y == 3 = RGB'+   | y == 4 = RGBA'+   | otherwise = error ("unmarshalPixelInternalFormat: illegal value " ++ show x)+   where y = fromIntegral x++-- Note: The following formats are still missing, it's a bit unclear how to+-- handle these nicely. From the EXT_texture_sRGB spec:+--+--    Accepted by the <internalformat> parameter of TexImage2D, CopyTexImage2D,+--    and CompressedTexImage2DARB and the <format> parameter of+--    CompressedTexSubImage2DARB:+--+--       COMPRESSED_SRGB_S3TC_DXT1_EXT                  0x8C4C+--       COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT            0x8C4D+--       COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT            0x8C4E+--       COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT            0x8C4F
Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs view
@@ -1,162 +1,162 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Queries
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
-) where
-
-import Control.Monad
-import Foreign.Marshal.Alloc
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelRectangles
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data TexLevelParameter =
-     TextureInternalFormat
-   | TextureWidth
-   | TextureHeight
-   | TextureDepth
-   | TextureBorder
-   | TextureRedSize
-   | TextureGreenSize
-   | TextureBlueSize
-   | TextureAlphaSize
-   | TextureIntensitySize
-   | TextureLuminanceSize
-   | TextureIndexSize
-   | DepthBits
-   | TextureCompressedImageSize
-   | TextureCompressed
-   | TextureSharedSize
-
-marshalTexLevelParameter :: TexLevelParameter -> GLenum
-marshalTexLevelParameter x = case x of
-   TextureInternalFormat -> gl_TEXTURE_INTERNAL_FORMAT
-   TextureWidth -> gl_TEXTURE_WIDTH
-   TextureHeight -> gl_TEXTURE_HEIGHT
-   TextureDepth -> gl_TEXTURE_DEPTH
-   TextureBorder -> gl_TEXTURE_BORDER
-   TextureRedSize -> gl_TEXTURE_RED_SIZE
-   TextureGreenSize -> gl_TEXTURE_GREEN_SIZE
-   TextureBlueSize -> gl_TEXTURE_BLUE_SIZE
-   TextureAlphaSize -> gl_TEXTURE_ALPHA_SIZE
-   TextureIntensitySize -> gl_TEXTURE_INTENSITY_SIZE
-   TextureLuminanceSize -> gl_TEXTURE_LUMINANCE_SIZE
-   TextureIndexSize -> gl_TEXTURE_INDEX_SIZE
-   DepthBits -> gl_DEPTH_BITS
-   TextureCompressedImageSize -> gl_TEXTURE_COMPRESSED_IMAGE_SIZE
-   TextureCompressed -> gl_TEXTURE_COMPRESSED
-   TextureSharedSize -> gl_TEXTURE_SHARED_SIZE
-
---------------------------------------------------------------------------------
-
-type TextureQuery 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
-
-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 =
-   alloca $ \buf -> do
-      glGetTexLevelParameteriv t level (marshalTexLevelParameter p) buf
-      peek1 f buf
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Queries+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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+) where++import Control.Monad+import Foreign.Marshal.Alloc+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.PixelRectangles+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.Texturing.Specification+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data TexLevelParameter =+     TextureInternalFormat+   | TextureWidth+   | TextureHeight+   | TextureDepth+   | TextureBorder+   | TextureRedSize+   | TextureGreenSize+   | TextureBlueSize+   | TextureAlphaSize+   | TextureIntensitySize+   | TextureLuminanceSize+   | TextureIndexSize+   | DepthBits+   | TextureCompressedImageSize+   | TextureCompressed+   | TextureSharedSize++marshalTexLevelParameter :: TexLevelParameter -> GLenum+marshalTexLevelParameter x = case x of+   TextureInternalFormat -> gl_TEXTURE_INTERNAL_FORMAT+   TextureWidth -> gl_TEXTURE_WIDTH+   TextureHeight -> gl_TEXTURE_HEIGHT+   TextureDepth -> gl_TEXTURE_DEPTH+   TextureBorder -> gl_TEXTURE_BORDER+   TextureRedSize -> gl_TEXTURE_RED_SIZE+   TextureGreenSize -> gl_TEXTURE_GREEN_SIZE+   TextureBlueSize -> gl_TEXTURE_BLUE_SIZE+   TextureAlphaSize -> gl_TEXTURE_ALPHA_SIZE+   TextureIntensitySize -> gl_TEXTURE_INTENSITY_SIZE+   TextureLuminanceSize -> gl_TEXTURE_LUMINANCE_SIZE+   TextureIndexSize -> gl_TEXTURE_INDEX_SIZE+   DepthBits -> gl_DEPTH_BITS+   TextureCompressedImageSize -> gl_TEXTURE_COMPRESSED_IMAGE_SIZE+   TextureCompressed -> gl_TEXTURE_COMPRESSED+   TextureSharedSize -> gl_TEXTURE_SHARED_SIZE++--------------------------------------------------------------------------------++type TextureQuery 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++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 =+   alloca $ \buf -> do+      glGetTexLevelParameteriv t level (marshalTexLevelParameter p) buf+      peek1 f buf
Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs view
@@ -1,352 +1,352 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Specification
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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 (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 (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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.Specification+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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 (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 (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
Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs view
@@ -1,132 +1,132 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Alloc
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-data TexParameter =
-     TextureMinFilter
-   | TextureMagFilter
-   | TextureWrapS
-   | TextureWrapT
-   | TextureWrapR
-   | TextureBorderColor
-   | TextureMinLOD
-   | TextureMaxLOD
-   | TextureBaseLevel
-   | TextureMaxLevel
-   | TexturePriority
-   | TextureMaxAnisotropy
-   | TextureCompare
-   | TextureCompareOperator
-   | TextureCompareFailValue
-   | GenerateMipmap
-   | TextureCompareMode
-   | TextureCompareFunc
-   | DepthTextureMode
-   | TextureLODBias
-   | TextureResident
-
-marshalTexParameter :: TexParameter -> GLenum
-marshalTexParameter x = case x of
-   TextureMinFilter -> gl_TEXTURE_MIN_FILTER
-   TextureMagFilter -> gl_TEXTURE_MAG_FILTER
-   TextureWrapS -> gl_TEXTURE_WRAP_S
-   TextureWrapT -> gl_TEXTURE_WRAP_T
-   TextureWrapR -> gl_TEXTURE_WRAP_R
-   TextureBorderColor -> gl_TEXTURE_BORDER_COLOR
-   TextureMinLOD -> gl_TEXTURE_MIN_LOD
-   TextureMaxLOD -> gl_TEXTURE_MAX_LOD
-   TextureBaseLevel -> gl_TEXTURE_BASE_LEVEL
-   TextureMaxLevel -> gl_TEXTURE_MAX_LEVEL
-   TexturePriority -> gl_TEXTURE_PRIORITY
-   TextureMaxAnisotropy -> gl_TEXTURE_MAX_ANISOTROPY
-   TextureCompare -> 0x819A
-   TextureCompareOperator -> 0x819B
-   TextureCompareFailValue -> gl_TEXTURE_COMPARE_FAIL_VALUE
-   GenerateMipmap -> gl_GENERATE_MIPMAP
-   TextureCompareMode -> gl_TEXTURE_COMPARE_MODE
-   TextureCompareFunc -> gl_TEXTURE_COMPARE_FUNC
-   DepthTextureMode -> gl_DEPTH_TEXTURE_MODE
-   TextureLODBias -> gl_TEXTURE_LOD_BIAS
-   TextureResident -> gl_TEXTURE_RESIDENT
-
---------------------------------------------------------------------------------
-
-texParameter :: 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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TexParameter+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.PeekPoke+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data TexParameter =+     TextureMinFilter+   | TextureMagFilter+   | TextureWrapS+   | TextureWrapT+   | TextureWrapR+   | TextureBorderColor+   | TextureMinLOD+   | TextureMaxLOD+   | TextureBaseLevel+   | TextureMaxLevel+   | TexturePriority+   | TextureMaxAnisotropy+   | TextureCompare+   | TextureCompareOperator+   | TextureCompareFailValue+   | GenerateMipmap+   | TextureCompareMode+   | TextureCompareFunc+   | DepthTextureMode+   | TextureLODBias+   | TextureResident++marshalTexParameter :: TexParameter -> GLenum+marshalTexParameter x = case x of+   TextureMinFilter -> gl_TEXTURE_MIN_FILTER+   TextureMagFilter -> gl_TEXTURE_MAG_FILTER+   TextureWrapS -> gl_TEXTURE_WRAP_S+   TextureWrapT -> gl_TEXTURE_WRAP_T+   TextureWrapR -> gl_TEXTURE_WRAP_R+   TextureBorderColor -> gl_TEXTURE_BORDER_COLOR+   TextureMinLOD -> gl_TEXTURE_MIN_LOD+   TextureMaxLOD -> gl_TEXTURE_MAX_LOD+   TextureBaseLevel -> gl_TEXTURE_BASE_LEVEL+   TextureMaxLevel -> gl_TEXTURE_MAX_LEVEL+   TexturePriority -> gl_TEXTURE_PRIORITY+   TextureMaxAnisotropy -> gl_TEXTURE_MAX_ANISOTROPY+   TextureCompare -> 0x819A+   TextureCompareOperator -> 0x819B+   TextureCompareFailValue -> gl_TEXTURE_COMPARE_FAIL_VALUE+   GenerateMipmap -> gl_GENERATE_MIPMAP+   TextureCompareMode -> gl_TEXTURE_COMPARE_MODE+   TextureCompareFunc -> gl_TEXTURE_COMPARE_FUNC+   DepthTextureMode -> gl_DEPTH_TEXTURE_MODE+   TextureLODBias -> gl_TEXTURE_LOD_BIAS+   TextureResident -> gl_TEXTURE_RESIDENT++--------------------------------------------------------------------------------++texParameter :: 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
Graphics/Rendering/OpenGL/GL/Texturing/TextureObject.hs view
@@ -1,43 +1,43 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureObject
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-newtype TextureObject = TextureObject { textureID :: GLuint }
-   deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-instance ObjectName TextureObject where
-   isObjectName = fmap unmarshalGLboolean . glIsTexture . textureID
-
-   deleteObjectNames textureObjects =
-      withArrayLen (map textureID textureObjects) $
-         glDeleteTextures . fromIntegral
-
-instance GeneratableObjectName TextureObject where
-   genObjectNames n =
-      allocaArray n $ \buf -> do
-        glGenTextures (fromIntegral n) buf
-        fmap (map TextureObject) $ peekArray n buf
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureObject+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.Marshal.Array+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++newtype TextureObject = TextureObject { textureID :: GLuint }+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++instance ObjectName TextureObject where+   isObjectName = fmap unmarshalGLboolean . glIsTexture . textureID++   deleteObjectNames textureObjects =+      withArrayLen (map textureID textureObjects) $+         glDeleteTextures . fromIntegral++instance GeneratableObjectName TextureObject where+   genObjectNames n =+      allocaArray n $ \buf -> do+        glGenTextures (fromIntegral n) buf+        fmap (map TextureObject) $ peekArray n buf
Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs view
@@ -1,297 +1,297 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs view
@@ -1,50 +1,50 @@-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | 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))
+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 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))
Graphics/Rendering/OpenGL/GL/TransformFeedback.hs view
@@ -1,124 +1,124 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.TransformFeedback
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013
--- 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 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.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Shaders.Program
-import Graphics.Rendering.OpenGL.GL.Shaders.Variables
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-beginTransformFeedback :: PrimitiveMode -> IO ()
-beginTransformFeedback = glBeginTransformFeedback . marshalPrimitiveMode
-
-endTransformFeedback :: IO ()
-endTransformFeedback = glEndTransformFeedback
-
---------------------------------------------------------------------------------
-
-data TransformFeedbackBufferMode =
-     InterleavedAttribs
-   | SeperateAttribs
-   deriving ( Eq, Ord, Show )
-
-marshalTransformFeedbackBufferMode :: TransformFeedbackBufferMode -> GLenum
-marshalTransformFeedbackBufferMode x = case x of
-   InterleavedAttribs -> gl_INTERLEAVED_ATTRIBS
-   SeperateAttribs -> gl_SEPARATE_ATTRIBS
-
-unmarshalTransformFeedbackBufferMode :: GLenum -> TransformFeedbackBufferMode
-unmarshalTransformFeedbackBufferMode x
-   | x == gl_INTERLEAVED_ATTRIBS = InterleavedAttribs
-   | x == gl_SEPARATE_ATTRIBS = SeperateAttribs
-   | 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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.TransformFeedback+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013+-- 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 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.QueryUtils+import Graphics.Rendering.OpenGL.GL.Shaders.Program+import Graphics.Rendering.OpenGL.GL.Shaders.Variables+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++beginTransformFeedback :: PrimitiveMode -> IO ()+beginTransformFeedback = glBeginTransformFeedback . marshalPrimitiveMode++endTransformFeedback :: IO ()+endTransformFeedback = glEndTransformFeedback++--------------------------------------------------------------------------------++data TransformFeedbackBufferMode =+     InterleavedAttribs+   | SeperateAttribs+   deriving ( Eq, Ord, Show )++marshalTransformFeedbackBufferMode :: TransformFeedbackBufferMode -> GLenum+marshalTransformFeedbackBufferMode x = case x of+   InterleavedAttribs -> gl_INTERLEAVED_ATTRIBS+   SeperateAttribs -> gl_SEPARATE_ATTRIBS++unmarshalTransformFeedbackBufferMode :: GLenum -> TransformFeedbackBufferMode+unmarshalTransformFeedbackBufferMode x+   | x == gl_INTERLEAVED_ATTRIBS = InterleavedAttribs+   | x == gl_SEPARATE_ATTRIBS = SeperateAttribs+   | 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
Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs view
@@ -1,55 +1,55 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrayObjects
--- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013
--- License     :  BSD3
---
--- Maintainer  :  Sven Panne <svenpanne@gmail.com>
--- Stability   :  stable
--- Portability :  portable
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.VertexArrayObjects (
-   VertexArrayObject,
-   bindVertexArrayObject
-) where
-
-import Foreign.Marshal.Array
-
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
------------------------------------------------------------------------------
-
-newtype VertexArrayObject = VertexArrayObject { vertexArrayID :: GLuint }
-   deriving( Eq, Ord, Show )
-
-instance ObjectName VertexArrayObject where
-   isObjectName =  fmap unmarshalGLboolean . glIsVertexArray . vertexArrayID
-
-   deleteObjectNames bufferObjects =
-      withArrayLen (map vertexArrayID bufferObjects) $
-         glDeleteVertexArrays . fromIntegral
-
-instance GeneratableObjectName VertexArrayObject where
-   genObjectNames n = allocaArray n $ \buf -> do
-      glGenVertexArrays (fromIntegral n) buf
-      fmap (map VertexArrayObject) $ peekArray n buf
-
-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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrayObjects+-- Copyright   :  (c) Sven Panne, Lars Corbijn 2011-2013+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Graphics.Rendering.OpenGL.GL.VertexArrayObjects (+   VertexArrayObject,+   bindVertexArrayObject+) where++import Foreign.Marshal.Array++import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.ObjectName+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++-----------------------------------------------------------------------------++newtype VertexArrayObject = VertexArrayObject { vertexArrayID :: GLuint }+   deriving( Eq, Ord, Show )++instance ObjectName VertexArrayObject where+   isObjectName =  fmap unmarshalGLboolean . glIsVertexArray . vertexArrayID++   deleteObjectNames bufferObjects =+      withArrayLen (map vertexArrayID bufferObjects) $+         glDeleteVertexArrays . fromIntegral++instance GeneratableObjectName VertexArrayObject where+   genObjectNames n = allocaArray n $ \buf -> do+      glGenVertexArrays (fromIntegral n) buf+      fmap (map VertexArrayObject) $ peekArray n buf++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
Graphics/Rendering/OpenGL/GL/VertexArrays.hs view
@@ -1,483 +1,483 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrays
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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,
-   arrayElement, drawArrays, multiDrawArrays, drawElements, multiDrawElements,
-   drawRangeElements, maxElementsVertices, maxElementsIndices, lockArrays,
-   primitiveRestartIndex, primitiveRestartIndexNV,
-
-   -- * Generic Vertex Attribute Arrays
-   vertexAttribPointer, vertexAttribArray,
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.DataType
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PrimitiveMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-type NumComponents = GLint
-
-type Stride = GLsizei
-
-data VertexArrayDescriptor a =
-   VertexArrayDescriptor !NumComponents !DataType !Stride !(Ptr a)
-   deriving ( Eq, Ord, Show )
-
-noVertexArrayDescriptor :: VertexArrayDescriptor a
-noVertexArrayDescriptor = VertexArrayDescriptor 0 Byte 0 nullPtr
-
---------------------------------------------------------------------------------
-
-data ClientArrayType =
-     VertexArray
-   | NormalArray
-   | ColorArray
-   | IndexArray
-   | TextureCoordArray
-   | EdgeFlagArray
-   | FogCoordArray
-   | SecondaryColorArray
-   | MatrixIndexArray
-   deriving ( Eq, Ord, Show )
-
-marshalClientArrayType :: ClientArrayType -> GLenum
-marshalClientArrayType x = case x of
-   VertexArray -> gl_VERTEX_ARRAY
-   NormalArray -> gl_NORMAL_ARRAY
-   ColorArray -> gl_COLOR_ARRAY
-   IndexArray -> gl_INDEX_ARRAY
-   TextureCoordArray -> gl_TEXTURE_COORD_ARRAY
-   EdgeFlagArray -> gl_EDGE_FLAG_ARRAY
-   FogCoordArray -> gl_FOG_COORD_ARRAY
-   SecondaryColorArray -> gl_SECONDARY_COLOR_ARRAY
-   MatrixIndexArray -> gl_MATRIX_INDEX_ARRAY
-
--- Hmmm...
-clientArrayTypeToEnableCap :: ClientArrayType -> EnableCap
-clientArrayTypeToEnableCap x = case x of
-   VertexArray -> CapVertexArray
-   NormalArray -> CapNormalArray
-   ColorArray -> CapColorArray
-   IndexArray -> CapIndexArray
-   TextureCoordArray -> CapTextureCoordArray
-   EdgeFlagArray -> CapEdgeFlagArray
-   FogCoordArray -> CapFogCoordArray
-   SecondaryColorArray -> CapSecondaryColorArray
-   MatrixIndexArray -> CapMatrixIndexArray
-
---------------------------------------------------------------------------------
-
-arrayPointer :: ClientArrayType -> StateVar (VertexArrayDescriptor a)
-arrayPointer t = case t of
-   VertexArray -> vertexPointer
-   NormalArray -> normalPointer
-   ColorArray -> colorPointer
-   IndexArray -> indexPointer
-   TextureCoordArray -> texCoordPointer
-   EdgeFlagArray -> edgeFlagPointer
-   FogCoordArray -> fogCoordPointer
-   SecondaryColorArray -> secondaryColorPointer
-   MatrixIndexArray ->
-      makeStateVar
-        (do recordInvalidEnum ; return noVertexArrayDescriptor)
-        (const recordInvalidEnum)
-
-check :: Bool -> IO () -> IO ()
-check flag val = if flag then val else recordInvalidValue
-
---------------------------------------------------------------------------------
-
-vertexPointer :: StateVar (VertexArrayDescriptor a)
-vertexPointer = makeStateVar getVertexPointer setVertexPointer
-
-getVertexPointer :: IO (VertexArrayDescriptor a)
-getVertexPointer = do
-   n <- getInteger1 id GetVertexArraySize
-   d <- getEnum1 unmarshalDataType GetVertexArrayType
-   s <- getInteger1 fromIntegral GetVertexArrayStride
-   p <- getPointer VertexArrayPointer
-   return $ VertexArrayDescriptor n d s p
-
-setVertexPointer :: VertexArrayDescriptor a -> IO ()
-setVertexPointer (VertexArrayDescriptor n d s p) =
-   glVertexPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-normalPointer :: StateVar (VertexArrayDescriptor a)
-normalPointer = makeStateVar getNormalPointer setNormalPointer
-
-getNormalPointer :: IO (VertexArrayDescriptor a)
-getNormalPointer = do
-   d <- getEnum1 unmarshalDataType GetNormalArrayType
-   s <- getInteger1 fromIntegral GetNormalArrayStride
-   p <- getPointer NormalArrayPointer
-   return $ VertexArrayDescriptor 3 d s p
-
-setNormalPointer :: VertexArrayDescriptor a -> IO ()
-setNormalPointer (VertexArrayDescriptor n d s p) =
-   check (n == 3) $ glNormalPointer (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-colorPointer :: StateVar (VertexArrayDescriptor a)
-colorPointer = makeStateVar getColorPointer setColorPointer
-
-getColorPointer :: IO (VertexArrayDescriptor a)
-getColorPointer = do
-   n <- getInteger1 id GetColorArraySize
-   d <- getEnum1 unmarshalDataType GetColorArrayType
-   s <- getInteger1 fromIntegral GetColorArrayStride
-   p <- getPointer ColorArrayPointer
-   return $ VertexArrayDescriptor n d s p
-
-setColorPointer :: VertexArrayDescriptor a -> IO ()
-setColorPointer (VertexArrayDescriptor n d s p) =
-   check (n == 3 || n == 4) $ glColorPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-indexPointer :: StateVar (VertexArrayDescriptor a)
-indexPointer = makeStateVar getIndexPointer setIndexPointer
-
-getIndexPointer :: IO (VertexArrayDescriptor a)
-getIndexPointer = do
-   d <- getEnum1 unmarshalDataType GetIndexArrayType
-   s <- getInteger1 fromIntegral GetIndexArrayStride
-   p <- getPointer IndexArrayPointer
-   return $ VertexArrayDescriptor 1 d s p
-
-setIndexPointer :: VertexArrayDescriptor a -> IO ()
-setIndexPointer (VertexArrayDescriptor n d s p) =
-   check (n == 1) $ glIndexPointer (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-texCoordPointer :: StateVar (VertexArrayDescriptor a)
-texCoordPointer = makeStateVar getTexCoordPointer setTexCoordPointer
-
-getTexCoordPointer :: IO (VertexArrayDescriptor a)
-getTexCoordPointer = do
-   n <- getInteger1 id GetTextureCoordArraySize
-   d <- getEnum1 unmarshalDataType GetTextureCoordArrayType
-   s <- getInteger1 fromIntegral GetTextureCoordArrayStride
-   p <- getPointer TextureCoordArrayPointer
-   return $ VertexArrayDescriptor n d s p
-
-setTexCoordPointer :: VertexArrayDescriptor a -> IO ()
-setTexCoordPointer (VertexArrayDescriptor n d s p) =
-   glTexCoordPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-edgeFlagPointer :: StateVar (VertexArrayDescriptor a)
-edgeFlagPointer = makeStateVar getEdgeFlagPointer setEdgeFlagPointer
-
-getEdgeFlagPointer :: IO (VertexArrayDescriptor a)
-getEdgeFlagPointer = do
-   s <- getInteger1 fromIntegral GetEdgeFlagArrayStride
-   p <- getPointer EdgeFlagArrayPointer
-   return $ VertexArrayDescriptor 1 UnsignedByte s p
-
-setEdgeFlagPointer :: VertexArrayDescriptor a -> IO ()
-setEdgeFlagPointer (VertexArrayDescriptor n d s p) =
-   check (n == 1 && d == UnsignedByte) $ glEdgeFlagPointer s p
-
---------------------------------------------------------------------------------
-
-fogCoordPointer :: StateVar (VertexArrayDescriptor a)
-fogCoordPointer = makeStateVar getFogCoordPointer setFogCoordPointer
-
-getFogCoordPointer :: IO (VertexArrayDescriptor a)
-getFogCoordPointer = do
-   d <- getEnum1 unmarshalDataType GetFogCoordArrayType
-   s <- getInteger1 fromIntegral GetFogCoordArrayStride
-   p <- getPointer FogCoordArrayPointer
-   return $ VertexArrayDescriptor 1 d s p
-
-setFogCoordPointer :: VertexArrayDescriptor a -> IO ()
-setFogCoordPointer (VertexArrayDescriptor n d s p) =
-   check (n == 1) $ glFogCoordPointer (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-secondaryColorPointer :: StateVar (VertexArrayDescriptor a)
-secondaryColorPointer =
-   makeStateVar getSecondaryColorPointer setSecondaryColorPointer
-
-getSecondaryColorPointer :: IO (VertexArrayDescriptor a)
-getSecondaryColorPointer = do
-   n <- getInteger1 id GetSecondaryColorArraySize
-   d <- getEnum1 unmarshalDataType GetSecondaryColorArrayType
-   s <- getInteger1 fromIntegral GetSecondaryColorArrayStride
-   p <- getPointer SecondaryColorArrayPointer
-   return $ VertexArrayDescriptor n d s p
-
-setSecondaryColorPointer :: (VertexArrayDescriptor a) -> IO ()
-setSecondaryColorPointer (VertexArrayDescriptor n d s p) =
-   glSecondaryColorPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-data InterleavedArrays =
-     V2f
-   | V3f
-   | C4ubV2f
-   | C4ubV3f
-   | C3fV3f
-   | N3fV3f
-   | C4fN3fV3f
-   | T2fV3f
-   | T4fV4f
-   | T2fC4ubV3f
-   | T2fC3fV3f
-   | T2fN3fV3f
-   | T2fC4fN3fV3f
-   | T4fC4fN3fV4f
-   deriving ( Eq, Ord, Show )
-
-marshalInterleavedArrays :: InterleavedArrays -> GLenum
-marshalInterleavedArrays x = case x of
-   V2f -> gl_V2F
-   V3f -> gl_V3F
-   C4ubV2f -> gl_C4UB_V2F
-   C4ubV3f -> gl_C4UB_V3F
-   C3fV3f -> gl_C3F_V3F
-   N3fV3f -> gl_N3F_V3F
-   C4fN3fV3f -> gl_C4F_N3F_V3F
-   T2fV3f -> gl_T2F_V3F
-   T4fV4f -> gl_T4F_V4F
-   T2fC4ubV3f -> gl_T2F_C4UB_V3F
-   T2fC3fV3f -> gl_T2F_C3F_V3F
-   T2fN3fV3f -> gl_T2F_N3F_V3F
-   T2fC4fN3fV3f -> gl_T2F_C4F_N3F_V3F
-   T4fC4fN3fV4f -> gl_T4F_C4F_N3F_V4F
-
---------------------------------------------------------------------------------
-
-interleavedArrays :: InterleavedArrays -> Stride -> Ptr a -> IO ()
-interleavedArrays = glInterleavedArrays . marshalInterleavedArrays
-
---------------------------------------------------------------------------------
-
-clientState :: ClientArrayType -> StateVar Capability
-clientState arrayType =
-   makeStateVar (getClientState arrayType) (setClientState arrayType)
-
-getClientState :: ClientArrayType -> IO Capability
-getClientState arrayType = get . makeCapability . clientArrayTypeToEnableCap $ arrayType
-
-setClientState :: ClientArrayType -> Capability -> IO ()
-setClientState arrayType val =
-   (if val == Enabled then glEnableClientState else glDisableClientState)
-      (marshalClientArrayType arrayType)
-
---------------------------------------------------------------------------------
-
-clientActiveTexture :: StateVar TextureUnit
-clientActiveTexture =
-   makeStateVar (getEnum1 unmarshalTextureUnit GetClientActiveTexture)
-                (glClientActiveTexture . marshalTextureUnit)
-
---------------------------------------------------------------------------------
-
-type ArrayIndex = GLint
-
-type NumArrayIndices = GLsizei
-
-type NumIndexBlocks = GLsizei
-
---------------------------------------------------------------------------------
-
-arrayElement :: ArrayIndex -> IO ()
-arrayElement = glArrayElement
-
-drawArrays :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> IO ()
-drawArrays = glDrawArrays . marshalPrimitiveMode
-
-multiDrawArrays ::
-      PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks
-   -> IO ()
-multiDrawArrays = glMultiDrawArrays . marshalPrimitiveMode
-
-drawElements :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> IO ()
-drawElements m c = glDrawElements (marshalPrimitiveMode m) c . marshalDataType
-
-multiDrawElements ::
-      PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a)
-   -> NumIndexBlocks -> IO ()
-multiDrawElements m c =
-   glMultiDrawElements (marshalPrimitiveMode m) c . marshalDataType
-
-drawRangeElements ::
-      PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType
-   -> Ptr a -> IO ()
-drawRangeElements m (s, e) c =
-   glDrawRangeElements (marshalPrimitiveMode m) (fromIntegral s)
-                       (fromIntegral e) c . marshalDataType
-
-maxElementsVertices :: GettableStateVar NumArrayIndices
-maxElementsVertices = makeGettableStateVar (getSizei1 id GetMaxElementsVertices)
-
-maxElementsIndices :: GettableStateVar NumArrayIndices
-maxElementsIndices = makeGettableStateVar (getSizei1 id GetMaxElementsIndices)
-
---------------------------------------------------------------------------------
-
-lockArrays :: StateVar (Maybe (ArrayIndex, NumArrayIndices))
-lockArrays = makeStateVar getLockArrays setLockArrays
-
-getLockArrays :: IO (Maybe (ArrayIndex, NumArrayIndices))
-getLockArrays = do
-   count <- getInteger1 fromIntegral GetArrayElementLockCount
-   if count > 0
-      then do first <- getInteger1 id GetArrayElementLockFirst
-              return $ Just (first, count)
-      else return Nothing
-
-setLockArrays :: Maybe (ArrayIndex, NumArrayIndices) -> IO ()
-setLockArrays = maybe glUnlockArrays (uncurry glLockArrays)
-
---------------------------------------------------------------------------------
-
-primitiveRestartIndex :: StateVar (Maybe ArrayIndex)
-primitiveRestartIndex =
-   makeStateVarMaybe
-      (return CapPrimitiveRestart)
-      (getInteger1 id GetPrimitiveRestartIndex)
-      (glPrimitiveRestartIndex . fromIntegral)
-
---------------------------------------------------------------------------------
-
--- We almost could use makeStateVarMaybe below, but, alas, this is client state.
-
-primitiveRestartIndexNV :: StateVar (Maybe ArrayIndex)
-primitiveRestartIndexNV =
-   makeStateVar getPrimitiveRestartIndexNV setPrimitiveRestartIndexNV
-
-getPrimitiveRestartIndexNV :: IO (Maybe ArrayIndex)
-getPrimitiveRestartIndexNV = do
-   on <- getBoolean1 unmarshalGLboolean GetPrimitiveRestartNV
-   if on
-      then fmap Just $ getInteger1 fromIntegral GetPrimitiveRestartIndexNV
-      else return Nothing
-
-setPrimitiveRestartIndexNV :: Maybe ArrayIndex -> IO ()
-setPrimitiveRestartIndexNV maybeIdx = case maybeIdx of
-   Nothing  -> glDisableClientState gl_PRIMITIVE_RESTART_NV
-   Just idx -> do glEnableClientState gl_PRIMITIVE_RESTART_NV
-                  glPrimitiveRestartIndexNV (fromIntegral idx)
-
---------------------------------------------------------------------------------
-
-data GetPointervPName =
-     VertexArrayPointer
-   | NormalArrayPointer
-   | ColorArrayPointer
-   | IndexArrayPointer
-   | TextureCoordArrayPointer
-   | EdgeFlagArrayPointer
-   | FogCoordArrayPointer
-   | SecondaryColorArrayPointer
-   | FeedbackBufferPointer
-   | SelectionBufferPointer
-   | WeightArrayPointer
-   | MatrixIndexArrayPointer
-
-marshalGetPointervPName :: GetPointervPName -> GLenum
-marshalGetPointervPName x = case x of
-   VertexArrayPointer -> gl_VERTEX_ARRAY_POINTER
-   NormalArrayPointer -> gl_NORMAL_ARRAY_POINTER
-   ColorArrayPointer -> gl_COLOR_ARRAY_POINTER
-   IndexArrayPointer -> gl_INDEX_ARRAY_POINTER
-   TextureCoordArrayPointer -> gl_TEXTURE_COORD_ARRAY_POINTER
-   EdgeFlagArrayPointer -> gl_EDGE_FLAG_ARRAY_POINTER
-   FogCoordArrayPointer -> gl_FOG_COORD_ARRAY_POINTER
-   SecondaryColorArrayPointer -> gl_SECONDARY_COLOR_ARRAY_POINTER
-   FeedbackBufferPointer -> gl_FEEDBACK_BUFFER_POINTER
-   SelectionBufferPointer -> gl_SELECTION_BUFFER_POINTER
-   WeightArrayPointer -> gl_WEIGHT_ARRAY_POINTER
-   MatrixIndexArrayPointer -> gl_MATRIX_INDEX_ARRAY_POINTER
-
---------------------------------------------------------------------------------
-
-getPointer :: GetPointervPName -> IO (Ptr a)
-getPointer n = alloca $ \buf -> do
-   glGetPointerv (marshalGetPointervPName n) buf
-   peek buf
-
---------------------------------------------------------------------------------
-
-vertexAttribPointer :: AttribLocation -> StateVar (IntegerHandling, VertexArrayDescriptor a)
-vertexAttribPointer location =
-   makeStateVar (getVertexAttribPointer_ location) (setVertexAttribPointer location)
-
-getVertexAttribPointer_ :: AttribLocation -> IO (IntegerHandling, VertexArrayDescriptor a)
-getVertexAttribPointer_ location = do
-   i <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayInteger
-   h <- if i
-           then return KeepIntegral
-           else do f <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayNormalized
-                   return $ if f then ToNormalizedFloat else ToFloat
-   n <- getVertexAttribInteger1 id location GetVertexAttribArraySize
-   d <- getVertexAttribEnum1 unmarshalDataType location GetVertexAttribArrayType
-   s <- getVertexAttribInteger1 fromIntegral location GetVertexAttribArrayStride
-   p <- getVertexAttribPointer location VertexAttribArrayPointer
-   return (h, VertexArrayDescriptor n d s p)
-
-setVertexAttribPointer :: AttribLocation -> (IntegerHandling, VertexArrayDescriptor a) -> IO ()
-setVertexAttribPointer (AttribLocation location) (h, VertexArrayDescriptor n d s p) = case h of
-   ToFloat -> glVertexAttribPointer location n md (marshalGLboolean False) s p
-   ToNormalizedFloat -> glVertexAttribPointer location n md (marshalGLboolean True) s p
-   KeepIntegral -> glVertexAttribIPointer location n md s p
-  where md = marshalDataType d
-
---------------------------------------------------------------------------------
-
-vertexAttribArray :: AttribLocation -> StateVar Capability
-vertexAttribArray location =
-   makeStateVar (getVertexAttribArray location) (flip setVertexAttribArray location)
-
-getVertexAttribArray :: AttribLocation -> IO Capability
-getVertexAttribArray location =
-   getVertexAttribBoolean1 unmarshalCapability location GetVertexAttribArrayEnabled
-
-setVertexAttribArray :: Capability -> AttribLocation -> IO ()
-setVertexAttribArray Disabled (AttribLocation location) = glDisableVertexAttribArray location
-setVertexAttribArray Enabled (AttribLocation location) = glEnableVertexAttribArray location
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexArrays+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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,+   arrayElement, drawArrays, multiDrawArrays, drawElements, multiDrawElements,+   drawRangeElements, maxElementsVertices, maxElementsIndices, lockArrays,+   primitiveRestartIndex, primitiveRestartIndexNV,++   -- * Generic Vertex Attribute Arrays+   vertexAttribPointer, vertexAttribArray,+) where++import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import Graphics.Rendering.OpenGL.GL.Capability+import Graphics.Rendering.OpenGL.GL.DataType+import Graphics.Rendering.OpenGL.GL.GLboolean+import Graphics.Rendering.OpenGL.GL.PrimitiveMode+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++type NumComponents = GLint++type Stride = GLsizei++data VertexArrayDescriptor a =+   VertexArrayDescriptor !NumComponents !DataType !Stride !(Ptr a)+   deriving ( Eq, Ord, Show )++noVertexArrayDescriptor :: VertexArrayDescriptor a+noVertexArrayDescriptor = VertexArrayDescriptor 0 Byte 0 nullPtr++--------------------------------------------------------------------------------++data ClientArrayType =+     VertexArray+   | NormalArray+   | ColorArray+   | IndexArray+   | TextureCoordArray+   | EdgeFlagArray+   | FogCoordArray+   | SecondaryColorArray+   | MatrixIndexArray+   deriving ( Eq, Ord, Show )++marshalClientArrayType :: ClientArrayType -> GLenum+marshalClientArrayType x = case x of+   VertexArray -> gl_VERTEX_ARRAY+   NormalArray -> gl_NORMAL_ARRAY+   ColorArray -> gl_COLOR_ARRAY+   IndexArray -> gl_INDEX_ARRAY+   TextureCoordArray -> gl_TEXTURE_COORD_ARRAY+   EdgeFlagArray -> gl_EDGE_FLAG_ARRAY+   FogCoordArray -> gl_FOG_COORD_ARRAY+   SecondaryColorArray -> gl_SECONDARY_COLOR_ARRAY+   MatrixIndexArray -> gl_MATRIX_INDEX_ARRAY++-- Hmmm...+clientArrayTypeToEnableCap :: ClientArrayType -> EnableCap+clientArrayTypeToEnableCap x = case x of+   VertexArray -> CapVertexArray+   NormalArray -> CapNormalArray+   ColorArray -> CapColorArray+   IndexArray -> CapIndexArray+   TextureCoordArray -> CapTextureCoordArray+   EdgeFlagArray -> CapEdgeFlagArray+   FogCoordArray -> CapFogCoordArray+   SecondaryColorArray -> CapSecondaryColorArray+   MatrixIndexArray -> CapMatrixIndexArray++--------------------------------------------------------------------------------++arrayPointer :: ClientArrayType -> StateVar (VertexArrayDescriptor a)+arrayPointer t = case t of+   VertexArray -> vertexPointer+   NormalArray -> normalPointer+   ColorArray -> colorPointer+   IndexArray -> indexPointer+   TextureCoordArray -> texCoordPointer+   EdgeFlagArray -> edgeFlagPointer+   FogCoordArray -> fogCoordPointer+   SecondaryColorArray -> secondaryColorPointer+   MatrixIndexArray ->+      makeStateVar+        (do recordInvalidEnum ; return noVertexArrayDescriptor)+        (const recordInvalidEnum)++check :: Bool -> IO () -> IO ()+check flag val = if flag then val else recordInvalidValue++--------------------------------------------------------------------------------++vertexPointer :: StateVar (VertexArrayDescriptor a)+vertexPointer = makeStateVar getVertexPointer setVertexPointer++getVertexPointer :: IO (VertexArrayDescriptor a)+getVertexPointer = do+   n <- getInteger1 id GetVertexArraySize+   d <- getEnum1 unmarshalDataType GetVertexArrayType+   s <- getInteger1 fromIntegral GetVertexArrayStride+   p <- getPointer VertexArrayPointer+   return $ VertexArrayDescriptor n d s p++setVertexPointer :: VertexArrayDescriptor a -> IO ()+setVertexPointer (VertexArrayDescriptor n d s p) =+   glVertexPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++normalPointer :: StateVar (VertexArrayDescriptor a)+normalPointer = makeStateVar getNormalPointer setNormalPointer++getNormalPointer :: IO (VertexArrayDescriptor a)+getNormalPointer = do+   d <- getEnum1 unmarshalDataType GetNormalArrayType+   s <- getInteger1 fromIntegral GetNormalArrayStride+   p <- getPointer NormalArrayPointer+   return $ VertexArrayDescriptor 3 d s p++setNormalPointer :: VertexArrayDescriptor a -> IO ()+setNormalPointer (VertexArrayDescriptor n d s p) =+   check (n == 3) $ glNormalPointer (marshalDataType d) s p++--------------------------------------------------------------------------------++colorPointer :: StateVar (VertexArrayDescriptor a)+colorPointer = makeStateVar getColorPointer setColorPointer++getColorPointer :: IO (VertexArrayDescriptor a)+getColorPointer = do+   n <- getInteger1 id GetColorArraySize+   d <- getEnum1 unmarshalDataType GetColorArrayType+   s <- getInteger1 fromIntegral GetColorArrayStride+   p <- getPointer ColorArrayPointer+   return $ VertexArrayDescriptor n d s p++setColorPointer :: VertexArrayDescriptor a -> IO ()+setColorPointer (VertexArrayDescriptor n d s p) =+   check (n == 3 || n == 4) $ glColorPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++indexPointer :: StateVar (VertexArrayDescriptor a)+indexPointer = makeStateVar getIndexPointer setIndexPointer++getIndexPointer :: IO (VertexArrayDescriptor a)+getIndexPointer = do+   d <- getEnum1 unmarshalDataType GetIndexArrayType+   s <- getInteger1 fromIntegral GetIndexArrayStride+   p <- getPointer IndexArrayPointer+   return $ VertexArrayDescriptor 1 d s p++setIndexPointer :: VertexArrayDescriptor a -> IO ()+setIndexPointer (VertexArrayDescriptor n d s p) =+   check (n == 1) $ glIndexPointer (marshalDataType d) s p++--------------------------------------------------------------------------------++texCoordPointer :: StateVar (VertexArrayDescriptor a)+texCoordPointer = makeStateVar getTexCoordPointer setTexCoordPointer++getTexCoordPointer :: IO (VertexArrayDescriptor a)+getTexCoordPointer = do+   n <- getInteger1 id GetTextureCoordArraySize+   d <- getEnum1 unmarshalDataType GetTextureCoordArrayType+   s <- getInteger1 fromIntegral GetTextureCoordArrayStride+   p <- getPointer TextureCoordArrayPointer+   return $ VertexArrayDescriptor n d s p++setTexCoordPointer :: VertexArrayDescriptor a -> IO ()+setTexCoordPointer (VertexArrayDescriptor n d s p) =+   glTexCoordPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++edgeFlagPointer :: StateVar (VertexArrayDescriptor a)+edgeFlagPointer = makeStateVar getEdgeFlagPointer setEdgeFlagPointer++getEdgeFlagPointer :: IO (VertexArrayDescriptor a)+getEdgeFlagPointer = do+   s <- getInteger1 fromIntegral GetEdgeFlagArrayStride+   p <- getPointer EdgeFlagArrayPointer+   return $ VertexArrayDescriptor 1 UnsignedByte s p++setEdgeFlagPointer :: VertexArrayDescriptor a -> IO ()+setEdgeFlagPointer (VertexArrayDescriptor n d s p) =+   check (n == 1 && d == UnsignedByte) $ glEdgeFlagPointer s p++--------------------------------------------------------------------------------++fogCoordPointer :: StateVar (VertexArrayDescriptor a)+fogCoordPointer = makeStateVar getFogCoordPointer setFogCoordPointer++getFogCoordPointer :: IO (VertexArrayDescriptor a)+getFogCoordPointer = do+   d <- getEnum1 unmarshalDataType GetFogCoordArrayType+   s <- getInteger1 fromIntegral GetFogCoordArrayStride+   p <- getPointer FogCoordArrayPointer+   return $ VertexArrayDescriptor 1 d s p++setFogCoordPointer :: VertexArrayDescriptor a -> IO ()+setFogCoordPointer (VertexArrayDescriptor n d s p) =+   check (n == 1) $ glFogCoordPointer (marshalDataType d) s p++--------------------------------------------------------------------------------++secondaryColorPointer :: StateVar (VertexArrayDescriptor a)+secondaryColorPointer =+   makeStateVar getSecondaryColorPointer setSecondaryColorPointer++getSecondaryColorPointer :: IO (VertexArrayDescriptor a)+getSecondaryColorPointer = do+   n <- getInteger1 id GetSecondaryColorArraySize+   d <- getEnum1 unmarshalDataType GetSecondaryColorArrayType+   s <- getInteger1 fromIntegral GetSecondaryColorArrayStride+   p <- getPointer SecondaryColorArrayPointer+   return $ VertexArrayDescriptor n d s p++setSecondaryColorPointer :: (VertexArrayDescriptor a) -> IO ()+setSecondaryColorPointer (VertexArrayDescriptor n d s p) =+   glSecondaryColorPointer n (marshalDataType d) s p++--------------------------------------------------------------------------------++data InterleavedArrays =+     V2f+   | V3f+   | C4ubV2f+   | C4ubV3f+   | C3fV3f+   | N3fV3f+   | C4fN3fV3f+   | T2fV3f+   | T4fV4f+   | T2fC4ubV3f+   | T2fC3fV3f+   | T2fN3fV3f+   | T2fC4fN3fV3f+   | T4fC4fN3fV4f+   deriving ( Eq, Ord, Show )++marshalInterleavedArrays :: InterleavedArrays -> GLenum+marshalInterleavedArrays x = case x of+   V2f -> gl_V2F+   V3f -> gl_V3F+   C4ubV2f -> gl_C4UB_V2F+   C4ubV3f -> gl_C4UB_V3F+   C3fV3f -> gl_C3F_V3F+   N3fV3f -> gl_N3F_V3F+   C4fN3fV3f -> gl_C4F_N3F_V3F+   T2fV3f -> gl_T2F_V3F+   T4fV4f -> gl_T4F_V4F+   T2fC4ubV3f -> gl_T2F_C4UB_V3F+   T2fC3fV3f -> gl_T2F_C3F_V3F+   T2fN3fV3f -> gl_T2F_N3F_V3F+   T2fC4fN3fV3f -> gl_T2F_C4F_N3F_V3F+   T4fC4fN3fV4f -> gl_T4F_C4F_N3F_V4F++--------------------------------------------------------------------------------++interleavedArrays :: InterleavedArrays -> Stride -> Ptr a -> IO ()+interleavedArrays = glInterleavedArrays . marshalInterleavedArrays++--------------------------------------------------------------------------------++clientState :: ClientArrayType -> StateVar Capability+clientState arrayType =+   makeStateVar (getClientState arrayType) (setClientState arrayType)++getClientState :: ClientArrayType -> IO Capability+getClientState arrayType = get . makeCapability . clientArrayTypeToEnableCap $ arrayType++setClientState :: ClientArrayType -> Capability -> IO ()+setClientState arrayType val =+   (if val == Enabled then glEnableClientState else glDisableClientState)+      (marshalClientArrayType arrayType)++--------------------------------------------------------------------------------++clientActiveTexture :: StateVar TextureUnit+clientActiveTexture =+   makeStateVar (getEnum1 unmarshalTextureUnit GetClientActiveTexture)+                (glClientActiveTexture . marshalTextureUnit)++--------------------------------------------------------------------------------++type ArrayIndex = GLint++type NumArrayIndices = GLsizei++type NumIndexBlocks = GLsizei++--------------------------------------------------------------------------------++arrayElement :: ArrayIndex -> IO ()+arrayElement = glArrayElement++drawArrays :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> IO ()+drawArrays = glDrawArrays . marshalPrimitiveMode++multiDrawArrays ::+      PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks+   -> IO ()+multiDrawArrays = glMultiDrawArrays . marshalPrimitiveMode++drawElements :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> IO ()+drawElements m c = glDrawElements (marshalPrimitiveMode m) c . marshalDataType++multiDrawElements ::+      PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a)+   -> NumIndexBlocks -> IO ()+multiDrawElements m c =+   glMultiDrawElements (marshalPrimitiveMode m) c . marshalDataType++drawRangeElements ::+      PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType+   -> Ptr a -> IO ()+drawRangeElements m (s, e) c =+   glDrawRangeElements (marshalPrimitiveMode m) (fromIntegral s)+                       (fromIntegral e) c . marshalDataType++maxElementsVertices :: GettableStateVar NumArrayIndices+maxElementsVertices = makeGettableStateVar (getSizei1 id GetMaxElementsVertices)++maxElementsIndices :: GettableStateVar NumArrayIndices+maxElementsIndices = makeGettableStateVar (getSizei1 id GetMaxElementsIndices)++--------------------------------------------------------------------------------++lockArrays :: StateVar (Maybe (ArrayIndex, NumArrayIndices))+lockArrays = makeStateVar getLockArrays setLockArrays++getLockArrays :: IO (Maybe (ArrayIndex, NumArrayIndices))+getLockArrays = do+   count <- getInteger1 fromIntegral GetArrayElementLockCount+   if count > 0+      then do first <- getInteger1 id GetArrayElementLockFirst+              return $ Just (first, count)+      else return Nothing++setLockArrays :: Maybe (ArrayIndex, NumArrayIndices) -> IO ()+setLockArrays = maybe glUnlockArrays (uncurry glLockArrays)++--------------------------------------------------------------------------------++primitiveRestartIndex :: StateVar (Maybe ArrayIndex)+primitiveRestartIndex =+   makeStateVarMaybe+      (return CapPrimitiveRestart)+      (getInteger1 id GetPrimitiveRestartIndex)+      (glPrimitiveRestartIndex . fromIntegral)++--------------------------------------------------------------------------------++-- We almost could use makeStateVarMaybe below, but, alas, this is client state.++primitiveRestartIndexNV :: StateVar (Maybe ArrayIndex)+primitiveRestartIndexNV =+   makeStateVar getPrimitiveRestartIndexNV setPrimitiveRestartIndexNV++getPrimitiveRestartIndexNV :: IO (Maybe ArrayIndex)+getPrimitiveRestartIndexNV = do+   on <- getBoolean1 unmarshalGLboolean GetPrimitiveRestartNV+   if on+      then fmap Just $ getInteger1 fromIntegral GetPrimitiveRestartIndexNV+      else return Nothing++setPrimitiveRestartIndexNV :: Maybe ArrayIndex -> IO ()+setPrimitiveRestartIndexNV maybeIdx = case maybeIdx of+   Nothing  -> glDisableClientState gl_PRIMITIVE_RESTART_NV+   Just idx -> do glEnableClientState gl_PRIMITIVE_RESTART_NV+                  glPrimitiveRestartIndexNV (fromIntegral idx)++--------------------------------------------------------------------------------++data GetPointervPName =+     VertexArrayPointer+   | NormalArrayPointer+   | ColorArrayPointer+   | IndexArrayPointer+   | TextureCoordArrayPointer+   | EdgeFlagArrayPointer+   | FogCoordArrayPointer+   | SecondaryColorArrayPointer+   | FeedbackBufferPointer+   | SelectionBufferPointer+   | WeightArrayPointer+   | MatrixIndexArrayPointer++marshalGetPointervPName :: GetPointervPName -> GLenum+marshalGetPointervPName x = case x of+   VertexArrayPointer -> gl_VERTEX_ARRAY_POINTER+   NormalArrayPointer -> gl_NORMAL_ARRAY_POINTER+   ColorArrayPointer -> gl_COLOR_ARRAY_POINTER+   IndexArrayPointer -> gl_INDEX_ARRAY_POINTER+   TextureCoordArrayPointer -> gl_TEXTURE_COORD_ARRAY_POINTER+   EdgeFlagArrayPointer -> gl_EDGE_FLAG_ARRAY_POINTER+   FogCoordArrayPointer -> gl_FOG_COORD_ARRAY_POINTER+   SecondaryColorArrayPointer -> gl_SECONDARY_COLOR_ARRAY_POINTER+   FeedbackBufferPointer -> gl_FEEDBACK_BUFFER_POINTER+   SelectionBufferPointer -> gl_SELECTION_BUFFER_POINTER+   WeightArrayPointer -> gl_WEIGHT_ARRAY_POINTER+   MatrixIndexArrayPointer -> gl_MATRIX_INDEX_ARRAY_POINTER++--------------------------------------------------------------------------------++getPointer :: GetPointervPName -> IO (Ptr a)+getPointer n = alloca $ \buf -> do+   glGetPointerv (marshalGetPointervPName n) buf+   peek buf++--------------------------------------------------------------------------------++vertexAttribPointer :: AttribLocation -> StateVar (IntegerHandling, VertexArrayDescriptor a)+vertexAttribPointer location =+   makeStateVar (getVertexAttribPointer_ location) (setVertexAttribPointer location)++getVertexAttribPointer_ :: AttribLocation -> IO (IntegerHandling, VertexArrayDescriptor a)+getVertexAttribPointer_ location = do+   i <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayInteger+   h <- if i+           then return KeepIntegral+           else do f <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayNormalized+                   return $ if f then ToNormalizedFloat else ToFloat+   n <- getVertexAttribInteger1 id location GetVertexAttribArraySize+   d <- getVertexAttribEnum1 unmarshalDataType location GetVertexAttribArrayType+   s <- getVertexAttribInteger1 fromIntegral location GetVertexAttribArrayStride+   p <- getVertexAttribPointer location VertexAttribArrayPointer+   return (h, VertexArrayDescriptor n d s p)++setVertexAttribPointer :: AttribLocation -> (IntegerHandling, VertexArrayDescriptor a) -> IO ()+setVertexAttribPointer (AttribLocation location) (h, VertexArrayDescriptor n d s p) = case h of+   ToFloat -> glVertexAttribPointer location n md (marshalGLboolean False) s p+   ToNormalizedFloat -> glVertexAttribPointer location n md (marshalGLboolean True) s p+   KeepIntegral -> glVertexAttribIPointer location n md s p+  where md = marshalDataType d++--------------------------------------------------------------------------------++vertexAttribArray :: AttribLocation -> StateVar Capability+vertexAttribArray location =+   makeStateVar (getVertexAttribArray location) (flip setVertexAttribArray location)++getVertexAttribArray :: AttribLocation -> IO Capability+getVertexAttribArray location =+   getVertexAttribBoolean1 unmarshalCapability location GetVertexAttribArrayEnabled++setVertexAttribArray :: Capability -> AttribLocation -> IO ()+setVertexAttribArray Disabled (AttribLocation location) = glDisableVertexAttribArray location+setVertexAttribArray Enabled (AttribLocation location) = glEnableVertexAttribArray location
Graphics/Rendering/OpenGL/GL/VertexAttributes.hs view
@@ -1,332 +1,332 @@-{-# LANGUAGE DeriveDataTypeable #-}
-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.VertexAttributes
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
-
-import Control.Applicative
-import Control.Monad
-import Data.Foldable
-import Data.Ix
-import Data.Traversable
-import Data.Typeable
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-
---------------------------------------------------------------------------------
-
--- | Texture coordinates with /t/=0, /r/=0, and /q/=1.
-newtype TexCoord1 a = TexCoord1 a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord1 where
-   fmap f (TexCoord1 x) = TexCoord1 (f x)
-
-instance Applicative TexCoord1 where
-   pure a = TexCoord1 a
-   TexCoord1 f <*> TexCoord1 x = TexCoord1 (f x)
-
-instance Foldable TexCoord1 where
-   foldr f a (TexCoord1 x) = x `f ` a
-   foldl f a (TexCoord1 x) = a `f` x
-   foldr1 _ (TexCoord1 x) = x
-   foldl1 _ (TexCoord1 x) = x
-
-instance Traversable TexCoord1 where
-   traverse f (TexCoord1 x) = pure TexCoord1 <*> f x
-   sequenceA (TexCoord1 x) =  pure TexCoord1 <*> x
-   mapM f (TexCoord1 x) = return TexCoord1 `ap` f x
-   sequence (TexCoord1 x) = return TexCoord1 `ap` x
-
-instance Storable a => Storable (TexCoord1 a) where
-   sizeOf    ~(TexCoord1 s) = sizeOf s
-   alignment ~(TexCoord1 s) = alignment s
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | Texture coordinates with /r/=0 and /q/=1.
-data TexCoord2 a = TexCoord2 !a !a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord2 where
-   fmap f (TexCoord2 x y) = TexCoord2 (f x) (f y)
-
-instance Applicative TexCoord2 where
-   pure a = TexCoord2 a a
-   TexCoord2 f g <*> TexCoord2 x y = TexCoord2 (f x) (g y)
-
-instance Foldable TexCoord2 where
-   foldr f a (TexCoord2 x y) = x `f ` (y `f` a)
-   foldl f a (TexCoord2 x y) = (a `f` x) `f` y
-   foldr1 f (TexCoord2 x y) = x `f` y
-   foldl1 f (TexCoord2 x y) = x `f` y
-
-instance Traversable TexCoord2 where
-   traverse f (TexCoord2 x y) = pure TexCoord2 <*> f x <*> f y
-   sequenceA (TexCoord2 x y) =  pure TexCoord2 <*> x <*> y
-   mapM f (TexCoord2 x y) = return TexCoord2 `ap` f x `ap` f y
-   sequence (TexCoord2 x y) = return TexCoord2 `ap` x `ap` y
-
-instance Storable a => Storable (TexCoord2 a) where
-   sizeOf ~(TexCoord2 x _) = 2 * sizeOf x
-   alignment ~(TexCoord2 x _) = alignment x
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | Texture coordinates with /q/=1.
-data TexCoord3 a = TexCoord3 !a !a !a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord3 where
-   fmap f (TexCoord3 x y z) = TexCoord3 (f x) (f y) (f z)
-
-instance Applicative TexCoord3 where
-   pure a = TexCoord3 a a a
-   TexCoord3 f g h <*> TexCoord3 x y z = TexCoord3 (f x) (g y) (h z)
-
-instance Foldable TexCoord3 where
-   foldr f a (TexCoord3 x y z) = x `f ` (y `f` (z `f` a))
-   foldl f a (TexCoord3 x y z) = ((a `f` x) `f` y) `f` z
-   foldr1 f (TexCoord3 x y z) = x `f` (y `f` z)
-   foldl1 f (TexCoord3 x y z) = (x `f` y) `f` z
-
-instance Traversable TexCoord3 where
-   traverse f (TexCoord3 x y z) = pure TexCoord3 <*> f x <*> f y <*> f z
-   sequenceA (TexCoord3 x y z) =  pure TexCoord3 <*> x <*> y <*> z
-   mapM f (TexCoord3 x y z) = return TexCoord3 `ap` f x `ap` f y `ap` f z
-   sequence (TexCoord3 x y z) = return TexCoord3 `ap` x `ap` y `ap` z
-
-instance Storable a => Storable (TexCoord3 a) where
-   sizeOf ~(TexCoord3 x _ _) = 3 * sizeOf x
-   alignment ~(TexCoord3 x _ _) = alignment x
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | Fully-fledged four-dimensional texture coordinates.
-data TexCoord4 a = TexCoord4 !a !a !a !a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord4 where
-   fmap f (TexCoord4 x y z w) = TexCoord4 (f x) (f y) (f z) (f w)
-
-instance Applicative TexCoord4 where
-   pure a = TexCoord4 a a a a
-   TexCoord4 f g h i <*> TexCoord4 x y z w = TexCoord4 (f x) (g y) (h z) (i w)
-
-instance Foldable TexCoord4 where
-   foldr f a (TexCoord4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))
-   foldl f a (TexCoord4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w
-   foldr1 f (TexCoord4 x y z w) = x `f` (y `f` (z `f` w))
-   foldl1 f (TexCoord4 x y z w) = ((x `f` y) `f` z) `f` w
-
-instance Traversable TexCoord4 where
-   traverse f (TexCoord4 x y z w) = pure TexCoord4 <*> f x <*> f y <*> f z <*> f w
-   sequenceA (TexCoord4 x y z w) =  pure TexCoord4 <*> x <*> y <*> z <*> w
-   mapM f (TexCoord4 x y z w) = return TexCoord4 `ap` f x `ap` f y `ap` f z `ap` f w
-   sequence (TexCoord4 x y z w) = return TexCoord4 `ap` x `ap` y `ap` z `ap` w
-
-instance Storable a => Storable (TexCoord4 a) where
-   sizeOf ~(TexCoord4 x _ _ _) = 4 * sizeOf x
-   alignment ~(TexCoord4 x _ _ _) = alignment x
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- A three-dimensional normal.
-data Normal3 a = Normal3 !a !a !a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable) 
-instance Functor Normal3 where
-   fmap f (Normal3 x y z) = Normal3 (f x) (f y) (f z)
-
-instance Applicative Normal3 where
-   pure a = Normal3 a a a
-   Normal3 f g h <*> Normal3 x y z = Normal3 (f x) (g y) (h z)
-
-instance Foldable Normal3 where
-   foldr f a (Normal3 x y z) = x `f ` (y `f` (z `f` a))
-   foldl f a (Normal3 x y z) = ((a `f` x) `f` y) `f` z
-   foldr1 f (Normal3 x y z) = x `f` (y `f` z)
-   foldl1 f (Normal3 x y z) = (x `f` y) `f` z
-
-instance Traversable Normal3 where
-   traverse f (Normal3 x y z) = pure Normal3 <*> f x <*> f y <*> f z
-   sequenceA (Normal3 x y z) =  pure Normal3 <*> x <*> y <*> z
-   mapM f (Normal3 x y z) = return Normal3 `ap` f x `ap` f y `ap` f z
-   sequence (Normal3 x y z) = return Normal3 `ap` x `ap` y `ap` z
-
-instance Storable a => Storable (Normal3 a) where
-   sizeOf ~(Normal3 x _ _) = 3 * sizeOf x
-   alignment ~(Normal3 x _ _) = alignment x
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | A fog coordinate.
-newtype FogCoord1 a = FogCoord1 a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor FogCoord1 where
-   fmap f (FogCoord1 x) = FogCoord1 (f x)
-
-instance Applicative FogCoord1 where
-   pure a = FogCoord1 a
-   FogCoord1 f <*> FogCoord1 x = FogCoord1 (f x)
-
-instance Foldable FogCoord1 where
-   foldr f a (FogCoord1 x) = x `f ` a
-   foldl f a (FogCoord1 x)  = a `f` x
-   foldr1 _ (FogCoord1 x) = x
-   foldl1 _ (FogCoord1 x) = x
-
-instance Traversable FogCoord1 where
-   traverse f (FogCoord1 x) = pure FogCoord1 <*> f x
-   sequenceA (FogCoord1 x) =  pure FogCoord1 <*> x
-   mapM f (FogCoord1 x) = return FogCoord1 `ap` f x
-   sequence (FogCoord1 x) = return FogCoord1 `ap` x
-
-instance Storable a => Storable (FogCoord1 a) where
-   sizeOf    ~(FogCoord1 s) = sizeOf s
-   alignment ~(FogCoord1 s) = alignment s
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- An RGBA color with /A/=1.
-data Color3 a = Color3 !a !a !a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor Color3 where
-   fmap f (Color3 x y z) = Color3 (f x) (f y) (f z)
-
-instance Applicative Color3 where
-   pure a = Color3 a a a
-   Color3 f g h <*> Color3 x y z = Color3 (f x) (g y) (h z)
-
-instance Foldable Color3 where
-   foldr f a (Color3 x y z) = x `f ` (y `f` (z `f` a))
-   foldl f a (Color3 x y z) = ((a `f` x) `f` y) `f` z
-   foldr1 f (Color3 x y z) = x `f` (y `f` z)
-   foldl1 f (Color3 x y z) = (x `f` y) `f` z
-
-instance Traversable Color3 where
-   traverse f (Color3 x y z) = pure Color3 <*> f x <*> f y <*> f z
-   sequenceA (Color3 x y z) =  pure Color3 <*> x <*> y <*> z
-   mapM f (Color3 x y z) = return Color3 `ap` f x `ap` f y `ap` f z
-   sequence (Color3 x y z) = return Color3 `ap` x `ap` y `ap` z
-
-instance Storable a => Storable (Color3 a) where
-   sizeOf ~(Color3 x _ _) = 3 * sizeOf x
-   alignment ~(Color3 x _ _) = alignment x
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | A fully-fledged RGBA color.
-data Color4 a = Color4 !a !a !a !a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor Color4 where
-   fmap f (Color4 x y z w) = Color4 (f x) (f y) (f z) (f w)
-
-instance Applicative Color4 where
-   pure a = Color4 a a a a
-   Color4 f g h i <*> Color4 x y z w = Color4 (f x) (g y) (h z) (i w)
-
-instance Foldable Color4 where
-   foldr f a (Color4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))
-   foldl f a (Color4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w
-   foldr1 f (Color4 x y z w) = x `f` (y `f` (z `f` w))
-   foldl1 f (Color4 x y z w) = ((x `f` y) `f` z) `f` w
-
-instance Traversable Color4 where
-   traverse f (Color4 x y z w) = pure Color4 <*> f x <*> f y <*> f z <*> f w
-   sequenceA (Color4 x y z w) =  pure Color4 <*> x <*> y <*> z <*> w
-   mapM f (Color4 x y z w) = return Color4 `ap` f x `ap` f y `ap` f z `ap` f w
-   sequence (Color4 x y z w) = return Color4 `ap` x `ap` y `ap` z `ap` w
-
-instance Storable a => Storable (Color4 a) where
-   sizeOf ~(Color4 x _ _ _) = 4 * sizeOf x
-   alignment ~(Color4 x _ _ _) = alignment x
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | A color index.
-newtype Index1 a = Index1 a
-   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor Index1 where
-   fmap f (Index1 x) = Index1 (f x)
-
-instance Applicative Index1 where
-   pure a = Index1 a
-   Index1 f <*> Index1 x = Index1 (f x)
-
-instance Foldable Index1 where
-   foldr f a (Index1 x) = x `f ` a
-   foldl f a (Index1 x)  = a `f` x
-   foldr1 _ (Index1 x) = x
-   foldl1 _ (Index1 x) = x
-
-instance Traversable Index1 where
-   traverse f (Index1 x) = pure Index1 <*> f x
-   sequenceA (Index1 x) =  pure Index1 <*> x
-   mapM f (Index1 x) = return Index1 `ap` f x
-   sequence (Index1 x) = return Index1 `ap` x
-
-instance Storable a => Storable (Index1 a) where
-   sizeOf    ~(Index1 s) = sizeOf s
-   alignment ~(Index1 s) = alignment s
-   peek = peekApplicativeTraversable
-   poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
-peekApplicativeTraversable :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> IO (t a)
-peekApplicativeTraversable = Data.Traversable.mapM peek . addresses
-
-addresses :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> t (Ptr a)
-addresses = snd . mapAccumL nextPtr 0 . pure . castPtr
-
-nextPtr :: Storable a => Int -> Ptr a -> (Int, Ptr a)
-nextPtr offset ptr = (offset + 1, advancePtr ptr offset)
-
---------------------------------------------------------------------------------
-
-pokeFoldable :: (Foldable t, Storable a) => Ptr (t a) -> t a -> IO ()
-pokeFoldable ptr xs = foldlM pokeAndAdvance (castPtr ptr) xs >> return ()
-
-pokeAndAdvance :: Storable a => Ptr a -> a -> IO (Ptr a)
-pokeAndAdvance ptr value = do
-   poke ptr value
-   return $ ptr `plusPtr` sizeOf value
+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexAttributes+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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++import Control.Applicative+import Control.Monad+import Data.Foldable+import Data.Ix+import Data.Traversable+import Data.Typeable+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable++--------------------------------------------------------------------------------++-- | Texture coordinates with /t/=0, /r/=0, and /q/=1.+newtype TexCoord1 a = TexCoord1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord1 where+   fmap f (TexCoord1 x) = TexCoord1 (f x)++instance Applicative TexCoord1 where+   pure a = TexCoord1 a+   TexCoord1 f <*> TexCoord1 x = TexCoord1 (f x)++instance Foldable TexCoord1 where+   foldr f a (TexCoord1 x) = x `f ` a+   foldl f a (TexCoord1 x) = a `f` x+   foldr1 _ (TexCoord1 x) = x+   foldl1 _ (TexCoord1 x) = x++instance Traversable TexCoord1 where+   traverse f (TexCoord1 x) = pure TexCoord1 <*> f x+   sequenceA (TexCoord1 x) =  pure TexCoord1 <*> x+   mapM f (TexCoord1 x) = return TexCoord1 `ap` f x+   sequence (TexCoord1 x) = return TexCoord1 `ap` x++instance Storable a => Storable (TexCoord1 a) where+   sizeOf    ~(TexCoord1 s) = sizeOf s+   alignment ~(TexCoord1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | Texture coordinates with /r/=0 and /q/=1.+data TexCoord2 a = TexCoord2 !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord2 where+   fmap f (TexCoord2 x y) = TexCoord2 (f x) (f y)++instance Applicative TexCoord2 where+   pure a = TexCoord2 a a+   TexCoord2 f g <*> TexCoord2 x y = TexCoord2 (f x) (g y)++instance Foldable TexCoord2 where+   foldr f a (TexCoord2 x y) = x `f ` (y `f` a)+   foldl f a (TexCoord2 x y) = (a `f` x) `f` y+   foldr1 f (TexCoord2 x y) = x `f` y+   foldl1 f (TexCoord2 x y) = x `f` y++instance Traversable TexCoord2 where+   traverse f (TexCoord2 x y) = pure TexCoord2 <*> f x <*> f y+   sequenceA (TexCoord2 x y) =  pure TexCoord2 <*> x <*> y+   mapM f (TexCoord2 x y) = return TexCoord2 `ap` f x `ap` f y+   sequence (TexCoord2 x y) = return TexCoord2 `ap` x `ap` y++instance Storable a => Storable (TexCoord2 a) where+   sizeOf ~(TexCoord2 x _) = 2 * sizeOf x+   alignment ~(TexCoord2 x _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | Texture coordinates with /q/=1.+data TexCoord3 a = TexCoord3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord3 where+   fmap f (TexCoord3 x y z) = TexCoord3 (f x) (f y) (f z)++instance Applicative TexCoord3 where+   pure a = TexCoord3 a a a+   TexCoord3 f g h <*> TexCoord3 x y z = TexCoord3 (f x) (g y) (h z)++instance Foldable TexCoord3 where+   foldr f a (TexCoord3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (TexCoord3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (TexCoord3 x y z) = x `f` (y `f` z)+   foldl1 f (TexCoord3 x y z) = (x `f` y) `f` z++instance Traversable TexCoord3 where+   traverse f (TexCoord3 x y z) = pure TexCoord3 <*> f x <*> f y <*> f z+   sequenceA (TexCoord3 x y z) =  pure TexCoord3 <*> x <*> y <*> z+   mapM f (TexCoord3 x y z) = return TexCoord3 `ap` f x `ap` f y `ap` f z+   sequence (TexCoord3 x y z) = return TexCoord3 `ap` x `ap` y `ap` z++instance Storable a => Storable (TexCoord3 a) where+   sizeOf ~(TexCoord3 x _ _) = 3 * sizeOf x+   alignment ~(TexCoord3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | Fully-fledged four-dimensional texture coordinates.+data TexCoord4 a = TexCoord4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor TexCoord4 where+   fmap f (TexCoord4 x y z w) = TexCoord4 (f x) (f y) (f z) (f w)++instance Applicative TexCoord4 where+   pure a = TexCoord4 a a a a+   TexCoord4 f g h i <*> TexCoord4 x y z w = TexCoord4 (f x) (g y) (h z) (i w)++instance Foldable TexCoord4 where+   foldr f a (TexCoord4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (TexCoord4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (TexCoord4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (TexCoord4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable TexCoord4 where+   traverse f (TexCoord4 x y z w) = pure TexCoord4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (TexCoord4 x y z w) =  pure TexCoord4 <*> x <*> y <*> z <*> w+   mapM f (TexCoord4 x y z w) = return TexCoord4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (TexCoord4 x y z w) = return TexCoord4 `ap` x `ap` y `ap` z `ap` w++instance Storable a => Storable (TexCoord4 a) where+   sizeOf ~(TexCoord4 x _ _ _) = 4 * sizeOf x+   alignment ~(TexCoord4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- A three-dimensional normal.+data Normal3 a = Normal3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable) +instance Functor Normal3 where+   fmap f (Normal3 x y z) = Normal3 (f x) (f y) (f z)++instance Applicative Normal3 where+   pure a = Normal3 a a a+   Normal3 f g h <*> Normal3 x y z = Normal3 (f x) (g y) (h z)++instance Foldable Normal3 where+   foldr f a (Normal3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Normal3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Normal3 x y z) = x `f` (y `f` z)+   foldl1 f (Normal3 x y z) = (x `f` y) `f` z++instance Traversable Normal3 where+   traverse f (Normal3 x y z) = pure Normal3 <*> f x <*> f y <*> f z+   sequenceA (Normal3 x y z) =  pure Normal3 <*> x <*> y <*> z+   mapM f (Normal3 x y z) = return Normal3 `ap` f x `ap` f y `ap` f z+   sequence (Normal3 x y z) = return Normal3 `ap` x `ap` y `ap` z++instance Storable a => Storable (Normal3 a) where+   sizeOf ~(Normal3 x _ _) = 3 * sizeOf x+   alignment ~(Normal3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A fog coordinate.+newtype FogCoord1 a = FogCoord1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor FogCoord1 where+   fmap f (FogCoord1 x) = FogCoord1 (f x)++instance Applicative FogCoord1 where+   pure a = FogCoord1 a+   FogCoord1 f <*> FogCoord1 x = FogCoord1 (f x)++instance Foldable FogCoord1 where+   foldr f a (FogCoord1 x) = x `f ` a+   foldl f a (FogCoord1 x)  = a `f` x+   foldr1 _ (FogCoord1 x) = x+   foldl1 _ (FogCoord1 x) = x++instance Traversable FogCoord1 where+   traverse f (FogCoord1 x) = pure FogCoord1 <*> f x+   sequenceA (FogCoord1 x) =  pure FogCoord1 <*> x+   mapM f (FogCoord1 x) = return FogCoord1 `ap` f x+   sequence (FogCoord1 x) = return FogCoord1 `ap` x++instance Storable a => Storable (FogCoord1 a) where+   sizeOf    ~(FogCoord1 s) = sizeOf s+   alignment ~(FogCoord1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- An RGBA color with /A/=1.+data Color3 a = Color3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Color3 where+   fmap f (Color3 x y z) = Color3 (f x) (f y) (f z)++instance Applicative Color3 where+   pure a = Color3 a a a+   Color3 f g h <*> Color3 x y z = Color3 (f x) (g y) (h z)++instance Foldable Color3 where+   foldr f a (Color3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Color3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Color3 x y z) = x `f` (y `f` z)+   foldl1 f (Color3 x y z) = (x `f` y) `f` z++instance Traversable Color3 where+   traverse f (Color3 x y z) = pure Color3 <*> f x <*> f y <*> f z+   sequenceA (Color3 x y z) =  pure Color3 <*> x <*> y <*> z+   mapM f (Color3 x y z) = return Color3 `ap` f x `ap` f y `ap` f z+   sequence (Color3 x y z) = return Color3 `ap` x `ap` y `ap` z++instance Storable a => Storable (Color3 a) where+   sizeOf ~(Color3 x _ _) = 3 * sizeOf x+   alignment ~(Color3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A fully-fledged RGBA color.+data Color4 a = Color4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Color4 where+   fmap f (Color4 x y z w) = Color4 (f x) (f y) (f z) (f w)++instance Applicative Color4 where+   pure a = Color4 a a a a+   Color4 f g h i <*> Color4 x y z w = Color4 (f x) (g y) (h z) (i w)++instance Foldable Color4 where+   foldr f a (Color4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (Color4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (Color4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (Color4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable Color4 where+   traverse f (Color4 x y z w) = pure Color4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (Color4 x y z w) =  pure Color4 <*> x <*> y <*> z <*> w+   mapM f (Color4 x y z w) = return Color4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (Color4 x y z w) = return Color4 `ap` x `ap` y `ap` z `ap` w++instance Storable a => Storable (Color4 a) where+   sizeOf ~(Color4 x _ _ _) = 4 * sizeOf x+   alignment ~(Color4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A color index.+newtype Index1 a = Index1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)++instance Functor Index1 where+   fmap f (Index1 x) = Index1 (f x)++instance Applicative Index1 where+   pure a = Index1 a+   Index1 f <*> Index1 x = Index1 (f x)++instance Foldable Index1 where+   foldr f a (Index1 x) = x `f ` a+   foldl f a (Index1 x)  = a `f` x+   foldr1 _ (Index1 x) = x+   foldl1 _ (Index1 x) = x++instance Traversable Index1 where+   traverse f (Index1 x) = pure Index1 <*> f x+   sequenceA (Index1 x) =  pure Index1 <*> x+   mapM f (Index1 x) = return Index1 `ap` f x+   sequence (Index1 x) = return Index1 `ap` x++instance Storable a => Storable (Index1 a) where+   sizeOf    ~(Index1 s) = sizeOf s+   alignment ~(Index1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++peekApplicativeTraversable :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> IO (t a)+peekApplicativeTraversable = Data.Traversable.mapM peek . addresses++addresses :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> t (Ptr a)+addresses = snd . mapAccumL nextPtr 0 . pure . castPtr++nextPtr :: Storable a => Int -> Ptr a -> (Int, Ptr a)+nextPtr offset ptr = (offset + 1, advancePtr ptr offset)++--------------------------------------------------------------------------------++pokeFoldable :: (Foldable t, Storable a) => Ptr (t a) -> t a -> IO ()+pokeFoldable ptr xs = foldlM pokeAndAdvance (castPtr ptr) xs >> return ()++pokeAndAdvance :: Storable a => Ptr a -> a -> IO (Ptr a)+pokeAndAdvance ptr value = do+   poke ptr value+   return $ ptr `plusPtr` sizeOf value
Graphics/Rendering/OpenGL/GL/VertexSpec.hs view
@@ -1,992 +1,992 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GL.VertexSpec
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
-import Graphics.Rendering.OpenGL.GL.VertexAttributes
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
--- | 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)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GL.VertexSpec+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 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.StateVar+import Graphics.Rendering.OpenGL.GL.Tensor+import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit+import Graphics.Rendering.OpenGL.GL.VertexAttributes+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++-- | 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)
Graphics/Rendering/OpenGL/GLU.hs view
@@ -1,31 +1,31 @@------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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
+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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
Graphics/Rendering/OpenGL/GLU/Errors.hs view
@@ -1,34 +1,34 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.Errors
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Graphics.Rendering.OpenGL.GL.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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Errors+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal++--------------------------------------------------------------------------------++-- | When an error occurs, it is recorded in this state variable and no further+-- errors are recorded. Reading 'errors' returns the currently recorded errors+-- (there may be more than one due to a possibly distributed implementation) and+-- resets the state variable to @[]@, re-enabling the recording of future+-- errors. The value @[]@ means that there has been no detectable error since+-- the last time 'errors' was read, or since the GL was initialized.++errors :: GettableStateVar [Error]+errors = makeGettableStateVar getErrors
Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs view
@@ -1,170 +1,170 @@-{-# OPTIONS_GHC -fno-cse #-}
-
-{-# OPTIONS_HADDOCK hide #-}
---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.ErrorsInternal
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.C.String ( peekCString )
-import Foreign.Ptr ( castPtr )
-import Graphics.Rendering.GLU.Raw
-import Graphics.Rendering.OpenGL.Raw
-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
-   = InvalidEnum
-   | InvalidValue
-   | InvalidOperation
-   | InvalidFramebufferOperation
-   | OutOfMemory
-   | StackOverflow
-   | StackUnderflow
-   | TableTooLarge
-   | TesselatorError
-   | NURBSError
-   deriving ( Eq, Ord, Show )
-
-unmarshalErrorCategory :: GLenum -> ErrorCategory
-unmarshalErrorCategory c
-   | isInvalidEnum c      = InvalidEnum
-   | isInvalidValue c     = InvalidValue
-   | isInvalidOperation c = InvalidOperation
-   | isInvalidFramebufferOperation c = InvalidFramebufferOperation
-   | isOutOfMemory c      = OutOfMemory
-   | isStackOverflow c    = StackOverflow
-   | isStackUnderflow c   = StackUnderflow
-   | isTableTooLarge c    = TableTooLarge
-   | isTesselatorError c  = TesselatorError
-   | isNURBSError c       = NURBSError
-   | otherwise = error "unmarshalErrorCategory"
-
-isInvalidEnum :: GLenum -> Bool
-isInvalidEnum c = c == gl_INVALID_ENUM || c == glu_INVALID_ENUM
-
-isInvalidValue :: GLenum -> Bool
-isInvalidValue c = c == gl_INVALID_VALUE || c == glu_INVALID_VALUE
-
-isInvalidOperation :: GLenum -> Bool
-isInvalidOperation c = c == gl_INVALID_OPERATION || c == glu_INVALID_OPERATION
-
-isInvalidFramebufferOperation :: GLenum -> Bool
-isInvalidFramebufferOperation c = c == gl_INVALID_FRAMEBUFFER_OPERATION
-
-isOutOfMemory :: GLenum -> Bool
-isOutOfMemory c = c == gl_OUT_OF_MEMORY || c == glu_OUT_OF_MEMORY
-
-isStackOverflow :: GLenum -> Bool
-isStackOverflow c = c == gl_STACK_OVERFLOW
-
-isStackUnderflow :: GLenum -> Bool
-isStackUnderflow c = c == gl_STACK_UNDERFLOW
-
-isTableTooLarge :: GLenum -> Bool
-isTableTooLarge c = c == gl_TABLE_TOO_LARGE
-
-isTesselatorError :: GLenum -> Bool
-isTesselatorError c = glu_TESS_ERROR1 <= c && c <= glu_TESS_ERROR8
-
-isNURBSError :: GLenum -> Bool
-isNURBSError c = glu_NURBS_ERROR1 <= c && c <= glu_NURBS_ERROR37
-
---------------------------------------------------------------------------------
-
--- The returned error string is statically allocated, so peekCString
--- does the right thing here. No malloc/free necessary here.
-
-makeError :: GLenum -> IO Error
-makeError e = do
-   let category = unmarshalErrorCategory e
-   ptr <- gluErrorString e
-   description <- peekCString (castPtr ptr)
-   return $ Error category description
-
---------------------------------------------------------------------------------
-
--- This seems to be a common Haskell hack nowadays: A plain old global variable
--- with an associated getter and mutator. Perhaps some language/library support
--- is needed?
-
-{-# NOINLINE theRecordedErrors #-}
-theRecordedErrors :: IORef ([GLenum],Bool)
-theRecordedErrors = unsafePerformIO (newIORef ([], True))
-
-getRecordedErrors :: IO ([GLenum],Bool)
-getRecordedErrors =  readIORef theRecordedErrors
-
-setRecordedErrors :: ([GLenum],Bool) -> IO ()
-setRecordedErrors = writeIORef theRecordedErrors
-
---------------------------------------------------------------------------------
-
-getGLErrors :: IO [GLenum]
-getGLErrors = getGLErrorsAux []
-   where getGLErrorsAux acc = do
-            errorCode <- glGetError
-            if isError errorCode
-               then getGLErrorsAux (errorCode : acc)
-               else return $ reverse acc
-
-isError :: GLenum -> Bool
-isError = (/= gl_NO_ERROR)
-
---------------------------------------------------------------------------------
-
-getErrors :: IO [Error]
-getErrors = do
-   es <- getErrorCodesAux (const ([], True))
-   mapM makeError es
-
-recordErrorCode :: GLenum -> IO ()
-recordErrorCode e = do
-   -- We don't need the return value because this calls setRecordedErrors
-   _ <- getErrorCodesAux (\es -> (if null es then [e] else [], False))
-   return ()
-
-recordInvalidEnum :: IO ()
-recordInvalidEnum = recordErrorCode gl_INVALID_ENUM
-
-recordInvalidValue :: IO ()
-recordInvalidValue = recordErrorCode gl_INVALID_VALUE
-
-recordOutOfMemory :: IO ()
-recordOutOfMemory = recordErrorCode gl_OUT_OF_MEMORY
-
--- ToDo: Make this thread-safe
-getErrorCodesAux :: ([GLenum] -> ([GLenum],Bool)) -> IO [GLenum]
-getErrorCodesAux f = do
-   (recordedErrors, useGLErrors) <- getRecordedErrors
-   glErrors <- getGLErrors
-   let es = if useGLErrors then recordedErrors ++ glErrors else recordedErrors
-   setRecordedErrors (f es)
-   return es
+{-# OPTIONS_GHC -fno-cse #-}++{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.ErrorsInternal+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.C.String ( peekCString )+import Foreign.Ptr ( castPtr )+import Graphics.Rendering.GLU.Raw+import Graphics.Rendering.OpenGL.Raw+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+   = InvalidEnum+   | InvalidValue+   | InvalidOperation+   | InvalidFramebufferOperation+   | OutOfMemory+   | StackOverflow+   | StackUnderflow+   | TableTooLarge+   | TesselatorError+   | NURBSError+   deriving ( Eq, Ord, Show )++unmarshalErrorCategory :: GLenum -> ErrorCategory+unmarshalErrorCategory c+   | isInvalidEnum c      = InvalidEnum+   | isInvalidValue c     = InvalidValue+   | isInvalidOperation c = InvalidOperation+   | isInvalidFramebufferOperation c = InvalidFramebufferOperation+   | isOutOfMemory c      = OutOfMemory+   | isStackOverflow c    = StackOverflow+   | isStackUnderflow c   = StackUnderflow+   | isTableTooLarge c    = TableTooLarge+   | isTesselatorError c  = TesselatorError+   | isNURBSError c       = NURBSError+   | otherwise = error "unmarshalErrorCategory"++isInvalidEnum :: GLenum -> Bool+isInvalidEnum c = c == gl_INVALID_ENUM || c == glu_INVALID_ENUM++isInvalidValue :: GLenum -> Bool+isInvalidValue c = c == gl_INVALID_VALUE || c == glu_INVALID_VALUE++isInvalidOperation :: GLenum -> Bool+isInvalidOperation c = c == gl_INVALID_OPERATION || c == glu_INVALID_OPERATION++isInvalidFramebufferOperation :: GLenum -> Bool+isInvalidFramebufferOperation c = c == gl_INVALID_FRAMEBUFFER_OPERATION++isOutOfMemory :: GLenum -> Bool+isOutOfMemory c = c == gl_OUT_OF_MEMORY || c == glu_OUT_OF_MEMORY++isStackOverflow :: GLenum -> Bool+isStackOverflow c = c == gl_STACK_OVERFLOW++isStackUnderflow :: GLenum -> Bool+isStackUnderflow c = c == gl_STACK_UNDERFLOW++isTableTooLarge :: GLenum -> Bool+isTableTooLarge c = c == gl_TABLE_TOO_LARGE++isTesselatorError :: GLenum -> Bool+isTesselatorError c = glu_TESS_ERROR1 <= c && c <= glu_TESS_ERROR8++isNURBSError :: GLenum -> Bool+isNURBSError c = glu_NURBS_ERROR1 <= c && c <= glu_NURBS_ERROR37++--------------------------------------------------------------------------------++-- The returned error string is statically allocated, so peekCString+-- does the right thing here. No malloc/free necessary here.++makeError :: GLenum -> IO Error+makeError e = do+   let category = unmarshalErrorCategory e+   ptr <- gluErrorString e+   description <- peekCString (castPtr ptr)+   return $ Error category description++--------------------------------------------------------------------------------++-- This seems to be a common Haskell hack nowadays: A plain old global variable+-- with an associated getter and mutator. Perhaps some language/library support+-- is needed?++{-# NOINLINE theRecordedErrors #-}+theRecordedErrors :: IORef ([GLenum],Bool)+theRecordedErrors = unsafePerformIO (newIORef ([], True))++getRecordedErrors :: IO ([GLenum],Bool)+getRecordedErrors =  readIORef theRecordedErrors++setRecordedErrors :: ([GLenum],Bool) -> IO ()+setRecordedErrors = writeIORef theRecordedErrors++--------------------------------------------------------------------------------++getGLErrors :: IO [GLenum]+getGLErrors = getGLErrorsAux []+   where getGLErrorsAux acc = do+            errorCode <- glGetError+            if isError errorCode+               then getGLErrorsAux (errorCode : acc)+               else return $ reverse acc++isError :: GLenum -> Bool+isError = (/= gl_NO_ERROR)++--------------------------------------------------------------------------------++getErrors :: IO [Error]+getErrors = do+   es <- getErrorCodesAux (const ([], True))+   mapM makeError es++recordErrorCode :: GLenum -> IO ()+recordErrorCode e = do+   -- We don't need the return value because this calls setRecordedErrors+   _ <- getErrorCodesAux (\es -> (if null es then [e] else [], False))+   return ()++recordInvalidEnum :: IO ()+recordInvalidEnum = recordErrorCode gl_INVALID_ENUM++recordInvalidValue :: IO ()+recordInvalidValue = recordErrorCode gl_INVALID_VALUE++recordOutOfMemory :: IO ()+recordOutOfMemory = recordErrorCode gl_OUT_OF_MEMORY++-- ToDo: Make this thread-safe+getErrorCodesAux :: ([GLenum] -> ([GLenum],Bool)) -> IO [GLenum]+getErrorCodesAux f = do+   (recordedErrors, useGLErrors) <- getRecordedErrors+   glErrors <- getGLErrors+   let es = if useGLErrors then recordedErrors ++ glErrors else recordedErrors+   setRecordedErrors (f es)+   return es
Graphics/Rendering/OpenGL/GLU/Initialization.hs view
@@ -1,36 +1,36 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.Initialization
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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 Foreign.C.String
-import Foreign.Ptr
-import Graphics.Rendering.GLU.Raw
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-gluVersion :: GettableStateVar String
-gluVersion = makeGettableStateVar (getString glu_VERSION)
-
-gluExtensions :: GettableStateVar [String]
-gluExtensions = makeGettableStateVar (fmap words $ getString glu_EXTENSIONS)
-
-getString :: GLenum -> IO String
-getString n = gluGetString n >>=
-              maybeNullPtr (return "") (peekCString . castPtr)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Initialization+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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 Foreign.C.String+import Foreign.Ptr+import Graphics.Rendering.GLU.Raw+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GL.StateVar+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++gluVersion :: GettableStateVar String+gluVersion = makeGettableStateVar (getString glu_VERSION)++gluExtensions :: GettableStateVar [String]+gluExtensions = makeGettableStateVar (fmap words $ getString glu_EXTENSIONS)++getString :: GLenum -> IO String+getString n = gluGetString n >>=+              maybeNullPtr (return "") (peekCString . castPtr)
Graphics/Rendering/OpenGL/GLU/Matrix.hs view
@@ -1,135 +1,135 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.Matrix
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.GLU.Raw
-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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
--- 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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Matrix+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.GLU.Raw+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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------+-- matrix setup++ortho2D :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()+ortho2D = gluOrtho2D+++perspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()+perspective = gluPerspective++lookAt :: Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble -> IO ()+lookAt (Vertex3 eyeX    eyeY    eyeZ)+       (Vertex3 centerX centerY centerZ)+       (Vector3 upX     upY     upZ) =+   gluLookAt eyeX eyeY eyeZ centerX centerY centerZ upX upY upZ++pickMatrix ::+   (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> (Position, Size) -> IO ()+pickMatrix (x, y) (w, h) viewPort =+   withViewport viewPort $ gluPickMatrix x y w h++--------------------------------------------------------------------------------+-- coordinate projection++project ::+      Matrix m+   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)+   -> IO (Vertex3 GLdouble)+project (Vertex3 objX objY objZ) model proj viewPort =+   withColumnMajor model $ \modelBuf ->+   withColumnMajor proj $ \projBuf ->+   withViewport viewPort $ \viewBuf ->+   getVertex3 $ gluProject objX objY objZ modelBuf projBuf viewBuf++unProject ::+      Matrix m+   => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)+   -> IO (Vertex3 GLdouble)+unProject (Vertex3 objX objY objZ) model proj viewPort =+   withColumnMajor model $ \modelBuf ->+   withColumnMajor proj $ \projBuf ->+   withViewport viewPort $ \viewBuf ->+   getVertex3 $ gluUnProject objX objY objZ modelBuf projBuf viewBuf++unProject4 ::+      Matrix m+   => Vertex4 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)+   -> GLclampd -> GLclampd+   -> IO (Vertex4 GLdouble)+unProject4 (Vertex4 objX objY objZ clipW) model proj viewPort near far =+   withColumnMajor model $ \modelBuf ->+   withColumnMajor proj $ \projBuf ->+   withViewport viewPort $ \viewBuf ->+   getVertex4 $+      gluUnProject4 objX objY objZ clipW modelBuf projBuf viewBuf near far++--------------------------------------------------------------------------------++withViewport :: (Position, Size) -> (Ptr GLint -> IO a ) -> IO a+withViewport (Position x y, Size w h) =+   withArray [ x, y, fromIntegral w, fromIntegral h ]++withColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO b) -> IO b+withColumnMajor mat act = withMatrix mat juggle+   where juggle ColumnMajor p = act p+         juggle RowMajor    p = do+            transposedElems <- mapM (peekElemOff p) [ 0, 4,  8, 12,+                                                      1, 5,  9, 13,+                                                      2, 6, 10, 14,+                                                      3, 7, 11, 15 ]+            withArray transposedElems act++getVertex3 ::+      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)+   -> IO (Vertex3 GLdouble)+getVertex3 act =+   alloca $ \xBuf ->+   alloca $ \yBuf ->+   alloca $ \zBuf -> do+   ok <- act xBuf yBuf zBuf+   if unmarshalGLboolean ok+      then do x <- peek xBuf+              y <- peek yBuf+              z <- peek zBuf+              return $ Vertex3 x y z+      else do recordInvalidValue+              return $ Vertex3 0 0 0++getVertex4 ::+      (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)+   -> IO (Vertex4 GLdouble)+getVertex4 act =+   alloca $ \xBuf ->+   alloca $ \yBuf ->+   alloca $ \zBuf ->+   alloca $ \wBuf -> do+   ok <- act xBuf yBuf zBuf wBuf+   if unmarshalGLboolean ok+      then do x <- peek xBuf+              y <- peek yBuf+              z <- peek zBuf+              w <- peek wBuf+              return $ Vertex4 x y z w+      else do recordInvalidValue+              return $ Vertex4 0 0 0 0
Graphics/Rendering/OpenGL/GLU/Mipmapping.hs view
@@ -1,64 +1,64 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.Mipmapping
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.GLU.Raw
-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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
--- 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?
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Mipmapping+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.GLU.Raw+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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------+-- 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?
Graphics/Rendering/OpenGL/GLU/NURBS.hs view
@@ -1,310 +1,310 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.NURBS
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.GLU.Raw 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.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
--- 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'
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.NURBS+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.GLU.Raw 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.VertexSpec+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------+-- chapter 7.1: The NURBS Object++-- an opaque pointer to a NURBS object+type NURBSObj = Ptr GLUnurbs++isNullNURBSObj :: NURBSObj -> Bool+isNullNURBSObj = (nullPtr ==)++withNURBSObj :: a -> (NURBSObj -> IO a) -> IO a+withNURBSObj failureValue action =+   bracket gluNewNurbsRenderer safeDeleteNurbsRenderer+           (\nurbsObj -> if isNullNURBSObj nurbsObj+                            then do recordOutOfMemory+                                    return failureValue+                            else action nurbsObj)++safeDeleteNurbsRenderer :: NURBSObj -> IO ()+safeDeleteNurbsRenderer nurbsObj =+   unless (isNullNURBSObj nurbsObj) $ gluDeleteNurbsRenderer nurbsObj++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (begin)++type NURBSBeginCallback = PrimitiveMode -> IO ()++withNURBSBeginCallback :: NURBSObj -> NURBSBeginCallback -> IO a -> IO a+withNURBSBeginCallback nurbsObj beginCallback action =+   bracket (makeNURBSBeginCallback (beginCallback . unmarshalPrimitiveMode))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj glu_NURBS_BEGIN callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (vertex)++type NURBSVertexCallback = Vertex3 GLfloat -> IO ()++withNURBSVertexCallback :: NURBSObj -> NURBSVertexCallback -> IO a -> IO a+withNURBSVertexCallback nurbsObj vertexCallback action =+   bracket (makeNURBSVertexCallback (\p -> peek (castPtr p) >>= vertexCallback))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj glu_NURBS_VERTEX callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (normal)++type NURBSNormalCallback = Normal3 GLfloat -> IO ()++withNURBSNormalCallback :: NURBSObj -> NURBSNormalCallback -> IO a -> IO a+withNURBSNormalCallback nurbsObj normalCallback action =+   bracket (makeNURBSNormalCallback (\p -> peek (castPtr p) >>= normalCallback))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj glu_NURBS_NORMAL callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (color)++type NURBSColorCallback = Color4 GLfloat -> IO ()++withNURBSColorCallback :: NURBSObj -> NURBSColorCallback -> IO a -> IO a+withNURBSColorCallback nurbsObj colorCallback action =+   bracket (makeNURBSColorCallback (\p -> peek (castPtr p) >>= colorCallback))+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj glu_NURBS_COLOR callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (end)++type NURBSEndCallback = IO ()++withNURBSEndCallback :: NURBSObj -> NURBSEndCallback -> IO a -> IO a+withNURBSEndCallback nurbsObj endCallback action =+   bracket (makeNURBSEndCallback endCallback)+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj glu_NURBS_END callbackPtr+      action++--------------------------------------------------------------------------------+-- chapter 7.2: Callbacks (error)++type ErrorCallback = GLenum -> IO ()++withErrorCallback :: NURBSObj -> ErrorCallback -> IO a -> IO a+withErrorCallback nurbsObj errorCallback action =+   bracket (makeNURBSErrorCallback errorCallback)+           freeHaskellFunPtr $ \callbackPtr -> do+      gluNurbsCallback nurbsObj glu_NURBS_ERROR callbackPtr+      action++checkForNURBSError :: NURBSObj -> IO a -> IO a+checkForNURBSError nurbsObj = withErrorCallback nurbsObj recordErrorCode++--------------------------------------------------------------------------------+-- chapter 7.3: NURBS Curves++nurbsBeginEndCurve :: NURBSObj -> IO a -> IO a+nurbsBeginEndCurve nurbsObj =+   bracket_ (gluBeginCurve nurbsObj) (gluEndCurve nurbsObj)+++nurbsCurve :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()+nurbsCurve nurbsObj knotCount knots stride control order =+   gluNurbsCurve nurbsObj knotCount knots stride (castPtr control) order (map1Target (pseudoPeek control))++pseudoPeek :: Ptr (c GLfloat) -> c GLfloat+pseudoPeek _ = undefined++--------------------------------------------------------------------------------+-- chapter 7.4: NURBS Surfaces++nurbsBeginEndSurface :: NURBSObj -> IO a -> IO a+nurbsBeginEndSurface nurbsObj =+   bracket_ (gluBeginSurface nurbsObj) (gluEndSurface nurbsObj)+++nurbsSurface :: ControlPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr GLfloat -> GLint -> GLint -> Ptr (c GLfloat) -> GLint -> GLint -> IO ()+nurbsSurface nurbsObj sKnotCount sKnots tKnotCount tKnots sStride tStride control sOrder tOrder =+   gluNurbsSurface nurbsObj sKnotCount sKnots tKnotCount tKnots sStride tStride (castPtr control) sOrder tOrder (map2Target (pseudoPeek control))++--------------------------------------------------------------------------------+-- chapter 7.5: Trimming++class TrimmingPoint p where+   trimmingTarget :: p GLfloat -> GLenum++instance TrimmingPoint Vertex2 where+   trimmingTarget = const glu_MAP1_TRIM_2++instance TrimmingPoint Vertex3 where+   trimmingTarget = const glu_MAP1_TRIM_3++nurbsBeginEndTrim :: NURBSObj -> IO a -> IO a+nurbsBeginEndTrim nurbsObj =+   bracket_ (gluBeginTrim nurbsObj) (gluEndTrim nurbsObj)++pwlCurve :: TrimmingPoint p => NURBSObj -> GLint -> Ptr (p GLfloat) -> GLint -> IO ()+pwlCurve nurbsObj count points stride =+   gluPwlCurve nurbsObj count (castPtr points) stride (trimmingTarget (pseudoPeek points))++trimmingCurve :: TrimmingPoint c => NURBSObj -> GLint -> Ptr GLfloat -> GLint -> Ptr (c GLfloat) -> GLint -> IO ()+trimmingCurve nurbsObj knotCount knots stride control order =+   gluNurbsCurve nurbsObj knotCount knots stride (castPtr control) order (trimmingTarget (pseudoPeek control))++--------------------------------------------------------------------------------++data NURBSMode =+     NURBSTessellator+   | NURBSRenderer+   deriving ( Eq, Ord, Show )++marshalNURBSMode :: NURBSMode -> GLfloat+marshalNURBSMode x = fromIntegral $ case x of+   NURBSTessellator -> glu_NURBS_TESSELLATOR+   NURBSRenderer -> glu_NURBS_RENDERER++setNURBSMode :: NURBSObj -> NURBSMode -> IO ()+setNURBSMode nurbsObj = gluNurbsProperty nurbsObj glu_NURBS_MODE . marshalNURBSMode++--------------------------------------------------------------------------------++setNURBSCulling :: NURBSObj -> Capability -> IO ()+setNURBSCulling nurbsObj = gluNurbsProperty nurbsObj glu_CULLING . fromIntegral . marshalCapability++--------------------------------------------------------------------------------++data SamplingMethod' =+     PathLength'+   | ParametricError'+   | DomainDistance'+   | ObjectPathLength'+   | ObjectParametricError'++marshalSamplingMethod' :: SamplingMethod' -> GLfloat+marshalSamplingMethod' x = fromIntegral $ case x of+   PathLength' -> glu_PATH_LENGTH+   ParametricError' -> glu_PARAMETRIC_TOLERANCE+   DomainDistance' -> glu_DOMAIN_DISTANCE+   ObjectPathLength' -> glu_OBJECT_PATH_LENGTH+   ObjectParametricError' -> glu_OBJECT_PARAMETRIC_ERROR++setSamplingMethod' :: NURBSObj -> SamplingMethod' -> IO ()+setSamplingMethod' nurbsObj = gluNurbsProperty nurbsObj glu_SAMPLING_METHOD . marshalSamplingMethod'++--------------------------------------------------------------------------------++data SamplingMethod =+     PathLength GLfloat+   | ParametricError GLfloat+   | DomainDistance GLfloat GLfloat+   | ObjectPathLength GLfloat+   | ObjectParametricError GLfloat+   deriving ( Eq, Ord, Show )++setSamplingMethod :: NURBSObj -> SamplingMethod -> IO ()+setSamplingMethod nurbsObj x = case x of+   PathLength s -> do+      gluNurbsProperty nurbsObj glu_SAMPLING_TOLERANCE s+      setSamplingMethod' nurbsObj PathLength'+   ParametricError p -> do+      gluNurbsProperty nurbsObj glu_PARAMETRIC_TOLERANCE p+      setSamplingMethod' nurbsObj ParametricError'+   DomainDistance u v -> do+      gluNurbsProperty nurbsObj glu_U_STEP u+      gluNurbsProperty nurbsObj glu_V_STEP v+      setSamplingMethod' nurbsObj DomainDistance'+   ObjectPathLength s -> do+      gluNurbsProperty nurbsObj glu_SAMPLING_TOLERANCE s+      setSamplingMethod' nurbsObj ObjectPathLength'+   ObjectParametricError p -> do+      gluNurbsProperty nurbsObj glu_PARAMETRIC_TOLERANCE p+      setSamplingMethod' nurbsObj ObjectParametricError'++--------------------------------------------------------------------------------++setAutoLoadMatrix :: NURBSObj -> Bool -> IO ()+setAutoLoadMatrix nurbsObj = gluNurbsProperty nurbsObj glu_AUTO_LOAD_MATRIX . marshalGLboolean++loadSamplingMatrices :: (Matrix m1, Matrix m2) => NURBSObj -> Maybe (m1 GLfloat, m2 GLfloat, (Position, Size)) -> IO ()+loadSamplingMatrices nurbsObj =+   maybe+      (setAutoLoadMatrix nurbsObj True)+      (\(mv, proj, (Position x y, Size w h)) -> do+          withMatrixColumnMajor mv $ \mvBuf ->+             withMatrixColumnMajor proj $ \projBuf ->+                withArray [x, y, fromIntegral w, fromIntegral h] $ \viewportBuf ->+                  gluLoadSamplingMatrices nurbsObj mvBuf projBuf viewportBuf+          setAutoLoadMatrix nurbsObj False)++withMatrixColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO a) -> IO a+withMatrixColumnMajor mat act =+   withMatrix mat $ \order p ->+      if order == ColumnMajor+         then act p+         else do+            elems <- mapM (peekElemOff p) [ 0, 4,  8, 12,+                                            1, 5,  9, 13,+                                            2, 6, 10, 14,+                                            3, 7, 11, 15 ]+            withArray elems act++--------------------------------------------------------------------------------++data DisplayMode' =+     Fill'+   | OutlinePolygon+   | OutlinePatch+   deriving ( Eq, Ord, Show )++marshalDisplayMode' :: DisplayMode' -> GLfloat+marshalDisplayMode' x = fromIntegral $ case x of+   Fill' -> glu_FILL+   OutlinePolygon -> glu_OUTLINE_POLYGON+   OutlinePatch -> glu_OUTLINE_PATCH++setDisplayMode' :: NURBSObj -> DisplayMode' -> IO ()+setDisplayMode' nurbsObj = gluNurbsProperty nurbsObj glu_DISPLAY_MODE . marshalDisplayMode'
Graphics/Rendering/OpenGL/GLU/Quadrics.hs view
@@ -1,155 +1,155 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.Quadrics
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.GLU.Raw
-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.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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 ==)
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Quadrics+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.GLU.Raw+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.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++data QuadricDrawStyle =+     PointStyle+   | LineStyle+   | FillStyle+   | SilhouetteStyle+   deriving ( Eq, Ord, Show )++marshalQuadricDrawStyle :: QuadricDrawStyle -> GLenum+marshalQuadricDrawStyle x = case x of+   PointStyle -> glu_POINT+   LineStyle -> glu_LINE+   FillStyle -> glu_FILL+   SilhouetteStyle -> glu_SILHOUETTE++--------------------------------------------------------------------------------++type QuadricNormal = Maybe ShadingModel++marshalQuadricNormal :: QuadricNormal -> GLenum+marshalQuadricNormal (Just Smooth) = glu_SMOOTH+marshalQuadricNormal (Just Flat  ) = glu_FLAT+marshalQuadricNormal Nothing       = glu_NONE++--------------------------------------------------------------------------------++data QuadricOrientation =+     Outside+   | Inside+   deriving ( Eq, Ord, Show )++marshalQuadricOrientation :: QuadricOrientation -> GLenum+marshalQuadricOrientation x = case x of+   Outside -> glu_OUTSIDE+   Inside -> glu_INSIDE++--------------------------------------------------------------------------------++data QuadricTexture+   = NoTextureCoordinates+   | GenerateTextureCoordinates+   deriving ( Eq,Ord )++marshalQuadricTexture :: QuadricTexture -> GLboolean+marshalQuadricTexture NoTextureCoordinates       = marshalGLboolean False+marshalQuadricTexture GenerateTextureCoordinates = marshalGLboolean True++--------------------------------------------------------------------------------++data QuadricStyle+   = QuadricStyle QuadricNormal+                  QuadricTexture+                  QuadricOrientation+                  QuadricDrawStyle+   deriving ( Eq,Ord )++--------------------------------------------------------------------------------++type Radius = GLdouble+type Height = GLdouble+type Angle  = GLdouble+type Slices = GLint+type Stacks = GLint+type Loops  = GLint++--------------------------------------------------------------------------------++data QuadricPrimitive+   = Sphere Radius Slices Stacks+   | Cylinder Radius Radius Height Slices Stacks+   | Disk Radius Radius Slices Loops+   | PartialDisk Radius Radius Slices Loops Angle Angle+   deriving ( Eq, Ord )++--------------------------------------------------------------------------------++renderQuadric :: QuadricStyle -> QuadricPrimitive -> IO ()+renderQuadric style prim = do+   withQuadricObj recordOutOfMemory $ \quadricObj ->+      withErrorCallback quadricObj recordErrorCode $ do+         setStyle quadricObj style+         renderPrimitive quadricObj prim++withQuadricObj :: IO a -> (QuadricObj -> IO a) -> IO a+withQuadricObj failure success =+   bracket gluNewQuadric safeDeleteQuadric+           (\quadricObj -> if isNullQuadricObj quadricObj+                              then failure+                              else success quadricObj)++safeDeleteQuadric :: QuadricObj -> IO ()+safeDeleteQuadric quadricObj =+   unless (isNullQuadricObj quadricObj) $ gluDeleteQuadric quadricObj++withErrorCallback :: QuadricObj -> QuadricCallback -> IO a -> IO a+withErrorCallback quadricObj callback action =+   bracket (makeQuadricCallback callback) freeHaskellFunPtr $ \callbackPtr -> do+      gluQuadricCallback quadricObj glu_ERROR callbackPtr+      action++setStyle :: QuadricObj -> QuadricStyle -> IO ()+setStyle quadricObj (QuadricStyle n t o d) = do+   gluQuadricNormals     quadricObj (marshalQuadricNormal      n)+   gluQuadricTexture     quadricObj (marshalQuadricTexture     t)+   gluQuadricOrientation quadricObj (marshalQuadricOrientation o)+   gluQuadricDrawStyle   quadricObj (marshalQuadricDrawStyle   d)++renderPrimitive :: QuadricObj -> QuadricPrimitive -> IO ()+renderPrimitive quadricObj (Sphere r s n) =+   gluSphere quadricObj r s n+renderPrimitive quadricObj (Cylinder b t h s n) =+   gluCylinder quadricObj b t h s n+renderPrimitive quadricObj (Disk i o s l) =+   gluDisk quadricObj i o s l+renderPrimitive quadricObj (PartialDisk i o s l a w) =+   gluPartialDisk quadricObj i o s l a w++--------------------------------------------------------------------------------++type QuadricObj = Ptr GLUquadric++isNullQuadricObj :: QuadricObj -> Bool+isNullQuadricObj = (nullPtr ==)
Graphics/Rendering/OpenGL/GLU/Tessellation.hs view
@@ -1,521 +1,521 @@---------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.OpenGL.GLU.Tessellation
--- Copyright   :  (c) Sven Panne 2002-2013
--- 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.Rendering.GLU.Raw
-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 ( unmarshalPrimitiveMode )
-import Graphics.Rendering.OpenGL.GL.BeginEnd (
-   PrimitiveMode, EdgeFlag(BeginsInteriorEdge) )
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw
-
---------------------------------------------------------------------------------
-
-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
+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.OpenGL.GLU.Tessellation+-- Copyright   :  (c) Sven Panne 2002-2013+-- 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.Rendering.GLU.Raw+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 ( unmarshalPrimitiveMode )+import Graphics.Rendering.OpenGL.GL.BeginEnd (+   PrimitiveMode, EdgeFlag(BeginsInteriorEdge) )+import Graphics.Rendering.OpenGL.GL.VertexSpec+import Graphics.Rendering.OpenGL.GL.QueryUtils+import Graphics.Rendering.OpenGL.GLU.ErrorsInternal+import Graphics.Rendering.OpenGL.Raw++--------------------------------------------------------------------------------++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
OpenGL.cabal view
@@ -1,150 +1,150 @@-name: OpenGL
-version: 2.9.0.0
-license: BSD3
-license-file: LICENSE
-maintainer: Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com>
-bug-reports: https://github.com/haskell-opengl/OpenGL/issues
-homepage: http://www.haskell.org/haskellwiki/Opengl
-category: Graphics
-synopsis: A binding for the OpenGL graphics system
-description:
-   A Haskell binding for the OpenGL graphics system (GL, version 4.4) and its
-   accompanying utility library (GLU, version 1.3).
-   .
-   OpenGL is the industry's most widely used and supported 2D and 3D graphics
-   application programming interface (API), incorporating a broad set of
-   rendering, texture mapping, special effects, and other powerful visualization
-   functions. For more information about OpenGL and its various extensions,
-   please see <http://www.opengl.org/>
-   and <http://www.opengl.org/registry/>.
-build-type: Simple
-cabal-version: >= 1.6
-extra-source-files:
-   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.ByteString,
-   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.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.ObjectName,
-   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.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.StateVar,
-   Graphics.Rendering.OpenGL.GL.StringQueries,
-   Graphics.Rendering.OpenGL.GL.SyncObjects,
-   Graphics.Rendering.OpenGL.GL.Tensor,
-   Graphics.Rendering.OpenGL.GL.Texturing,
-   Graphics.Rendering.OpenGL.GL.Texturing.Application,
-   Graphics.Rendering.OpenGL.GL.Texturing.Environments,
-   Graphics.Rendering.OpenGL.GL.Texturing.Objects,
-   Graphics.Rendering.OpenGL.GL.Texturing.Parameters,
-   Graphics.Rendering.OpenGL.GL.Texturing.Queries,
-   Graphics.Rendering.OpenGL.GL.Texturing.Specification,
-   Graphics.Rendering.OpenGL.GL.TransformFeedback,
-   Graphics.Rendering.OpenGL.GL.VertexArrayObjects,
-   Graphics.Rendering.OpenGL.GL.VertexArrays,
-   Graphics.Rendering.OpenGL.GL.VertexSpec,
-   Graphics.Rendering.OpenGL.GLU,
-   Graphics.Rendering.OpenGL.GLU.Errors,
-   Graphics.Rendering.OpenGL.GLU.Initialization,
-   Graphics.Rendering.OpenGL.GLU.Matrix,
-   Graphics.Rendering.OpenGL.GLU.Mipmapping,
-   Graphics.Rendering.OpenGL.GLU.NURBS,
-   Graphics.Rendering.OpenGL.GLU.Quadrics,
-   Graphics.Rendering.OpenGL.GLU.Tessellation
-  other-modules:
-   Graphics.Rendering.OpenGL.GL.BlendingFactor,
-   Graphics.Rendering.OpenGL.GL.BufferMode,
-   Graphics.Rendering.OpenGL.GL.Capability,
-   Graphics.Rendering.OpenGL.GL.ComparisonFunction,
-   Graphics.Rendering.OpenGL.GL.ControlPoint,
-   Graphics.Rendering.OpenGL.GL.DataType,
-   Graphics.Rendering.OpenGL.GL.Domain,
-   Graphics.Rendering.OpenGL.GL.EdgeFlag,
-   Graphics.Rendering.OpenGL.GL.Exception,
-   Graphics.Rendering.OpenGL.GL.Face,
-   Graphics.Rendering.OpenGL.GL.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.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.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
-  ghc-options: -Wall -O2
-  build-depends:
-   base >= 3 && < 5, bytestring, text, OpenGLRaw >= 1.4.0.0, GLURaw >= 1.3.0.0
-
-source-repository head
-  type:     git
-  location: https://github.com/haskell-opengl/OpenGL
+name: OpenGL+version: 2.9.1.0+license: BSD3+license-file: LICENSE+maintainer: Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com>+bug-reports: https://github.com/haskell-opengl/OpenGL/issues+homepage: http://www.haskell.org/haskellwiki/Opengl+category: Graphics+synopsis: A binding for the OpenGL graphics system+description:+   A Haskell binding for the OpenGL graphics system (GL, version 4.4) and its+   accompanying utility library (GLU, version 1.3).+   .+   OpenGL is the industry's most widely used and supported 2D and 3D graphics+   application programming interface (API), incorporating a broad set of+   rendering, texture mapping, special effects, and other powerful visualization+   functions. For more information about OpenGL and its various extensions,+   please see <http://www.opengl.org/>+   and <http://www.opengl.org/registry/>.+build-type: Simple+cabal-version: >= 1.6+extra-source-files:+   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.ByteString,+   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.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.ObjectName,+   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.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.StateVar,+   Graphics.Rendering.OpenGL.GL.StringQueries,+   Graphics.Rendering.OpenGL.GL.SyncObjects,+   Graphics.Rendering.OpenGL.GL.Tensor,+   Graphics.Rendering.OpenGL.GL.Texturing,+   Graphics.Rendering.OpenGL.GL.Texturing.Application,+   Graphics.Rendering.OpenGL.GL.Texturing.Environments,+   Graphics.Rendering.OpenGL.GL.Texturing.Objects,+   Graphics.Rendering.OpenGL.GL.Texturing.Parameters,+   Graphics.Rendering.OpenGL.GL.Texturing.Queries,+   Graphics.Rendering.OpenGL.GL.Texturing.Specification,+   Graphics.Rendering.OpenGL.GL.TransformFeedback,+   Graphics.Rendering.OpenGL.GL.VertexArrayObjects,+   Graphics.Rendering.OpenGL.GL.VertexArrays,+   Graphics.Rendering.OpenGL.GL.VertexSpec,+   Graphics.Rendering.OpenGL.GLU,+   Graphics.Rendering.OpenGL.GLU.Errors,+   Graphics.Rendering.OpenGL.GLU.Initialization,+   Graphics.Rendering.OpenGL.GLU.Matrix,+   Graphics.Rendering.OpenGL.GLU.Mipmapping,+   Graphics.Rendering.OpenGL.GLU.NURBS,+   Graphics.Rendering.OpenGL.GLU.Quadrics,+   Graphics.Rendering.OpenGL.GLU.Tessellation+  other-modules:+   Graphics.Rendering.OpenGL.GL.BlendingFactor,+   Graphics.Rendering.OpenGL.GL.BufferMode,+   Graphics.Rendering.OpenGL.GL.Capability,+   Graphics.Rendering.OpenGL.GL.ComparisonFunction,+   Graphics.Rendering.OpenGL.GL.ControlPoint,+   Graphics.Rendering.OpenGL.GL.DataType,+   Graphics.Rendering.OpenGL.GL.Domain,+   Graphics.Rendering.OpenGL.GL.EdgeFlag,+   Graphics.Rendering.OpenGL.GL.Exception,+   Graphics.Rendering.OpenGL.GL.Face,+   Graphics.Rendering.OpenGL.GL.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.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.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+  ghc-options: -Wall -O2+  build-depends:+   base >= 3 && < 5, bytestring, text, OpenGLRaw >= 1.4.0.0, GLURaw >= 1.3.0.0++source-repository head+  type:     git+  location: https://github.com/haskell-opengl/OpenGL