diff --git a/Graphics/Rendering/OpenGL.hs b/Graphics/Rendering/OpenGL.hs
--- a/Graphics/Rendering/OpenGL.hs
+++ b/Graphics/Rendering/OpenGL.hs
@@ -1,138 +1,138 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- A convenience module, combining the Haskell bindings for GL and GLU.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL (
- -- * Supported Extensions
-
- -- $SupportedExtensions
-
- -- * Legal stuff
-
- -- $LegalStuff
-
- module Graphics.Rendering.OpenGL.GL
- , module Graphics.Rendering.OpenGL.GLU
-) where
-
-import Graphics.Rendering.OpenGL.GL
-import Graphics.Rendering.OpenGL.GLU
-
---------------------------------------------------------------------------------
--- $SupportedExtensions
--- There is support for full OpenGL 2.1, including the imaging subset, plus some
--- extensions:
---
--- @
--- extension | core since
--- -------------------------------+------------
--- GL_APPLE_packed_pixels | 1.2
--- GL_APPLE_ycbcr_422 |
--- GL_ARB_copy_buffer | 3.1
--- GL_ARB_depth_buffer_float | 3.0
--- GL_ARB_depth_texture | 1.4
--- GL_ARB_half_float_pixel | 3.0
--- GL_ARB_imaging |
--- GL_ARB_multisample | 1.3
--- GL_ARB_multitexture | 1.3
--- GL_ARB_occlusion_query | 1.5
--- GL_ARB_point_parameters | 1.4
--- GL_ARB_point_sprite |
--- GL_ARB_shadow | 1.4
--- GL_ARB_texture_border_clamp | 1.3
--- GL_ARB_texture_compression | 1.3
--- GL_ARB_texture_cube_map | 1.3
--- GL_ARB_texture_env_add | 1.3
--- GL_ARB_texture_env_combine | 1.3
--- GL_ARB_texture_env_crossbar | 1.4
--- GL_ARB_texture_env_dot3 | 1.3
--- GL_ARB_texture_mirrored_repeat | 1.4
--- GL_ARB_texture_rectangle | 3.1
--- GL_ARB_transpose_matrix | 1.3
--- GL_ARB_vertex_buffer_object | 1.5
--- GL_ARB_vertex_shader | 2.0
--- GL_ARB_window_pos | 1.4
--- GL_EXT_abgr |
--- GL_EXT_bgra | 1.2
--- GL_EXT_blend_color | 1.4
--- GL_EXT_blend_func_separate | 1.4
--- GL_EXT_blend_logic_op | 1.1
--- GL_EXT_blend_minmax | 1.4
--- GL_EXT_blend_subtract | 1.4
--- GL_EXT_color_subtable |
--- GL_EXT_compiled_vertex_array |
--- GL_EXT_convolution |
--- GL_EXT_copy_texture | 1.1
--- GL_EXT_depth_bounds_test |
--- GL_EXT_draw_range_elements | 1.2
--- GL_EXT_fog_coord | 1.4
--- GL_EXT_histogram |
--- GL_EXT_multi_draw_arrays | 1.4
--- GL_EXT_packed_float | 3.0
--- GL_EXT_packed_pixels | 1.2
--- GL_EXT_polygon_offset | 1.1
--- GL_EXT_rescale_normal | 1.2
--- GL_EXT_secondary_color | 1.4
--- GL_EXT_separate_specular_color | 1.2
--- GL_EXT_shadow_funcs | 1.5
--- GL_EXT_stencil_two_side |
--- GL_EXT_stencil_wrap | 1.4
--- GL_EXT_subtexture | 1.1
--- GL_EXT_texture | 1.1
--- GL_EXT_texture3D | 1.2
--- GL_EXT_texture_lod_bias | 1.4
--- GL_EXT_texture_shared_exponent | 3.0
--- GL_EXT_texture_object | 1.1
--- GL_EXT_vertex_array | 1.1
--- GL_HP_convolution_border_modes |
--- GL_IBM_rasterpos_clip |
--- GL_MESA_ycbcr_texture |
--- GL_NV_blend_square | 1.4
--- GL_NV_depth_clamp |
--- GL_NV_fog_distance |
--- GL_NV_light_max_exponent |
--- GL_NV_packed_depth_stencil |
--- GL_NV_primitive_restart |
--- GL_SGIS_generate_mipmap | 1.4
--- GL_SGIS_texture_edge_clamp |
--- GL_SGIS_texture_lod |
--- GL_SGI_color_matrix |
--- GL_SGI_color_table |
--- @
-
---------------------------------------------------------------------------------
--- $LegalStuff
--- The documentation is loosely based on the man pages of the OpenGL Sample
--- Implemenation from SGI, see: . 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: .
---
--- 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
+-- 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: . 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: .
+--
+-- 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.
diff --git a/Graphics/Rendering/OpenGL/GL.hs b/Graphics/Rendering/OpenGL/GL.hs
--- a/Graphics/Rendering/OpenGL/GL.hs
+++ b/Graphics/Rendering/OpenGL/GL.hs
@@ -1,112 +1,122 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- A Haskell binding for OpenGL, the industry\'s most widely used and
--- supported 2D and 3D graphics API.
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL (
- -- * OpenGL Operation
- module Graphics.Rendering.OpenGL.Raw.Core31,
- module Graphics.Rendering.OpenGL.GL.BeginEnd,
- module Graphics.Rendering.OpenGL.GL.VertexSpec,
- module Graphics.Rendering.OpenGL.GL.VertexArrays,
- module Graphics.Rendering.OpenGL.GL.VertexArrayObjects,
- module Graphics.Rendering.OpenGL.GL.BufferObjects,
- module Graphics.Rendering.OpenGL.GL.Rectangles,
- module Graphics.Rendering.OpenGL.GL.CoordTrans,
- module Graphics.Rendering.OpenGL.GL.Clipping,
- module Graphics.Rendering.OpenGL.GL.RasterPos,
- module Graphics.Rendering.OpenGL.GL.Colors,
- module Graphics.Rendering.OpenGL.GL.Shaders,
-
- -- * Rasterization
- module Graphics.Rendering.OpenGL.GL.Antialiasing,
- module Graphics.Rendering.OpenGL.GL.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.FlushFinish,
- module Graphics.Rendering.OpenGL.GL.Hints,
- module Graphics.Rendering.OpenGL.GL.PixellikeObject,
- module Graphics.Rendering.OpenGL.GL.TransformFeedback,
--- is exported through PerFragment for backwards compatibility reasons
--- module Graphics.Rendering.OpenGL.GL.QueryObjects,
-
- -- * 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.Core31 (
- GLbitfield, GLboolean, GLbyte, GLchar, GLclampd, GLclampf, GLdouble,
- GLenum, GLfloat, GLhalf, GLint, GLintptr, GLshort, GLsizei,
- GLsizeiptr, GLubyte, GLuint, GLushort )
-import Graphics.Rendering.OpenGL.GL.BeginEnd
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GL.VertexArrays
-import Graphics.Rendering.OpenGL.GL.VertexArrayObjects
-import Graphics.Rendering.OpenGL.GL.BufferObjects
-import Graphics.Rendering.OpenGL.GL.Rectangles
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.Clipping
-import Graphics.Rendering.OpenGL.GL.RasterPos
-import Graphics.Rendering.OpenGL.GL.Colors
-import Graphics.Rendering.OpenGL.GL.Shaders
-
-import Graphics.Rendering.OpenGL.GL.Antialiasing
-import Graphics.Rendering.OpenGL.GL.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.FlushFinish
-import Graphics.Rendering.OpenGL.GL.Hints
-import Graphics.Rendering.OpenGL.GL.PixellikeObject
-import Graphics.Rendering.OpenGL.GL.TransformFeedback
--- is exported through PerFragment for backwards compatibility reasons
---import Graphics.Rendering.OpenGL.GL.QueryObjects
-
-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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Antialiasing.hs b/Graphics/Rendering/OpenGL/GL/Antialiasing.hs
--- a/Graphics/Rendering/OpenGL/GL/Antialiasing.hs
+++ b/Graphics/Rendering/OpenGL/GL/Antialiasing.hs
@@ -1,40 +1,40 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Antialiasing
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.2 (Antialiasing) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Antialiasing (
- sampleBuffers, samples, multisample, subpixelBits
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-sampleBuffers :: GettableStateVar GLsizei
-sampleBuffers = antialiasingInfo GetSampleBuffers
-
-samples :: GettableStateVar GLsizei
-samples = antialiasingInfo GetSamples
-
-multisample :: StateVar Capability
-multisample = makeCapability CapMultisample
-
-subpixelBits :: GettableStateVar GLsizei
-subpixelBits = antialiasingInfo GetSubpixelBits
-
-antialiasingInfo :: 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/BeginEnd.hs b/Graphics/Rendering/OpenGL/GL/BeginEnd.hs
--- a/Graphics/Rendering/OpenGL/GL/BeginEnd.hs
+++ b/Graphics/Rendering/OpenGL/GL/BeginEnd.hs
@@ -1,130 +1,129 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.BeginEnd
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.6 (Begin\/End Paradigm) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.BeginEnd (
- -- * Begin and End Objects
- PrimitiveMode(..),
- renderPrimitive, unsafeRenderPrimitive, primitiveRestart,
-
- -- * Polygon Edges
- EdgeFlag(..),
- edgeFlag
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.EdgeFlag
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.PrimitiveMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glBegin, glEnd, glEdgeFlag )
-import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart
-
---------------------------------------------------------------------------------
-
--- | Delimit the vertices that define a primitive or a group of like primitives.
---
--- Only a subset of GL commands can be used in the delimited action:
--- Those for specifying vertex coordinates
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.vertex',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.vertexv'),
--- vertex colors
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.color',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.colorv',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColor',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.secondaryColorv',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.index',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.indexv'),
--- normal
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.normal',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.normalv'),
--- texture coordinates
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.texCoord',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.texCoordv',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoord',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.multiTexCoordv'),
--- and fog coordinates
--- ('Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoord',
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.fogCoordv').
--- Additionally,
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint1',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalPoint2',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord1v',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2',
--- 'Graphics.Rendering.OpenGL.GL.Evaluators.evalCoord2v',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbient',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialDiffuse',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialAmbientAndDiffuse',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialSpecular',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialEmission',
--- 'Graphics.Rendering.OpenGL.GL.Colors.materialShininess',
--- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callList',
--- 'Graphics.Rendering.OpenGL.GL.DisplayLists.callLists',
--- and setting 'edgeFlag' are allowed. Writing the respective state variables
--- is allowed in the delimited action, too.
---
--- Regardless of the chosen 'PrimitiveMode', there is no limit to the number of
--- vertices that can be defined during a single 'renderPrimitive'. Lines,
--- triangles, quadrilaterals, and polygons that are incompletely specified are
--- not drawn. Incomplete specification results when either too few vertices are
--- provided to specify even a single primitive or when an incorrect multiple of
--- vertices is specified. The incomplete primitive is ignored; the rest are
--- drawn.
---
--- The minimum specification of vertices for each primitive is as follows: 1
--- for a point, 2 for a line, 3 for a triangle, 4 for a quadrilateral, and 3 for
--- a polygon. Modes that require a certain multiple of vertices are 'Lines' (2),
--- 'Triangles' (3), 'Quads' (4), and 'QuadStrip' (2).
-
-renderPrimitive :: PrimitiveMode -> IO a -> IO a
-renderPrimitive = renderPrim bracket_
-
--- | A more efficient, but potentially dangerous version of 'renderPrimitive':
--- The given action is not allowed to throw an exception.
-
-unsafeRenderPrimitive :: PrimitiveMode -> IO a -> IO a
-unsafeRenderPrimitive = renderPrim unsafeBracket_
-
-{-# INLINE renderPrim #-}
-renderPrim :: (IO () -> IO () -> IO a -> IO a) -> PrimitiveMode -> IO a -> IO a
-renderPrim brack_ beginMode =
- brack_ (glBegin (marshalPrimitiveMode beginMode)) glEnd
-
---------------------------------------------------------------------------------
-
-primitiveRestart :: IO ()
-primitiveRestart = glPrimitiveRestart
-
---------------------------------------------------------------------------------
-
--- | Each vertex of a polygon, separate triangle, or separate quadrilateral
--- specified during 'renderPrimitive' is marked as the start of either a boundary
--- or nonboundary (interior) edge.
---
--- The vertices of connected triangles and connected quadrilaterals are always
--- marked as boundary, regardless of the value of the edge flag.
---
--- Boundary and nonboundary edge flags on vertices are significant only if
--- 'Graphics.Rendering.OpenGL.GL.Polygons.polygonMode' is set to
--- 'Graphics.Rendering.OpenGL.GL.Polygons.Point' or
--- 'Graphics.Rendering.OpenGL.GL.Polygons.Line'.
---
--- Note that the current edge flag can be updated at any time, in particular
--- during 'renderPrimitive'.
-
-edgeFlag :: StateVar EdgeFlag
-edgeFlag =
- makeStateVar (getBoolean1 unmarshalEdgeFlag GetEdgeFlag)
- (glEdgeFlag . marshalEdgeFlag)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.BeginEnd
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Bitmaps.hs b/Graphics/Rendering/OpenGL/GL/Bitmaps.hs
--- a/Graphics/Rendering/OpenGL/GL/Bitmaps.hs
+++ b/Graphics/Rendering/OpenGL/GL/Bitmaps.hs
@@ -1,29 +1,28 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Bitmaps
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.7 (Bitmaps) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Bitmaps (
- bitmap
-) where
-
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glBitmap )
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.Tensor
-
---------------------------------------------------------------------------------
-
-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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/BlendingFactor.hs b/Graphics/Rendering/OpenGL/GL/BlendingFactor.hs
--- a/Graphics/Rendering/OpenGL/GL/BlendingFactor.hs
+++ b/Graphics/Rendering/OpenGL/GL/BlendingFactor.hs
@@ -1,77 +1,77 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.BlendingFactor
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling BlendingFactor.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.BlendingFactor (
- BlendingFactor(..), marshalBlendingFactor, unmarshalBlendingFactor
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data BlendingFactor =
- Zero
- | One
- | SrcColor
- | OneMinusSrcColor
- | DstColor
- | OneMinusDstColor
- | SrcAlpha
- | OneMinusSrcAlpha
- | DstAlpha
- | OneMinusDstAlpha
- | ConstantColor
- | OneMinusConstantColor
- | ConstantAlpha
- | OneMinusConstantAlpha
- | SrcAlphaSaturate
- deriving ( Eq, Ord, Show )
-
-marshalBlendingFactor :: BlendingFactor -> GLenum
-marshalBlendingFactor x = case x of
- Zero -> gl_ZERO
- One -> gl_ONE
- SrcColor -> gl_SRC_COLOR
- OneMinusSrcColor -> gl_ONE_MINUS_SRC_COLOR
- DstColor -> gl_DST_COLOR
- OneMinusDstColor -> gl_ONE_MINUS_DST_COLOR
- SrcAlpha -> gl_SRC_ALPHA
- OneMinusSrcAlpha -> gl_ONE_MINUS_SRC_ALPHA
- DstAlpha -> gl_DST_ALPHA
- OneMinusDstAlpha -> gl_ONE_MINUS_DST_ALPHA
- ConstantColor -> gl_CONSTANT_COLOR
- OneMinusConstantColor -> gl_ONE_MINUS_CONSTANT_COLOR
- ConstantAlpha -> gl_CONSTANT_ALPHA
- OneMinusConstantAlpha -> gl_ONE_MINUS_CONSTANT_ALPHA
- SrcAlphaSaturate -> gl_SRC_ALPHA_SATURATE
-
-unmarshalBlendingFactor :: GLenum -> BlendingFactor
-unmarshalBlendingFactor x
- | x == gl_ZERO = Zero
- | x == gl_ONE = One
- | x == gl_SRC_COLOR = SrcColor
- | x == gl_ONE_MINUS_SRC_COLOR = OneMinusSrcColor
- | x == gl_DST_COLOR = DstColor
- | x == gl_ONE_MINUS_DST_COLOR = OneMinusDstColor
- | x == gl_SRC_ALPHA = SrcAlpha
- | x == gl_ONE_MINUS_SRC_ALPHA = OneMinusSrcAlpha
- | x == gl_DST_ALPHA = DstAlpha
- | x == gl_ONE_MINUS_DST_ALPHA = OneMinusDstAlpha
- | x == gl_CONSTANT_COLOR = ConstantColor
- | x == gl_ONE_MINUS_CONSTANT_COLOR = OneMinusConstantColor
- | x == gl_CONSTANT_ALPHA = ConstantAlpha
- | x == gl_ONE_MINUS_CONSTANT_ALPHA = OneMinusConstantAlpha
- | x == gl_SRC_ALPHA_SATURATE = SrcAlphaSaturate
- | otherwise = error ("unmarshalBlendingFactor: illegal value " ++ show x)
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.BlendingFactor
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/BufferMode.hs b/Graphics/Rendering/OpenGL/GL/BufferMode.hs
--- a/Graphics/Rendering/OpenGL/GL/BufferMode.hs
+++ b/Graphics/Rendering/OpenGL/GL/BufferMode.hs
@@ -1,126 +1,113 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.BufferMode
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling BufferMode.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.BufferMode (
- BufferMode(..), marshalBufferMode, unmarshalBufferMode, unmarshalBufferModeSafe,
- maxColorAttachments,
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( gl_AUX0 )
-
---------------------------------------------------------------------------------
-
--- | The set of color buffers which are selected for reading and writing.
-
-data BufferMode =
- NoBuffers
- -- ^ No color buffers are selected.
- | FrontLeftBuffer
- -- ^ Only the front left color buffer is selected.
- | FrontRightBuffer
- -- ^ Only the front right color buffer is selected.
- | BackLeftBuffer
- -- ^ Only the back left color buffer is selected.
- | BackRightBuffer
- -- ^ Only the back right color buffer is selected.
- | FrontBuffers
- -- ^ Only the front left and front right color buffers are selected. If
- -- there is no front right color buffer, only the front left color buffer
- -- is selected.
- | BackBuffers
- -- ^ Only the back left and back right color buffers are selected. If there
- -- is no back right color buffer, only the back left color buffer is
- -- selected.
- | LeftBuffers
- -- ^ Only the front left and back left color buffers are selected. If there
- -- is no back left color buffer, only the front left color buffer is
- -- selected.
- | RightBuffers
- -- ^ Only the front right and back right color buffers are selected. If
- -- there is no back right color buffer, only the front right color buffer
- -- is selected.
- | FrontAndBackBuffers
- -- ^ All the front and back color buffers (front left, front right, back
- -- left, back right) are selected. If there are no back color buffers, only
- -- the front left and front right color buffers are selected. If there are
- -- no right color buffers, only the front left and back left color buffers
- -- are selected. If there are no right or back color buffers, only the
- -- front left color buffer is selected.
- | AuxBuffer GLsizei
- -- ^ Only the given auxiliary color buffer no. /i/ is selected.
- | 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
---unmarshalBufferMode x
--- | x == gl_NONE = NoBuffers
--- | x == gl_FRONT_LEFT = FrontLeftBuffer
--- | x == gl_FRONT_RIGHT = FrontRightBuffer
--- | x == gl_BACK_LEFT = BackLeftBuffer
--- | x == gl_BACK_RIGHT = BackRightBuffer
--- | x == gl_FRONT = FrontBuffers
--- | x == gl_BACK = BackBuffers
--- | x == gl_LEFT = LeftBuffers
--- | x == gl_RIGHT = RightBuffers
--- | x == gl_FRONT_AND_BACK = FrontAndBackBuffers
--- | gl_AUX0 <= x && x <= gl_AUX0 + maxAuxBuffer = AuxBuffer (fromIntegral (x - gl_AUX0))
--- | otherwise = error ("unmarshalBufferMode: illegal value " ++ show x)
-
-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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/BufferObjects.hs b/Graphics/Rendering/OpenGL/GL/BufferObjects.hs
--- a/Graphics/Rendering/OpenGL/GL/BufferObjects.hs
+++ b/Graphics/Rendering/OpenGL/GL/BufferObjects.hs
@@ -1,420 +1,434 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.BufferObjects
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.9 (Buffer Objects) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.BufferObjects (
- -- * Object Names
- module Graphics.Rendering.OpenGL.GL.ObjectName,
-
- -- * Buffer Objects
- BufferObject(BufferObject),
-
- -- * Binding Buffer Objects
- BufferTarget(..), bindBuffer, arrayBufferBinding,
- vertexAttribArrayBufferBinding,
-
- -- * Handling Buffer Data
- BufferUsage(..), bufferData, TransferDirection(..), bufferSubData,
-
- -- * Mapping Buffer Objects
- BufferAccess(..), MappingFailure(..), withMappedBuffer,
- mapBuffer, unmapBuffer,
- bufferAccess, bufferMapped,
-
- BufferRangeAccessBit(..), Offset, Length,
- mapBufferRange, flushMappedBufferRange,
-
- -- * Indexed Buffer manipulation
- BufferIndex,
- RangeStartIndex, RangeSize,
- BufferRange,
- IndexedBufferTarget(..),
- bindBufferBase, bindBufferRange,
- indexedBufferStart, indexedBufferSize
-) where
-
-import Data.List(foldl1')
-import Data.Bits((.|.))
-import Data.Maybe
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexArrays
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-newtype BufferObject = BufferObject { bufferID :: GLuint }
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-instance ObjectName BufferObject where
- genObjectNames n =
- allocaArray n $ \buf -> do
- glGenBuffers (fromIntegral n) buf
- fmap (map BufferObject) $ peekArray n buf
-
- deleteObjectNames bufferObjects =
- withArrayLen (map bufferID bufferObjects) $
- glDeleteBuffers . fromIntegral
-
- isObjectName = fmap unmarshalGLboolean . glIsBuffer . bufferID
-
---------------------------------------------------------------------------------
-
-data BufferTarget =
- ArrayBuffer
- | CopyReadBuffer
- | CopyWriteBuffer
- | ElementArrayBuffer
- | PixelPackBuffer
- | PixelUnpackBuffer
- | TransformFeedbackBuffer
- deriving ( Eq, Ord, Show )
-
-marshalBufferTarget :: BufferTarget -> GLenum
-marshalBufferTarget x = case x of
- ArrayBuffer -> gl_ARRAY_BUFFER
- CopyReadBuffer -> gl_COPY_READ_BUFFER
- CopyWriteBuffer -> gl_COPY_WRITE_BUFFER
- ElementArrayBuffer -> gl_ELEMENT_ARRAY_BUFFER
- PixelPackBuffer -> gl_PIXEL_PACK_BUFFER
- PixelUnpackBuffer -> gl_PIXEL_UNPACK_BUFFER
- TransformFeedbackBuffer -> gl_TRANSFORM_FEEDBACK_BUFFER
-
-bufferTargetToGetPName :: BufferTarget -> PName1I
-bufferTargetToGetPName x = case x of
- ArrayBuffer -> GetArrayBufferBinding
- ElementArrayBuffer -> GetElementArrayBufferBinding
- CopyReadBuffer -> GetCopyReadBuffer
- CopyWriteBuffer -> GetCopyWriteBuffer
- PixelPackBuffer -> GetPixelPackBufferBinding
- PixelUnpackBuffer -> GetPixelUnpackBufferBinding
- TransformFeedbackBuffer -> GetTransformFeedbackBufferBinding
-
---------------------------------------------------------------------------------
-
-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 BufferRangeAccessBit =
- ReadBit
- | WriteBit
- | InvalidateRangeBit
- | InvalidateBufferBit
- | FlushExplicitBit
- | UnsychronizedBit
-
-type Offset = GLintptr
-type Length = GLsizeiptr
-
-marshalBufferRangeAccessBit :: BufferRangeAccessBit -> GLenum
-marshalBufferRangeAccessBit x = case x of
- ReadBit -> gl_MAP_READ_BIT
- WriteBit -> gl_MAP_WRITE_BIT
- InvalidateRangeBit -> gl_MAP_INVALIDATE_RANGE_BIT
- InvalidateBufferBit -> gl_MAP_INVALIDATE_BUFFER_BIT
- FlushExplicitBit -> gl_MAP_FLUSH_EXPLICIT_BIT
- UnsychronizedBit -> gl_MAP_FLUSH_EXPLICIT_BIT
-
-marshalToBitfield :: [BufferRangeAccessBit] -> GLenum
-marshalToBitfield b = foldl1' (.|.) $ map marshalBufferRangeAccessBit b
-
---------------------------------------------------------------------------------
-
-mapBufferRange_ :: BufferTarget -> Offset -> Length ->
- [BufferRangeAccessBit] -> IO (Ptr a)
-mapBufferRange_ t o l b = glMapBufferRange (marshalBufferTarget t) o l
- (fromIntegral $ marshalToBitfield b)
-
-mapBufferRange :: BufferTarget -> Offset -> Length ->
- [BufferRangeAccessBit] -> 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/ByteString.hs b/Graphics/Rendering/OpenGL/GL/ByteString.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/ByteString.hs
@@ -0,0 +1,62 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.ByteString
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Capability.hs b/Graphics/Rendering/OpenGL/GL/Capability.hs
--- a/Graphics/Rendering/OpenGL/GL/Capability.hs
+++ b/Graphics/Rendering/OpenGL/GL/Capability.hs
@@ -1,320 +1,308 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Capability
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for handling OpenGL capabilities, i.e.
--- boolean state variables.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Capability (
- Capability(..), marshalCapability, unmarshalCapability,
- EnableCap(..), makeCapability, makeStateVarMaybe,
-
- 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.ARB.Compatibility (
- gl_ALPHA_TEST, gl_AUTO_NORMAL, gl_COLOR_ARRAY, gl_COLOR_MATERIAL,
- gl_COLOR_SUM, gl_COLOR_TABLE, gl_CONVOLUTION_1D, gl_CONVOLUTION_2D,
- gl_EDGE_FLAG_ARRAY, gl_FOG, gl_FOG_COORD_ARRAY, gl_HISTOGRAM, gl_INDEX_ARRAY,
- gl_INDEX_LOGIC_OP, gl_LIGHTING, gl_LINE_STIPPLE, gl_MAP1_COLOR_4,
- gl_MAP1_INDEX, gl_MAP1_NORMAL, gl_MAP1_TEXTURE_COORD_1,
- gl_MAP1_TEXTURE_COORD_2, gl_MAP1_TEXTURE_COORD_3, gl_MAP1_TEXTURE_COORD_4,
- gl_MAP1_VERTEX_3, gl_MAP1_VERTEX_4, gl_MAP2_COLOR_4, gl_MAP2_INDEX,
- gl_MAP2_NORMAL, gl_MAP2_TEXTURE_COORD_1, gl_MAP2_TEXTURE_COORD_2,
- gl_MAP2_TEXTURE_COORD_3, gl_MAP2_TEXTURE_COORD_4, gl_MAP2_VERTEX_3,
- gl_MAP2_VERTEX_4, gl_MINMAX, gl_NORMALIZE, gl_NORMAL_ARRAY, gl_POINT_SMOOTH,
- gl_POINT_SPRITE, gl_POLYGON_STIPPLE, gl_POST_COLOR_MATRIX_COLOR_TABLE,
- gl_POST_CONVOLUTION_COLOR_TABLE, gl_RESCALE_NORMAL, gl_SECONDARY_COLOR_ARRAY,
- gl_SEPARABLE_2D, gl_TEXTURE_COORD_ARRAY, gl_TEXTURE_GEN_Q, gl_TEXTURE_GEN_R,
- gl_TEXTURE_GEN_S, gl_TEXTURE_GEN_T, gl_VERTEX_ARRAY,
- gl_VERTEX_PROGRAM_TWO_SIDE )
-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette ( gl_MATRIX_INDEX_ARRAY, gl_MATRIX_PALETTE )
-import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend ( gl_WEIGHT_SUM_UNITY, gl_VERTEX_BLEND, gl_WEIGHT_ARRAY )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( gl_DEPTH_BOUNDS_TEST )
-import Graphics.Rendering.OpenGL.Raw.EXT.SharedTexturePalette ( gl_SHARED_TEXTURE_PALETTE )
-import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( gl_STENCIL_TEST_TWO_SIDE )
-import Graphics.Rendering.OpenGL.Raw.NV.DepthClamp ( gl_DEPTH_CLAMP )
-
---------------------------------------------------------------------------------
-
-data Capability =
- Disabled
- | Enabled
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-marshalCapability :: Capability -> GLboolean
-marshalCapability = marshalGLboolean . (Enabled ==)
-
-unmarshalCapability :: GLboolean -> Capability
-unmarshalCapability x = if unmarshalGLboolean x then Enabled else Disabled
-
---------------------------------------------------------------------------------
-
-data EnableCap =
- CapFog
- | CapLighting
- | CapTexture1D
- | CapTexture2D
- | CapTextureRectangle
- | CapLineStipple
- | CapPolygonStipple
- | CapCullFace
- | CapAlphaTest
- | CapBlend
- | CapIndexLogicOp
- | CapColorLogicOp
- | CapDither
- | CapStencilTest
- | CapDepthTest
- | CapClipPlane GLsizei
- | CapLight GLsizei
- | CapTextureGenS
- | CapTextureGenT
- | CapTextureGenR
- | CapTextureGenQ
- | CapMap1Vertex3
- | CapMap1Vertex4
- | CapMap1Color4
- | CapMap1Index
- | CapMap1Normal
- | CapMap1TextureCoord1
- | CapMap1TextureCoord2
- | CapMap1TextureCoord3
- | CapMap1TextureCoord4
- | CapMap2Vertex3
- | CapMap2Vertex4
- | CapMap2Color4
- | CapMap2Index
- | CapMap2Normal
- | CapMap2TextureCoord1
- | CapMap2TextureCoord2
- | CapMap2TextureCoord3
- | CapMap2TextureCoord4
- | CapPointSmooth
- | CapLineSmooth
- | CapPolygonSmooth
- | CapScissorTest
- | CapColorMaterial
- | CapNormalize
- | CapAutoNormal
- | CapPolygonOffsetPoint
- | CapPolygonOffsetLine
- | CapPolygonOffsetFill
- | CapVertexArray
- | CapNormalArray
- | CapColorArray
- | CapIndexArray
- | CapTextureCoordArray
- | CapEdgeFlagArray
- | CapFogCoordArray
- | CapSecondaryColorArray
- | CapMatrixIndexArray
- | CapConvolution1D
- | CapConvolution2D
- | CapSeparable2D
- | CapHistogram
- | CapMinmax
- | CapRescaleNormal
- | CapSharedTexturePalette
- | CapTexture3D
- | CapMultisample
- | CapSampleAlphaToCoverage
- | CapSampleAlphaToOne
- | CapSampleCoverage
- | CapColorTable
- | CapPostConvolutionColorTable
- | CapPostColorMatrixColorTable
- | CapColorSum
- | CapTextureCubeMap
- | CapWeightSumUnity
- | CapVertexBlend
- | CapWeightArray
- | CapMatrixPalette
- | CapDepthClamp
- | CapDepthBoundsTest
- | CapPrimitiveRestart
- | CapPointSprite
- | CapStencilTestTwoSide
- | CapRasterPositionUnclipped
- | 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
- CapTextureRectangle -> Just gl_TEXTURE_RECTANGLE
- CapLineStipple -> Just gl_LINE_STIPPLE
- CapPolygonStipple -> Just gl_POLYGON_STIPPLE
- CapCullFace -> Just gl_CULL_FACE
- CapAlphaTest -> Just gl_ALPHA_TEST
- CapBlend -> Just gl_BLEND
- CapIndexLogicOp -> Just gl_INDEX_LOGIC_OP
- CapColorLogicOp -> Just gl_COLOR_LOGIC_OP
- CapDither -> Just gl_DITHER
- CapStencilTest -> Just gl_STENCIL_TEST
- CapDepthTest -> Just gl_DEPTH_TEST
- CapClipPlane i -> clipPlaneIndexToEnum i
- CapLight i -> lightIndexToEnum i
- CapTextureGenS -> Just gl_TEXTURE_GEN_S
- CapTextureGenT -> Just gl_TEXTURE_GEN_T
- CapTextureGenR -> Just gl_TEXTURE_GEN_R
- CapTextureGenQ -> Just gl_TEXTURE_GEN_Q
- CapMap1Vertex3 -> Just gl_MAP1_VERTEX_3
- CapMap1Vertex4 -> Just gl_MAP1_VERTEX_4
- CapMap1Color4 -> Just gl_MAP1_COLOR_4
- CapMap1Index -> Just gl_MAP1_INDEX
- CapMap1Normal -> Just gl_MAP1_NORMAL
- CapMap1TextureCoord1 -> Just gl_MAP1_TEXTURE_COORD_1
- CapMap1TextureCoord2 -> Just gl_MAP1_TEXTURE_COORD_2
- CapMap1TextureCoord3 -> Just gl_MAP1_TEXTURE_COORD_3
- CapMap1TextureCoord4 -> Just gl_MAP1_TEXTURE_COORD_4
- CapMap2Vertex3 -> Just gl_MAP2_VERTEX_3
- CapMap2Vertex4 -> Just gl_MAP2_VERTEX_4
- CapMap2Color4 -> Just gl_MAP2_COLOR_4
- CapMap2Index -> Just gl_MAP2_INDEX
- CapMap2Normal -> Just gl_MAP2_NORMAL
- CapMap2TextureCoord1 -> Just gl_MAP2_TEXTURE_COORD_1
- CapMap2TextureCoord2 -> Just gl_MAP2_TEXTURE_COORD_2
- CapMap2TextureCoord3 -> Just gl_MAP2_TEXTURE_COORD_3
- CapMap2TextureCoord4 -> Just gl_MAP2_TEXTURE_COORD_4
- CapPointSmooth -> Just gl_POINT_SMOOTH
- CapLineSmooth -> Just gl_LINE_SMOOTH
- CapPolygonSmooth -> Just gl_POLYGON_SMOOTH
- CapScissorTest -> Just gl_SCISSOR_TEST
- CapColorMaterial -> Just gl_COLOR_MATERIAL
- CapNormalize -> Just gl_NORMALIZE
- CapAutoNormal -> Just gl_AUTO_NORMAL
- CapPolygonOffsetPoint -> Just gl_POLYGON_OFFSET_POINT
- CapPolygonOffsetLine -> Just gl_POLYGON_OFFSET_LINE
- CapPolygonOffsetFill -> Just gl_POLYGON_OFFSET_FILL
- CapVertexArray -> Just gl_VERTEX_ARRAY
- CapNormalArray -> Just gl_NORMAL_ARRAY
- CapColorArray -> Just gl_COLOR_ARRAY
- CapIndexArray -> Just gl_INDEX_ARRAY
- CapTextureCoordArray -> Just gl_TEXTURE_COORD_ARRAY
- CapEdgeFlagArray -> Just gl_EDGE_FLAG_ARRAY
- CapFogCoordArray -> Just gl_FOG_COORD_ARRAY
- CapSecondaryColorArray -> Just gl_SECONDARY_COLOR_ARRAY
- CapMatrixIndexArray -> Just gl_MATRIX_INDEX_ARRAY
- CapConvolution1D -> Just gl_CONVOLUTION_1D
- CapConvolution2D -> Just gl_CONVOLUTION_2D
- CapSeparable2D -> Just gl_SEPARABLE_2D
- CapHistogram -> Just gl_HISTOGRAM
- CapMinmax -> Just gl_MINMAX
- CapRescaleNormal -> Just gl_RESCALE_NORMAL
- CapSharedTexturePalette -> Just gl_SHARED_TEXTURE_PALETTE
- CapTexture3D -> Just gl_TEXTURE_3D
- CapMultisample -> Just gl_MULTISAMPLE
- CapSampleAlphaToCoverage -> Just gl_SAMPLE_ALPHA_TO_COVERAGE
- CapSampleAlphaToOne -> Just gl_SAMPLE_ALPHA_TO_ONE
- CapSampleCoverage -> Just gl_SAMPLE_COVERAGE
- CapColorTable -> Just gl_COLOR_TABLE
- CapPostConvolutionColorTable -> Just gl_POST_CONVOLUTION_COLOR_TABLE
- CapPostColorMatrixColorTable -> Just gl_POST_COLOR_MATRIX_COLOR_TABLE
- CapColorSum -> Just gl_COLOR_SUM
- CapTextureCubeMap -> Just gl_TEXTURE_CUBE_MAP
- CapWeightSumUnity -> Just gl_WEIGHT_SUM_UNITY
- CapVertexBlend -> Just gl_VERTEX_BLEND
- CapWeightArray -> Just gl_WEIGHT_ARRAY
- CapMatrixPalette -> Just gl_MATRIX_PALETTE
- CapDepthClamp -> Just gl_DEPTH_CLAMP
- CapDepthBoundsTest -> Just gl_DEPTH_BOUNDS_TEST
- CapPrimitiveRestart -> Just gl_PRIMITIVE_RESTART
- CapPointSprite -> Just gl_POINT_SPRITE
- CapStencilTestTwoSide -> Just gl_STENCIL_TEST_TWO_SIDE
- -- TODO: use RASTER_POSITION_UNCLIPPED_IBM from IBM_rasterpos_clip extension
- CapRasterPositionUnclipped -> Just 0x19262
- 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Clipping.hs b/Graphics/Rendering/OpenGL/GL/Clipping.hs
--- a/Graphics/Rendering/OpenGL/GL/Clipping.hs
+++ b/Graphics/Rendering/OpenGL/GL/Clipping.hs
@@ -1,53 +1,57 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Clipping
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.12 (Clipping) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Clipping (
- ClipPlaneName(..), clipPlane, maxClipPlanes
-) where
-
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glClipPlane )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-newtype ClipPlaneName = ClipPlaneName GLsizei
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-clipPlane :: ClipPlaneName -> StateVar (Maybe (Plane GLdouble))
-clipPlane (ClipPlaneName i) =
- makeStateVarMaybe
- (return (CapClipPlane i))
--- (alloca $ \buf -> do
--- getDoublev (GetClipPlane i) (castPtr buf)
--- peek1 id (buf :: Ptr (Plane GLdouble)))
- (getDouble4 Plane (GetClipPlane i))
- (\plane -> maybe recordInvalidEnum (with plane . glClipPlane_)
- (clipPlaneIndexToEnum i))
-
-glClipPlane_ :: GLenum -> Ptr (Plane GLdouble) -> IO ()
-glClipPlane_ plane ptr = glClipPlane plane (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-maxClipPlanes :: GettableStateVar GLsizei
-maxClipPlanes = makeGettableStateVar (getSizei1 id GetMaxClipPlanes)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Clipping
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/ColorSum.hs b/Graphics/Rendering/OpenGL/GL/ColorSum.hs
--- a/Graphics/Rendering/OpenGL/GL/ColorSum.hs
+++ b/Graphics/Rendering/OpenGL/GL/ColorSum.hs
@@ -1,25 +1,25 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.ColorSum
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.9 (Color Sum) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.ColorSum (
- colorSum
-) where
-
-import Graphics.Rendering.OpenGL.GL.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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Colors.hs b/Graphics/Rendering/OpenGL/GL/Colors.hs
--- a/Graphics/Rendering/OpenGL/GL/Colors.hs
+++ b/Graphics/Rendering/OpenGL/GL/Colors.hs
@@ -1,520 +1,509 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Colors
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.14 (Colors and Coloring) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Colors (
- -- * Lighting
- lighting, Light(..), light, maxLights,
- FrontFaceDirection(..), frontFace,
-
- -- * Lighting Parameter Specification
- Face(..),
- materialAmbient, materialDiffuse, materialAmbientAndDiffuse,
- materialSpecular, materialEmission, materialShininess, maxShininess,
- materialColorIndexes,
-
- ambient, diffuse, specular,
- position, spotDirection, spotExponent, maxSpotExponent, spotCutoff,
- attenuation,
-
- lightModelAmbient, lightModelLocalViewer, lightModelTwoSide,
- vertexProgramTwoSide,
- LightModelColorControl(..), lightModelColorControl,
-
- -- * ColorMaterial
- ColorMaterialParameter(..), colorMaterial,
-
- -- * Flatshading
- ShadingModel(..), shadeModel,
-
- -- * 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.ARB.Compatibility (
- glColorMaterial, glGetLightfv, glGetMaterialfv, glGetMaterialiv,
- glLightModelfv, glLightModeli, glLightfv, glMaterialfv, glMaterialiv,
- glShadeModel, gl_AMBIENT, gl_AMBIENT_AND_DIFFUSE, gl_COLOR_INDEXES,
- gl_CONSTANT_ATTENUATION, gl_DIFFUSE, gl_EMISSION, gl_FLAT,
- gl_LIGHT_MODEL_AMBIENT, gl_LIGHT_MODEL_COLOR_CONTROL,
- gl_LIGHT_MODEL_LOCAL_VIEWER, gl_LIGHT_MODEL_TWO_SIDE, gl_LINEAR_ATTENUATION,
- gl_POSITION, gl_QUADRATIC_ATTENUATION, gl_SEPARATE_SPECULAR_COLOR,
- gl_SHININESS, gl_SINGLE_COLOR, gl_SMOOTH, gl_SPECULAR, gl_SPOT_CUTOFF,
- gl_SPOT_DIRECTION, gl_SPOT_EXPONENT,
- gl_CLAMP_FRAGMENT_COLOR, gl_CLAMP_VERTEX_COLOR )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-lighting :: StateVar Capability
-lighting = makeCapability CapLighting
-
---------------------------------------------------------------------------------
-
-newtype Light = Light GLsizei
- deriving ( Eq, Ord, Show )
-
-marshalLight :: Light -> Maybe GLenum
-marshalLight (Light l) = lightIndexToEnum l
-
---------------------------------------------------------------------------------
-
-light :: Light -> StateVar Capability
-light (Light l) = makeCapability (CapLight l)
-
-maxLights :: GettableStateVar GLsizei
-maxLights = makeGettableStateVar (getSizei1 id GetMaxLights)
-
---------------------------------------------------------------------------------
-
-data FrontFaceDirection =
- CW
- | CCW
- deriving ( Eq, Ord, Show )
-
-marshalFrontFaceDirection :: FrontFaceDirection -> GLenum
-marshalFrontFaceDirection x = case x of
- CW -> gl_CW
- CCW -> gl_CCW
-
-unmarshalFrontFaceDirection :: GLenum -> FrontFaceDirection
-unmarshalFrontFaceDirection x
- | x == gl_CW = CW
- | x == gl_CCW = CCW
- | otherwise = error ("unmarshalFrontFaceDirection: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-frontFace :: StateVar FrontFaceDirection
-frontFace =
- makeStateVar
- (getEnum1 unmarshalFrontFaceDirection GetFrontFace)
- (glFrontFace . marshalFrontFaceDirection)
-
---------------------------------------------------------------------------------
-
-data MaterialParameter =
- MaterialEmission
- | MaterialShininess
- | MaterialAmbientAndDiffuse
- | MaterialColorIndexes
- | MaterialAmbient
- | MaterialDiffuse
- | MaterialSpecular
-
-marshalMaterialParameter :: MaterialParameter -> GLenum
-marshalMaterialParameter x = case x of
- MaterialEmission -> gl_EMISSION
- MaterialShininess -> gl_SHININESS
- MaterialAmbientAndDiffuse -> gl_AMBIENT_AND_DIFFUSE
- MaterialColorIndexes -> gl_COLOR_INDEXES
- MaterialAmbient -> gl_AMBIENT
- MaterialDiffuse -> gl_DIFFUSE
- MaterialSpecular -> gl_SPECULAR
-
---------------------------------------------------------------------------------
-
-materialAmbient :: Face -> StateVar (Color4 GLfloat)
-materialAmbient =
- makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialAmbient
-
-materialDiffuse :: Face -> StateVar (Color4 GLfloat)
-materialDiffuse =
- makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialDiffuse
-
-materialAmbientAndDiffuse :: Face -> StateVar (Color4 GLfloat)
-materialAmbientAndDiffuse =
- makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialAmbientAndDiffuse
-
-materialSpecular :: Face -> StateVar (Color4 GLfloat)
-materialSpecular =
- makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialSpecular
-
-materialEmission :: Face -> StateVar (Color4 GLfloat)
-materialEmission =
- makeMaterialVar glGetMaterialfvc glMaterialfvc MaterialEmission
-
-makeMaterialVar :: Storable a
- => (GLenum -> GLenum -> Ptr a -> IO ())
- -> (GLenum -> GLenum -> Ptr a -> IO ())
- -> MaterialParameter -> Face -> StateVar a
-makeMaterialVar getter setter materialParameter face =
- makeStateVar (alloca $ \buf -> do getter f mp buf ; peek buf)
- (\val -> with val $ setter f mp)
- where mp = marshalMaterialParameter materialParameter
- f = marshalFace face
-
-glGetMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glGetMaterialfvc face pname ptr = glGetMaterialfv face pname (castPtr ptr)
-
-glMaterialfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glMaterialfvc face pname ptr = glMaterialfv face pname (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-materialShininess :: Face -> StateVar GLfloat
-materialShininess =
- makeMaterialVar glGetMaterialfvf glMaterialff MaterialShininess
-
-glGetMaterialfvf :: GLenum -> GLenum -> Ptr GLfloat -> IO ()
-glGetMaterialfvf face pname ptr = glGetMaterialfv face pname (castPtr ptr)
-
-glMaterialff :: GLenum -> GLenum -> Ptr GLfloat -> IO ()
-glMaterialff face pname ptr = glMaterialfv face pname (castPtr ptr)
-
-maxShininess :: GettableStateVar GLfloat
-maxShininess = makeGettableStateVar $ getFloat1 id GetMaxShininess
-
---------------------------------------------------------------------------------
-
--- Alas, (Index1 GLint, Index1 GLint, Index1 GLint) is not an instance of
--- Storable...
-
-materialColorIndexes ::
- Face -> StateVar (Index1 GLint, Index1 GLint, Index1 GLint)
-materialColorIndexes face =
- makeStateVar (getMaterialColorIndexes face) (setMaterialColorIndexes face)
-
-getMaterialColorIndexes :: Face -> IO (Index1 GLint, Index1 GLint, Index1 GLint)
-getMaterialColorIndexes face =
- allocaArray 3 $ \buf -> do
- glGetMaterialiv (marshalFace face)
- (marshalMaterialParameter MaterialColorIndexes)
- buf
- peek3 (\a d s -> (Index1 a, Index1 d, Index1 s)) buf
-
-setMaterialColorIndexes ::
- Face -> (Index1 GLint, Index1 GLint, Index1 GLint) -> IO ()
-setMaterialColorIndexes face (Index1 a, Index1 d, Index1 s) =
- withArray [a, d, s] $
- glMaterialiv (marshalFace face)
- (marshalMaterialParameter MaterialColorIndexes)
-
---------------------------------------------------------------------------------
-
-data LightParameter =
- Ambient'
- | Diffuse'
- | Specular'
- | Position
- | SpotDirection
- | SpotExponent
- | SpotCutoff
- | ConstantAttenuation
- | LinearAttenuation
- | QuadraticAttenuation
-
-marshalLightParameter :: LightParameter -> GLenum
-marshalLightParameter x = case x of
- Ambient' -> gl_AMBIENT
- Diffuse' -> gl_DIFFUSE
- Specular' -> gl_SPECULAR
- Position -> gl_POSITION
- SpotDirection -> gl_SPOT_DIRECTION
- SpotExponent -> gl_SPOT_EXPONENT
- SpotCutoff -> gl_SPOT_CUTOFF
- ConstantAttenuation -> gl_CONSTANT_ATTENUATION
- LinearAttenuation -> gl_LINEAR_ATTENUATION
- QuadraticAttenuation -> gl_QUADRATIC_ATTENUATION
-
---------------------------------------------------------------------------------
-
-ambient :: Light -> StateVar (Color4 GLfloat)
-ambient = makeLightVar glGetLightfvc glLightfvc Ambient' black
-
-black :: Color4 GLfloat
-black = Color4 0 0 0 0
-
-diffuse :: Light -> StateVar (Color4 GLfloat)
-diffuse = makeLightVar glGetLightfvc glLightfvc Diffuse' black
-
-specular :: Light -> StateVar (Color4 GLfloat)
-specular = makeLightVar glGetLightfvc glLightfvc Specular' black
-
-makeLightVar :: Storable a
- => (GLenum -> GLenum -> Ptr a -> IO ())
- -> (GLenum -> GLenum -> Ptr a -> IO ())
- -> LightParameter -> a -> Light -> StateVar a
-makeLightVar getter setter lightParameter defaultValue theLight =
- makeStateVar (maybe (return defaultValue) getLightVar ml)
- (\val -> maybe recordInvalidEnum (setLightVar val) ml)
- where lp = marshalLightParameter lightParameter
- ml = marshalLight theLight
- getLightVar = \l -> alloca $ \buf -> do getter l lp buf ; peek buf
- setLightVar = \val l -> with val $ setter l lp
-
-glGetLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glGetLightfvc l pname ptr = glGetLightfv l pname (castPtr ptr)
-
-glLightfvc :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glLightfvc l pname ptr = glLightfv l pname (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-position :: Light -> StateVar (Vertex4 GLfloat)
-position = makeLightVar glGetLightfvv glLightfvv Position (Vertex4 0 0 0 0)
-
-glLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
-glLightfvv l pname ptr = glLightfv l pname (castPtr ptr)
-
-glGetLightfvv :: GLenum -> GLenum -> Ptr (Vertex4 GLfloat) -> IO ()
-glGetLightfvv l pname ptr = glGetLightfv l pname (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-spotDirection :: Light -> StateVar (Normal3 GLfloat)
-spotDirection =
- makeLightVar glGetLightfvn glLightfvn SpotDirection (Normal3 0 0 0)
-
-glLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
-glLightfvn l pname ptr = glLightfv l pname (castPtr ptr)
-
-glGetLightfvn :: GLenum -> GLenum -> Ptr (Normal3 GLfloat) -> IO ()
-glGetLightfvn l pname ptr = glGetLightfv l pname (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-spotExponent :: Light -> StateVar GLfloat
-spotExponent = makeLightVar glGetLightfv glLightfv SpotExponent 0
-
-maxSpotExponent :: GettableStateVar GLfloat
-maxSpotExponent = makeGettableStateVar $ getFloat1 id GetMaxSpotExponent
-
---------------------------------------------------------------------------------
-
-spotCutoff :: Light -> StateVar GLfloat
-spotCutoff = makeLightVar glGetLightfv glLightfv SpotCutoff 0
-
---------------------------------------------------------------------------------
-
-attenuation :: Light -> StateVar (GLfloat, GLfloat, GLfloat)
-attenuation theLight =
- makeStateVar
- (liftM3 (,,) (get (constantAttenuation theLight))
- (get (linearAttenuation theLight))
- (get (quadraticAttenuation theLight)))
- (\(constant, linear, quadratic) -> do
- constantAttenuation theLight $= constant
- linearAttenuation theLight $= linear
- quadraticAttenuation theLight $= quadratic)
-
-constantAttenuation :: Light -> StateVar GLfloat
-constantAttenuation = makeLightVar glGetLightfv glLightfv ConstantAttenuation 0
-
-linearAttenuation :: Light -> StateVar GLfloat
-linearAttenuation = makeLightVar glGetLightfv glLightfv LinearAttenuation 0
-
-quadraticAttenuation :: Light -> StateVar GLfloat
-quadraticAttenuation =
- makeLightVar glGetLightfv glLightfv QuadraticAttenuation 0
-
---------------------------------------------------------------------------------
-
-data LightModelParameter =
- LightModelAmbient
- | LightModelLocalViewer
- | LightModelTwoSide
- | LightModelColorControl
-
-marshalLightModelParameter :: LightModelParameter -> GLenum
-marshalLightModelParameter x = case x of
- LightModelAmbient -> gl_LIGHT_MODEL_AMBIENT
- LightModelLocalViewer -> gl_LIGHT_MODEL_LOCAL_VIEWER
- LightModelTwoSide -> gl_LIGHT_MODEL_TWO_SIDE
- LightModelColorControl -> gl_LIGHT_MODEL_COLOR_CONTROL
-
---------------------------------------------------------------------------------
-
-lightModelAmbient :: StateVar (Color4 GLfloat)
-lightModelAmbient =
- makeStateVar
- (getFloat4 Color4 GetLightModelAmbient)
- (\c -> with c $
- glLightModelfv (marshalLightModelParameter LightModelAmbient) . castPtr)
-
---------------------------------------------------------------------------------
-
-lightModelLocalViewer :: StateVar Capability
-lightModelLocalViewer =
- makeLightModelCapVar GetLightModelLocalViewer LightModelLocalViewer
-
-makeLightModelCapVar :: 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs b/Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs
--- a/Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs
+++ b/Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs
@@ -1,57 +1,57 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.ComparisonFunction
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling ComparisonFunction.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.ComparisonFunction (
- ComparisonFunction(..), marshalComparisonFunction,
- unmarshalComparisonFunction
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data ComparisonFunction =
- Never
- | Less
- | Equal
- | Lequal
- | Greater
- | Notequal
- | Gequal
- | Always
- deriving ( Eq, Ord, Show )
-
-marshalComparisonFunction :: ComparisonFunction -> GLenum
-marshalComparisonFunction x = case x of
- Never -> gl_NEVER
- Less -> gl_LESS
- Equal -> gl_EQUAL
- Lequal -> gl_LEQUAL
- Greater -> gl_GREATER
- Notequal -> gl_NOTEQUAL
- Gequal -> gl_GEQUAL
- Always -> gl_ALWAYS
-
-unmarshalComparisonFunction :: GLenum -> ComparisonFunction
-unmarshalComparisonFunction x
- | x == gl_NEVER = Never
- | x == gl_LESS = Less
- | x == gl_EQUAL = Equal
- | x == gl_LEQUAL = Lequal
- | x == gl_GREATER = Greater
- | x == gl_NOTEQUAL = Notequal
- | x == gl_GEQUAL = Gequal
- | x == gl_ALWAYS = Always
- | otherwise = error ("unmarshalComparisonFunction: illegal value " ++ show x)
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.ComparisonFunction
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/ConditionalRendering.hs b/Graphics/Rendering/OpenGL/GL/ConditionalRendering.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/ConditionalRendering.hs
@@ -0,0 +1,52 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.ConditionalRendering
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/ControlPoint.hs b/Graphics/Rendering/OpenGL/GL/ControlPoint.hs
--- a/Graphics/Rendering/OpenGL/GL/ControlPoint.hs
+++ b/Graphics/Rendering/OpenGL/GL/ControlPoint.hs
@@ -1,169 +1,162 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.ControlPoint
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for handling control points.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.ControlPoint (
- ControlPoint(..)
-) where
-
-import Foreign.Ptr
-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.Core31
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_MAP1_COLOR_4, gl_MAP1_INDEX, gl_MAP1_NORMAL, gl_MAP1_TEXTURE_COORD_1,
- gl_MAP1_TEXTURE_COORD_2, gl_MAP1_TEXTURE_COORD_3, gl_MAP1_TEXTURE_COORD_4,
- gl_MAP1_VERTEX_3, gl_MAP2_COLOR_4, gl_MAP2_INDEX, gl_MAP2_NORMAL,
- gl_MAP2_TEXTURE_COORD_1, gl_MAP2_TEXTURE_COORD_2, gl_MAP2_TEXTURE_COORD_3,
- gl_MAP2_TEXTURE_COORD_4, gl_MAP2_VERTEX_3, gl_MAP2_VERTEX_4,
- gl_MAP1_VERTEX_4 )
-
---------------------------------------------------------------------------------
-
-class ControlPoint c where
- map1Target :: Domain d => c d -> GLenum
- map2Target :: Domain d => c d -> GLenum
- enableCap1 :: Domain d => c d -> EnableCap
- enableCap2 :: Domain d => c d -> EnableCap
- numComponents :: Domain d => c d -> Stride
- peekControlPoint :: Domain d => Ptr (c d) -> IO (c d)
- pokeControlPoint :: Domain d => Ptr (c d) -> (c d) -> IO ()
-
-instance ControlPoint Vertex3 where
- map1Target = marshalMapTarget . const Map1Vertex3
- map2Target = marshalMapTarget . const Map2Vertex3
- enableCap1 = const CapMap1Vertex3
- enableCap2 = const CapMap2Vertex3
- numComponents = const 3
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint Vertex4 where
- map1Target = marshalMapTarget . const Map1Vertex4
- map2Target = marshalMapTarget . const Map2Vertex4
- enableCap1 = const CapMap1Vertex4
- enableCap2 = const CapMap2Vertex4
- numComponents = const 4
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint Index1 where
- map1Target = marshalMapTarget . const Map1Index
- map2Target = marshalMapTarget . const Map2Index
- enableCap1 = const CapMap1Index
- enableCap2 = const CapMap2Index
- numComponents = const 1
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint Color4 where
- map1Target = marshalMapTarget . const Map1Color4
- map2Target = marshalMapTarget . const Map2Color4
- enableCap1 = const CapMap1Color4
- enableCap2 = const CapMap2Color4
- numComponents = const 4
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint Normal3 where
- map1Target = marshalMapTarget . const Map1Normal
- map2Target = marshalMapTarget . const Map2Normal
- enableCap1 = const CapMap1Normal
- enableCap2 = const CapMap2Normal
- numComponents = const 3
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint TexCoord1 where
- map1Target = marshalMapTarget . const Map1TextureCoord1
- map2Target = marshalMapTarget . const Map2TextureCoord1
- enableCap1 = const CapMap1TextureCoord1
- enableCap2 = const CapMap2TextureCoord1
- numComponents = const 1
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint TexCoord2 where
- map1Target = marshalMapTarget . const Map1TextureCoord2
- map2Target = marshalMapTarget . const Map2TextureCoord2
- enableCap1 = const CapMap1TextureCoord2
- enableCap2 = const CapMap2TextureCoord2
- numComponents = const 2
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint TexCoord3 where
- map1Target = marshalMapTarget . const Map1TextureCoord3
- map2Target = marshalMapTarget . const Map2TextureCoord3
- enableCap1 = const CapMap1TextureCoord3
- enableCap2 = const CapMap2TextureCoord3
- numComponents = const 3
- peekControlPoint = peek
- pokeControlPoint = poke
-
-instance ControlPoint TexCoord4 where
- map1Target = marshalMapTarget . const Map1TextureCoord4
- map2Target = marshalMapTarget . const Map2TextureCoord4
- enableCap1 = const CapMap1TextureCoord4
- enableCap2 = const CapMap2TextureCoord4
- numComponents = const 4
- peekControlPoint = peek
- pokeControlPoint = poke
-
---------------------------------------------------------------------------------
-
-data MapTarget =
- Map1Color4
- | Map1Index
- | Map1Normal
- | Map1TextureCoord1
- | Map1TextureCoord2
- | Map1TextureCoord3
- | Map1TextureCoord4
- | Map1Vertex3
- | Map1Vertex4
- | Map2Color4
- | Map2Index
- | Map2Normal
- | Map2TextureCoord1
- | Map2TextureCoord2
- | Map2TextureCoord3
- | Map2TextureCoord4
- | Map2Vertex3
- | Map2Vertex4
-
-marshalMapTarget :: MapTarget -> GLenum
-marshalMapTarget x = case x of
- Map1Color4 -> gl_MAP1_COLOR_4
- Map1Index -> gl_MAP1_INDEX
- Map1Normal -> gl_MAP1_NORMAL
- Map1TextureCoord1 -> gl_MAP1_TEXTURE_COORD_1
- Map1TextureCoord2 -> gl_MAP1_TEXTURE_COORD_2
- Map1TextureCoord3 -> gl_MAP1_TEXTURE_COORD_3
- Map1TextureCoord4 -> gl_MAP1_TEXTURE_COORD_4
- Map1Vertex3 -> gl_MAP1_VERTEX_3
- Map1Vertex4 -> gl_MAP1_VERTEX_4
- Map2Color4 -> gl_MAP2_COLOR_4
- Map2Index -> gl_MAP2_INDEX
- Map2Normal -> gl_MAP2_NORMAL
- Map2TextureCoord1 -> gl_MAP2_TEXTURE_COORD_1
- Map2TextureCoord2 -> gl_MAP2_TEXTURE_COORD_2
- Map2TextureCoord3 -> gl_MAP2_TEXTURE_COORD_3
- Map2TextureCoord4 -> gl_MAP2_TEXTURE_COORD_4
- Map2Vertex3 -> gl_MAP2_VERTEX_3
- Map2Vertex4 -> gl_MAP2_VERTEX_4
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.ControlPoint
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/CoordTrans.hs b/Graphics/Rendering/OpenGL/GL/CoordTrans.hs
--- a/Graphics/Rendering/OpenGL/GL/CoordTrans.hs
+++ b/Graphics/Rendering/OpenGL/GL/CoordTrans.hs
@@ -1,532 +1,518 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.CoordTrans
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.11 (Coordinate Transformations) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-{-# 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(..),
- currentMatrix, matrix, multMatrix, GLmatrix, loadIdentity,
- ortho, frustum, depthClamp,
- activeTexture,
- preservingMatrix, unsafePreservingMatrix,
- stackDepth, maxStackDepth,
-
- -- * Normal Transformation
- rescaleNormal, normalize,
-
- -- * Generating Texture Coordinates
- Plane(..), TextureCoordName(..), TextureGenMode(..), textureGenMode
-) where
-
-import Foreign.ForeignPtr
-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.ARB.Compatibility (
- glFrustum, glGetTexGendv, glGetTexGeniv, glLoadIdentity, glLoadMatrixd,
- glLoadMatrixf, glLoadTransposeMatrixd, glLoadTransposeMatrixf, glMatrixMode,
- glMultMatrixd, glMultMatrixf, glMultTransposeMatrixd, glMultTransposeMatrixf,
- glOrtho, glPopMatrix, glPushMatrix, glRotated, glRotatef, glScaled, glScalef,
- glTexGendv, glTexGeni, glTranslated, glTranslatef, gl_EYE_LINEAR,
- gl_EYE_PLANE, gl_NORMAL_MAP, gl_OBJECT_LINEAR, gl_OBJECT_PLANE,
- gl_PROJECTION, gl_Q, gl_R, gl_REFLECTION_MAP, gl_S, gl_SPHERE_MAP, gl_T,
- gl_TEXTURE_GEN_MODE )
-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette ( gl_MATRIX_PALETTE )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | After clipping and division by /w/, depth coordinates range from -1 to 1,
--- corresponding to the near and far clipping planes. 'depthRange' specifies a
--- linear mapping of the normalized depth coordinates in this range to window
--- depth coordinates. Regardless of the actual depth buffer implementation,
--- window coordinate depth values are treated as though they range from 0
--- through 1 (like color components). Thus, the values accepted by 'depthRange'
--- are both clamped to this range before they are accepted.
---
--- The initial setting of (0, 1) maps the near plane to 0 and the far plane to
--- 1. With this mapping, the depth buffer range is fully utilized.
---
--- It is not necessary that the near value be less than the far value. Reverse
--- mappings such as (1, 0) are acceptable.
-
-depthRange :: StateVar (GLclampd, GLclampd)
-depthRange = makeStateVar (getClampd2 (,) GetDepthRange) (uncurry glDepthRange)
-
---------------------------------------------------------------------------------
-
--- | A 2-dimensional position, measured in pixels.
-data Position = Position !GLint !GLint
- deriving ( Eq, Ord, Show )
-
--- | A 2-dimensional size, measured in pixels.
-data Size = Size !GLsizei !GLsizei
- deriving ( Eq, Ord, Show )
-
--- | Controls the affine transformation from normalized device coordinates to
--- window coordinates. The viewport state variable consists of the coordinates
--- (/x/, /y/) of the lower left corner of the viewport rectangle, (in pixels,
--- initial value (0,0)), and the size (/width/, /height/) of the viewport. When
--- a GL context is first attached to a window, /width/ and /height/ are set to
--- the dimensions of that window.
---
--- Let (/xnd/, /ynd/) be normalized device coordinates. Then the window
--- coordinates (/xw/, /yw/) are computed as follows:
---
--- /xw/ = (/xnd/ + 1) (/width/ \/ 2) + /x/
---
--- /yw/ = (/ynd/ + 1) (/heigth/ \/ 2) + /y/
---
--- Viewport width and height are silently clamped to a range that depends on the
--- implementation, see 'maxViewportDims'.
-
-viewport :: StateVar (Position, Size)
-viewport = makeStateVar (getInteger4 makeVp GetViewport)
- (\(Position x y, Size w h) -> glViewport x y w h)
- where makeVp x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))
-
--- | The implementation-dependent maximum viewport width and height.
-
-maxViewportDims :: GettableStateVar Size
-maxViewportDims = makeGettableStateVar (getSizei2 Size GetMaxViewportDims)
-
---------------------------------------------------------------------------------
-
--- | A matrix stack.
-
-data MatrixMode =
- Modelview GLsizei -- ^ The modelview matrix stack of the specified vertex unit.
- | Projection -- ^ The projection matrix stack.
- | Texture -- ^ The texture matrix stack.
- | Color -- ^ The color matrix stack.
- | MatrixPalette -- ^ The matrix palette stack.
- deriving ( Eq, Ord, Show )
-
-marshalMatrixMode :: MatrixMode -> Maybe GLenum
-marshalMatrixMode x = case x of
- Modelview i -> modelviewIndexToEnum i
- Projection -> Just gl_PROJECTION
- Texture -> Just gl_TEXTURE
- Color -> Just gl_COLOR
- MatrixPalette -> Just gl_MATRIX_PALETTE
-
-unmarshalMatrixMode :: GLenum -> MatrixMode
-unmarshalMatrixMode x
- | x == gl_PROJECTION = Projection
- | x == gl_TEXTURE = Texture
- | x == gl_COLOR = Color
- | x == gl_MATRIX_PALETTE = MatrixPalette
- | otherwise =
- case modelviewEnumToIndex x of
- Just i -> Modelview i
- Nothing -> error ("unmarshalMatrixMode: illegal value " ++ show x)
-
-matrixModeToGetMatrix :: MatrixMode -> 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 ]
-
---------------------------------------------------------------------------------
-
-{-# DEPRECATED currentMatrix "use `matrix' instead" #-}
-currentMatrix :: (Matrix m, MatrixComponent c) => StateVar (m c)
-currentMatrix = matrix Nothing
-
-matrix :: (Matrix m, MatrixComponent c) => Maybe MatrixMode -> StateVar (m c)
-matrix maybeMode =
- makeStateVar
- (maybe (get matrixMode) return maybeMode >>= (getMatrix' . matrixModeToGetMatrix))
- (maybe id withMatrixMode maybeMode . setMatrix)
-
-withMatrixMode :: MatrixMode -> IO a -> IO a
-withMatrixMode mode act =
- preservingMatrixMode $ do
- matrixMode $= mode
- act
-
-getMatrix' :: (Matrix m, MatrixComponent c) => 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
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/DataType.hs b/Graphics/Rendering/OpenGL/GL/DataType.hs
--- a/Graphics/Rendering/OpenGL/GL/DataType.hs
+++ b/Graphics/Rendering/OpenGL/GL/DataType.hs
@@ -1,160 +1,158 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.DataType
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling DataType.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.DataType (
- DataType(..), marshalDataType, unmarshalDataType,
- DataTypeType(..), marshalDataTypeType, unmarshalDataTypeType
-) where
-
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_2_BYTES, gl_3_BYTES, gl_4_BYTES, gl_BITMAP )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- basically table 3.2 (pixel data type parameter) plus a few additions
-data DataType =
- UnsignedByte
- | Byte
- | UnsignedShort
- | Short
- | UnsignedInt
- | Int
- | HalfFloat
- | Float
- | UnsignedByte332
- | UnsignedByte233Rev
- | UnsignedShort565
- | UnsignedShort565Rev
- | UnsignedShort4444
- | UnsignedShort4444Rev
- | UnsignedShort5551
- | UnsignedShort1555Rev
- | UnsignedInt8888
- | UnsignedInt8888Rev
- | UnsignedInt1010102
- | UnsignedInt2101010Rev
- | UnsignedInt248
- | UnsignedInt10f11f11fRev
- | UnsignedInt5999Rev
- | Float32UnsignedInt248Rev
- | Bitmap -- pixel data, deprecated in 3.1
- | UnsignedShort88 -- MESA_ycbcr_texture/APPLE_ycbcr_422
- | UnsignedShort88Rev -- MESA_ycbcr_texture/APPLE_ycbcr_422
- | Double -- vertex arrays (EXT_vertex_array, now core)
- | TwoBytes -- CallLists
- | ThreeBytes -- CallLists
- | FourBytes -- CallLists
- deriving ( Eq, Ord, Show )
-
-marshalDataType :: DataType -> GLenum
-marshalDataType x = case x of
- UnsignedByte -> gl_UNSIGNED_BYTE
- Byte -> gl_BYTE
- UnsignedShort -> gl_UNSIGNED_SHORT
- Short -> gl_SHORT
- UnsignedInt -> gl_UNSIGNED_INT
- Int -> gl_INT
- HalfFloat -> gl_HALF_FLOAT
- Float -> gl_FLOAT
- UnsignedByte332 -> gl_UNSIGNED_BYTE_3_3_2
- UnsignedByte233Rev -> gl_UNSIGNED_BYTE_2_3_3_REV
- UnsignedShort565 -> gl_UNSIGNED_SHORT_5_6_5
- UnsignedShort565Rev -> gl_UNSIGNED_SHORT_5_6_5_REV
- UnsignedShort4444 -> gl_UNSIGNED_SHORT_4_4_4_4
- UnsignedShort4444Rev -> gl_UNSIGNED_SHORT_4_4_4_4_REV
- UnsignedShort5551 -> gl_UNSIGNED_SHORT_5_5_5_1
- UnsignedShort1555Rev -> gl_UNSIGNED_SHORT_1_5_5_5_REV
- UnsignedInt8888 -> gl_UNSIGNED_INT_8_8_8_8
- UnsignedInt8888Rev -> gl_UNSIGNED_INT_8_8_8_8_REV
- UnsignedInt1010102 -> gl_UNSIGNED_INT_10_10_10_2
- UnsignedInt2101010Rev -> gl_UNSIGNED_INT_2_10_10_10_REV
- UnsignedInt248 -> gl_UNSIGNED_INT_24_8
- UnsignedInt10f11f11fRev -> gl_UNSIGNED_INT_10F_11F_11F_REV
- UnsignedInt5999Rev -> gl_UNSIGNED_INT_5_9_9_9_REV
- Float32UnsignedInt248Rev -> gl_FLOAT_32_UNSIGNED_INT_24_8_REV
- Bitmap -> gl_BITMAP
- -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension
- UnsignedShort88 -> 0x85ba
- -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension
- UnsignedShort88Rev -> 0x85bb
- Double -> gl_DOUBLE
- TwoBytes -> gl_2_BYTES
- ThreeBytes -> gl_3_BYTES
- FourBytes -> gl_4_BYTES
-
-unmarshalDataType :: GLenum -> DataType
-unmarshalDataType x
- | x == gl_UNSIGNED_BYTE = UnsignedByte
- | x == gl_BYTE = Byte
- | x == gl_UNSIGNED_SHORT = UnsignedShort
- | x == gl_SHORT = Short
- | x == gl_UNSIGNED_INT = UnsignedInt
- | x == gl_INT = Int
- | x == gl_HALF_FLOAT = HalfFloat
- | x == gl_FLOAT = Float
- | x == gl_UNSIGNED_BYTE_3_3_2 = UnsignedByte332
- | x == gl_UNSIGNED_BYTE_2_3_3_REV = UnsignedByte233Rev
- | x == gl_UNSIGNED_SHORT_5_6_5 = UnsignedShort565
- | x == gl_UNSIGNED_SHORT_5_6_5_REV = UnsignedShort565Rev
- | x == gl_UNSIGNED_SHORT_4_4_4_4 = UnsignedShort4444
- | x == gl_UNSIGNED_SHORT_4_4_4_4_REV = UnsignedShort4444Rev
- | x == gl_UNSIGNED_SHORT_5_5_5_1 = UnsignedShort5551
- | x == gl_UNSIGNED_SHORT_1_5_5_5_REV = UnsignedShort1555Rev
- | x == gl_UNSIGNED_INT_8_8_8_8 = UnsignedInt8888
- | x == gl_UNSIGNED_INT_8_8_8_8_REV = UnsignedInt8888Rev
- | x == gl_UNSIGNED_INT_10_10_10_2 = UnsignedInt1010102
- | x == gl_UNSIGNED_INT_2_10_10_10_REV = UnsignedInt2101010Rev
- | x == gl_UNSIGNED_INT_24_8 = UnsignedInt248
- | x == gl_UNSIGNED_INT_10F_11F_11F_REV = UnsignedInt10f11f11fRev
- | x == gl_UNSIGNED_INT_5_9_9_9_REV = UnsignedInt5999Rev
- | x == gl_FLOAT_32_UNSIGNED_INT_24_8_REV = Float32UnsignedInt248Rev
- | x == gl_BITMAP = Bitmap
- -- TODO: Use UNSIGNED_SHORT_8_8_APPLE from APPLE_ycbcr_422 extension
- | x == 0x85ba = UnsignedShort88
- -- TODO: Use UNSIGNED_SHORT_8_8_REV_APPLE from APPLE_ycbcr_422 extension
- | x == 0x85bb = UnsignedShort88Rev
- | x == gl_DOUBLE = Double
- | x == gl_2_BYTES = TwoBytes
- | x == gl_3_BYTES = ThreeBytes
- | x == gl_4_BYTES = FourBytes
- | otherwise = error ("unmarshalDataType: illegal value " ++ show x)
-
-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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/DisplayLists.hs b/Graphics/Rendering/OpenGL/GL/DisplayLists.hs
--- a/Graphics/Rendering/OpenGL/GL/DisplayLists.hs
+++ b/Graphics/Rendering/OpenGL/GL/DisplayLists.hs
@@ -1,158 +1,124 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.DisplayLists
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 5.4 (Display Lists) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.DisplayLists (
- -- * Defining Display Lists
- DisplayList(..), ListMode(..), defineList, defineNewList, listIndex,
- listMode, maxListNesting,
-
- -- * Calling Display Lists
- callList, callLists, listBase,
-
- -- * Deprecated Functions
- genLists, deleteLists, isList,
-) where
-
-import Foreign.Ptr
-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.ARB.Compatibility (
- glCallList, glCallLists, glDeleteLists, glEndList, glGenLists, glIsList,
- glListBase, glNewList, gl_COMPILE, gl_COMPILE_AND_EXECUTE )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-newtype DisplayList = DisplayList GLuint
- deriving ( Eq, Ord, Show )
-
-instance ObjectName DisplayList where
- genObjectNames = genLists_
- deleteObjectNames = deleteLists_
- isObjectName = isList_
-
---------------------------------------------------------------------------------
-
-{-# DEPRECATED genLists "use `genObjectNames' instead" #-}
-genLists :: GLsizei -> IO [DisplayList]
-genLists = genLists_ . fromIntegral
-
-genLists_ :: Int -> IO [DisplayList]
-genLists_ n = do
- first <- glGenLists (fromIntegral n)
- if DisplayList first == noDisplayList
- then do recordOutOfMemory
- return []
- else return [ DisplayList l | l <- [ first .. first + fromIntegral n - 1 ] ]
-
---------------------------------------------------------------------------------
-
-{-# DEPRECATED deleteLists "use `deleteObjectNames' instead" #-}
-deleteLists :: [DisplayList] -> IO ()
-deleteLists = deleteLists_
-
-deleteLists_ :: [DisplayList] -> IO ()
-deleteLists_ = mapM_ (uncurry glDeleteLists) . combineConsecutive
-
-combineConsecutive :: [DisplayList] -> [(GLuint, GLsizei)]
-combineConsecutive [] = []
-combineConsecutive (z@(DisplayList dl) :zs) = (dl, len) : combineConsecutive rest
- where (len, rest) = run (0 :: GLsizei) z zs
- run n x xs = case n + 1 of
- m -> case xs of
- [] -> (m, [])
- (y:ys) | x `isFollowedBy` y -> run m y ys
- | otherwise -> (m, xs)
- DisplayList x `isFollowedBy` DisplayList y = x + 1 == y
-
---------------------------------------------------------------------------------
-
-{-# DEPRECATED isList "use `isObjectName' instead" #-}
-isList :: DisplayList -> IO Bool
-isList = isList_
-
-isList_ :: DisplayList -> IO Bool
-isList_ (DisplayList dl) = fmap unmarshalGLboolean (glIsList dl)
-
---------------------------------------------------------------------------------
-
-data ListMode =
- Compile
- | CompileAndExecute
- deriving ( Eq, Ord, Show )
-
-marshalListMode :: ListMode -> GLenum
-marshalListMode x = case x of
- Compile -> gl_COMPILE
- CompileAndExecute -> gl_COMPILE_AND_EXECUTE
-
-unmarshalListMode :: GLenum -> ListMode
-unmarshalListMode x
- | x == gl_COMPILE = Compile
- | x == gl_COMPILE_AND_EXECUTE = CompileAndExecute
- | otherwise = error ("unmarshalListMode: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-defineList :: DisplayList -> ListMode -> IO a -> IO a
-defineList (DisplayList dl) mode = bracket_ (glNewList dl (marshalListMode mode)) glEndList
-
-defineNewList :: ListMode -> IO a -> IO DisplayList
-defineNewList mode action = do
- lists <- genLists 1
- if null lists
- then do recordOutOfMemory
- return noDisplayList
- else do let lst = head lists
- _ <- defineList lst mode action
- return lst
-
---------------------------------------------------------------------------------
-
-listIndex :: GettableStateVar (Maybe DisplayList)
-listIndex =
- makeGettableStateVar
- (do l <- getEnum1 (DisplayList . fromIntegral) GetListIndex
- return $ if l == noDisplayList then Nothing else Just l)
-
-noDisplayList :: DisplayList
-noDisplayList = DisplayList 0
-
-listMode :: GettableStateVar ListMode
-listMode = makeGettableStateVar (getEnum1 unmarshalListMode GetListMode)
-
-maxListNesting :: GettableStateVar GLsizei
-maxListNesting = makeGettableStateVar (getSizei1 id GetMaxListNesting)
-
---------------------------------------------------------------------------------
-
-callList :: DisplayList -> IO ()
-callList (DisplayList dl) = glCallList dl
-
-callLists :: GLsizei -> DataType -> Ptr a -> IO ()
-callLists n = glCallLists n . marshalDataType
-
---------------------------------------------------------------------------------
-
-listBase :: StateVar DisplayList
-listBase =
- makeStateVar
- (getEnum1 (DisplayList . fromIntegral) GetListBase)
- (\(DisplayList dl) -> glListBase dl)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.DisplayLists
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Domain.hs b/Graphics/Rendering/OpenGL/GL/Domain.hs
--- a/Graphics/Rendering/OpenGL/GL/Domain.hs
+++ b/Graphics/Rendering/OpenGL/GL/Domain.hs
@@ -1,73 +1,68 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Domain
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for handling evaluator domains.
---
---------------------------------------------------------------------------------
-
-{-# 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.Core31
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glEvalCoord1d, glEvalCoord1dv, glEvalCoord1f, glEvalCoord1fv, glEvalCoord2d,
- glEvalCoord2dv, glEvalCoord2f, glEvalCoord2fv, glGetMapdv, glGetMapfv,
- glMap1d, glMap1f, glMap2d, glMap2f, glMapGrid1d, glMapGrid1f, glMapGrid2d,
- glMapGrid2f )
-
---------------------------------------------------------------------------------
-
-class Storable d => Domain d where
- glMap1 :: GLenum -> d -> d -> GLint -> GLint -> Ptr d -> IO ()
- glMap2 :: GLenum -> d -> d -> GLint -> GLint -> d -> d -> GLint -> GLint -> Ptr d -> IO ()
- glGetMapv :: GLenum -> GLenum -> Ptr d -> IO ()
- evalCoord1 :: d -> IO ()
- evalCoord1v :: Ptr d -> IO ()
- evalCoord2 :: (d, d) -> IO ()
- evalCoord2v :: Ptr d -> IO ()
- glMapGrid1 :: GLint -> d -> d -> IO ()
- glMapGrid2 :: GLint -> d -> d -> GLint -> d -> d -> IO ()
- get2 :: 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs b/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs
--- a/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs
+++ b/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs
@@ -1,36 +1,36 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.EdgeFlag
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling EdgeFlag.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.EdgeFlag (
- EdgeFlag(..), marshalEdgeFlag, unmarshalEdgeFlag
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.GL.GLboolean
-
---------------------------------------------------------------------------------
-
--- | A vertex can begin an edge which lies in the interior of its polygon or on
--- the polygon\'s boundary.
-
-data EdgeFlag = BeginsInteriorEdge | BeginsBoundaryEdge
- deriving ( Eq, Ord, Show )
-
-marshalEdgeFlag :: EdgeFlag -> GLboolean
-marshalEdgeFlag = marshalGLboolean . (BeginsBoundaryEdge ==)
-
-unmarshalEdgeFlag :: GLboolean -> EdgeFlag
-unmarshalEdgeFlag f =
- if unmarshalGLboolean f then BeginsBoundaryEdge else BeginsInteriorEdge
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.EdgeFlag
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Evaluators.hs b/Graphics/Rendering/OpenGL/GL/Evaluators.hs
--- a/Graphics/Rendering/OpenGL/GL/Evaluators.hs
+++ b/Graphics/Rendering/OpenGL/GL/Evaluators.hs
@@ -1,370 +1,367 @@
-{-# LANGUAGE KindSignatures #-}
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Evaluators
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 5.1 (Evaluators) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Evaluators (
- -- * Evaluator-related Types
- Order, maxOrder, Domain, MapDescriptor(..), ControlPoint,
-
- -- * Defining Evaluator Maps
- -- ** One-dimensional Evaluator Maps
- Map1(..), GLmap1, map1,
-
- -- ** Two-dimensional Evaluator Maps
- Map2(..), GLmap2, map2,
-
- -- * Using Evaluator Maps
-
- -- ** Evaluating an Arbitrary Coordinate Value
- evalCoord1, evalCoord1v, evalCoord2, evalCoord2v,
-
- -- ** Using Evenly Spaced Coordinate Values
-
- -- *** Defining a Grid
- mapGrid1, mapGrid2,
-
- -- *** Evaluating a Whole Mesh
- evalMesh1, evalMesh2,
-
- -- *** Evaluating a Single Point on a Mesh
- evalPoint1, evalPoint2,
-
- -- * Normal Generation
- autoNormal
-) where
-
-import Control.Monad
-import Data.List
-import Foreign.ForeignPtr
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.ControlPoint
-import Graphics.Rendering.OpenGL.GL.Domain
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PolygonMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexArrays
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glEvalMesh1, glEvalMesh2, glEvalPoint1, glEvalPoint2, glGetMapiv, gl_COEFF,
- gl_DOMAIN, gl_ORDER )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-type Order = GLint
-
-maxOrder :: GettableStateVar Order
-maxOrder = makeGettableStateVar (getInteger1 id GetMaxEvalOrder)
-
---------------------------------------------------------------------------------
-
-data MapDescriptor d =
- MapDescriptor (d, d) Stride Order NumComponents
- deriving ( Eq, Ord, Show )
-
-totalComponents1 :: Domain d => MapDescriptor d -> Int
-totalComponents1 (MapDescriptor _ stride order numComp) =
- fromIntegral stride * (fromIntegral order - 1) + fromIntegral numComp
-
-totalComponents2 :: Domain d => MapDescriptor d -> MapDescriptor d -> Int
-totalComponents2 uDescriptor vDescriptor@(MapDescriptor _ _ _ numComp) =
- totalComponents1 uDescriptor + totalComponents1 vDescriptor - fromIntegral numComp
-
---------------------------------------------------------------------------------
-
-peekControlPoints1 ::
- (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> IO [c d]
-peekControlPoints1 descriptor ptr =
- mapM peekControlPoint (controlPointPtrs1 descriptor ptr)
-
-peekControlPoints2 ::
- (ControlPoint c, Domain d)
- => MapDescriptor d -> MapDescriptor d -> Ptr d -> IO [[c d]]
-peekControlPoints2 uDescriptor vDescriptor ptr =
- mapM (mapM peekControlPoint) (controlPointPtrs2 uDescriptor vDescriptor ptr)
-
-pokeControlPoints1 ::
- (ControlPoint c, Domain d) => MapDescriptor d -> Ptr d -> [c d] -> IO ()
-pokeControlPoints1 descriptor ptr =
- zipWithM_ pokeControlPoint (controlPointPtrs1 descriptor ptr)
-
-pokeControlPoints2 ::
- (ControlPoint c, Domain d)
- => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[c d]] -> IO ()
-pokeControlPoints2 uDescriptor vDescriptor ptr =
- zipWithM_ (zipWithM_ pokeControlPoint)
- (controlPointPtrs2 uDescriptor vDescriptor ptr)
-
-controlPointPtrs1 :: Domain d => MapDescriptor d -> Ptr d -> [Ptr a]
-controlPointPtrs1 (MapDescriptor _ stride order _) ptr =
- [ ptr `plusPtr` (o * s) | o <- [ 0 .. fromIntegral order - 1 ] ]
- where s = sizeOfPtr ptr * fromIntegral stride
-
-controlPointPtrs2 ::
- Domain d => MapDescriptor d -> MapDescriptor d -> Ptr d -> [[Ptr a]]
-controlPointPtrs2 uDescriptor vDescriptor ptr =
- [ controlPointPtrs1 vDescriptor p | p <- controlPointPtrs1 uDescriptor ptr ]
-
-sizeOfPtr :: Storable a => Ptr a -> Int
-sizeOfPtr = sizeOf . (const undefined :: Ptr a -> a)
-
---------------------------------------------------------------------------------
-
-class Map1 m where
- withNewMap1 :: (ControlPoint c, Domain d)
- => MapDescriptor d -> (Ptr d -> IO ()) -> IO (m c d)
-
- withMap1 :: (ControlPoint c, Domain d)
- => m c d -> (MapDescriptor d -> Ptr d -> IO a) -> IO a
-
- newMap1 :: (ControlPoint c, Domain d)
- => (d, d) -> [c d] -> IO (m c d)
-
- getMap1Components :: (ControlPoint c, Domain d)
- => m c d -> IO ((d, d), [c d])
-
- withNewMap1 descriptor@(MapDescriptor domain _ _ _) act = do
- allocaArray (totalComponents1 descriptor) $ \ptr -> do
- act ptr
- controlPoints <- peekControlPoints1 descriptor ptr
- newMap1 domain controlPoints
-
- withMap1 m act = do
- (domain, controlPoints) <- getMap1Components m
- let stride = numComponents (head controlPoints)
- order = genericLength controlPoints
- descriptor = MapDescriptor domain stride order (fromIntegral stride)
- allocaArray (totalComponents1 descriptor) $ \ptr -> do
- pokeControlPoints1 descriptor ptr controlPoints
- act descriptor ptr
-
- newMap1 domain controlPoints = do
- let stride = numComponents (head controlPoints)
- order = genericLength controlPoints
- descriptor = MapDescriptor domain stride order (fromIntegral stride)
- withNewMap1 descriptor $ \ptr ->
- pokeControlPoints1 descriptor ptr controlPoints
-
- getMap1Components m =
- withMap1 m $ \descriptor@(MapDescriptor domain _ _ _) ptr -> do
- controlPoints <- peekControlPoints1 descriptor ptr
- return (domain, controlPoints)
-
---------------------------------------------------------------------------------
-
-data 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Exception.hs b/Graphics/Rendering/OpenGL/GL/Exception.hs
--- a/Graphics/Rendering/OpenGL/GL/Exception.hs
+++ b/Graphics/Rendering/OpenGL/GL/Exception.hs
@@ -1,55 +1,55 @@
-{-# LANGUAGE CPP #-}
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Exception
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module to compensate for differences between
--- Haskell implementations.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Exception (
- bracket, bracket_, unsafeBracket_, finallyRet
-) where
-
-import Data.IORef ( newIORef, readIORef, writeIORef )
-
-#ifdef __NHC__
-import qualified IO ( bracket, bracket_ )
-
-{-# INLINE bracket #-}
-bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
-bracket = IO.bracket
-
-{-# INLINE bracket_ #-}
-bracket_ :: IO a -> IO b -> IO c -> IO c
-bracket_ before = IO.bracket_ before . const
-
-finally :: IO a -> IO b -> IO a
-finally = flip . bracket_ . return $ undefined
-#else
-import Control.Exception ( bracket, bracket_, finally )
-#endif
-
-{-# INLINE unsafeBracket_ #-}
-unsafeBracket_ :: IO a -> IO b -> IO c -> IO c
-unsafeBracket_ before after thing = do
- _ <- before
- r <- thing
- _ <- after
- return r
-
-{-# INLINE finallyRet #-}
-finallyRet :: IO a -> IO b -> IO (a, b)
-a `finallyRet` sequel = do
- r2Ref <- newIORef undefined
- r1 <- a `finally` (sequel >>= writeIORef r2Ref)
- r2 <- readIORef r2Ref
- return (r1, r2)
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Exception
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Face.hs b/Graphics/Rendering/OpenGL/GL/Face.hs
--- a/Graphics/Rendering/OpenGL/GL/Face.hs
+++ b/Graphics/Rendering/OpenGL/GL/Face.hs
@@ -1,41 +1,41 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Face
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling Face.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Face (
- Face(..), marshalFace, unmarshalFace
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data Face =
- Front
- | Back
- | FrontAndBack
- deriving ( Eq, Ord, Show )
-
-marshalFace :: Face -> GLenum
-marshalFace x = case x of
- Front -> gl_FRONT
- Back -> gl_BACK
- FrontAndBack -> gl_FRONT_AND_BACK
-
-unmarshalFace :: GLenum -> Face
-unmarshalFace x
- | x == gl_FRONT = Front
- | x == gl_BACK = Back
- | x == gl_FRONT_AND_BACK = FrontAndBack
- | otherwise = error ("unmarshalFace: illegal value " ++ show x)
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Face
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Feedback.hs b/Graphics/Rendering/OpenGL/GL/Feedback.hs
--- a/Graphics/Rendering/OpenGL/GL/Feedback.hs
+++ b/Graphics/Rendering/OpenGL/GL/Feedback.hs
@@ -1,201 +1,196 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Feedback
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 5.3 (Feedback) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Feedback (
- FeedbackToken(..), VertexInfo(..), ColorInfo, FeedbackType(..),
- getFeedbackTokens, PassThroughValue(..), passThrough
-) where
-
-import Control.Monad
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.IOState
-import Graphics.Rendering.OpenGL.GL.RenderMode
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glFeedbackBuffer, glPassThrough, gl_2D, gl_3D, gl_3D_COLOR,
- gl_3D_COLOR_TEXTURE, gl_4D_COLOR_TEXTURE, gl_BITMAP_TOKEN,
- gl_COPY_PIXEL_TOKEN, gl_DRAW_PIXEL_TOKEN, gl_LINE_RESET_TOKEN, gl_LINE_TOKEN,
- gl_PASS_THROUGH_TOKEN, gl_POINT_TOKEN, gl_POLYGON_TOKEN )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data FeedbackToken =
- PointToken VertexInfo
- | LineToken VertexInfo VertexInfo
- | LineResetToken VertexInfo VertexInfo
- | PolygonToken [VertexInfo]
- | BitmapToken VertexInfo
- | DrawPixelToken VertexInfo
- | CopyPixelToken VertexInfo
- | PassThroughToken PassThroughValue
- deriving ( Eq, Ord, Show )
-
-data VertexInfo =
- Vertex2D (Vertex2 GLfloat)
- | Vertex3D (Vertex3 GLfloat)
- | Vertex3DColor (Vertex3 GLfloat) ColorInfo
- | Vertex3DColorTexture (Vertex3 GLfloat) ColorInfo (TexCoord4 GLfloat)
- | Vertex4DColorTexture (Vertex4 GLfloat) ColorInfo (TexCoord4 GLfloat)
- deriving ( Eq, Ord, Show )
-
-type ColorInfo = Either (Index1 GLint) (Color4 GLfloat)
-
---------------------------------------------------------------------------------
-
-data FeedbackTag =
- PointTag
- | LineTag
- | LineResetTag
- | PolygonTag
- | BitmapTag
- | DrawPixelTag
- | CopyPixelTag
- | PassThroughTag
-
-unmarshalFeedbackTag :: GLenum -> FeedbackTag
-unmarshalFeedbackTag x
- | x == gl_POINT_TOKEN = PointTag
- | x == gl_LINE_TOKEN = LineTag
- | x == gl_LINE_RESET_TOKEN = LineResetTag
- | x == gl_POLYGON_TOKEN = PolygonTag
- | x == gl_BITMAP_TOKEN = BitmapTag
- | x == gl_DRAW_PIXEL_TOKEN = DrawPixelTag
- | x == gl_COPY_PIXEL_TOKEN = CopyPixelTag
- | x == gl_PASS_THROUGH_TOKEN = PassThroughTag
- | otherwise = error ("unmarshalFeedbackTag: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-data FeedbackType =
- TwoD
- | ThreeD
- | ThreeDColor
- | ThreeDColorTexture
- | FourDColorTexture
- deriving ( Eq, Ord, Show )
-
-marshalFeedbackType :: FeedbackType -> GLenum
-marshalFeedbackType x = case x of
- TwoD -> gl_2D
- ThreeD -> gl_3D
- ThreeDColor -> gl_3D_COLOR
- ThreeDColorTexture -> gl_3D_COLOR_TEXTURE
- FourDColorTexture -> gl_4D_COLOR_TEXTURE
-
---------------------------------------------------------------------------------
-
-getFeedbackTokens ::
- GLsizei -> FeedbackType -> IO a -> IO (a, Maybe [FeedbackToken])
-getFeedbackTokens bufSize feedbackType action =
- allocaArray (fromIntegral bufSize) $ \buf -> do
- glFeedbackBuffer bufSize (marshalFeedbackType feedbackType) buf
- (value, numValues) <- withRenderMode Feedback action
- tokens <- parseFeedbackBuffer numValues buf feedbackType
- return (value, tokens)
-
---------------------------------------------------------------------------------
-
-parseFeedbackBuffer ::
- GLint -> Ptr GLfloat -> FeedbackType -> IO (Maybe [FeedbackToken])
-parseFeedbackBuffer numValues buf feedbackType
- | numValues < 0 = return Nothing
- | otherwise = do
- rgba <- get rgbaMode
- let end = buf `plusPtr`
- (sizeOf (undefined :: GLfloat) * fromIntegral numValues)
- infoParser = calcInfoParser feedbackType (calcColorParser rgba)
- loop tokens = do
- ptr <- getIOState
- if ptr == end
- then return (reverse tokens)
- else do token <- tokenParser infoParser
- loop (token : tokens)
- fmap Just $ evalIOState (loop []) buf
-
-type Parser a = IOState GLfloat a
-
-tokenParser :: Parser VertexInfo -> Parser FeedbackToken
-tokenParser infoParser = do
- tag <- parseGLenum
- case unmarshalFeedbackTag tag of
- PointTag -> fmap PointToken infoParser
- LineTag -> liftM2 LineToken infoParser infoParser
- LineResetTag -> liftM2 LineResetToken infoParser infoParser
- PolygonTag -> do n <- parseGLint; fmap PolygonToken (nTimes n infoParser)
- BitmapTag -> fmap BitmapToken infoParser
- DrawPixelTag -> fmap DrawPixelToken infoParser
- CopyPixelTag -> fmap CopyPixelToken infoParser
- PassThroughTag -> fmap PassThroughToken parsePassThroughValue
-
-calcInfoParser :: FeedbackType -> Parser ColorInfo -> Parser VertexInfo
-calcInfoParser feedbackType colorParser = case feedbackType of
- TwoD ->
- fmap Vertex2D parseVertex2
- ThreeD ->
- fmap Vertex3D parseVertex3
- ThreeDColor ->
- liftM2 Vertex3DColor parseVertex3 colorParser
- ThreeDColorTexture ->
- liftM3 Vertex3DColorTexture parseVertex3 colorParser parseTexCoord4
- FourDColorTexture ->
- liftM3 Vertex4DColorTexture parseVertex4 colorParser parseTexCoord4
-
-parseVertex2 :: Parser (Vertex2 GLfloat)
-parseVertex2 = liftM2 Vertex2 parseGLfloat parseGLfloat
-
-parseVertex3 :: Parser (Vertex3 GLfloat)
-parseVertex3 = liftM3 Vertex3 parseGLfloat parseGLfloat parseGLfloat
-
-parseVertex4 :: Parser (Vertex4 GLfloat)
-parseVertex4 =
- liftM4 Vertex4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat
-
-calcColorParser :: Bool -> Parser ColorInfo
-calcColorParser False = fmap Left parseIndex1
-calcColorParser True = fmap Right parseColor4
-
-parseIndex1 :: Parser (Index1 GLint)
-parseIndex1 = fmap Index1 parseGLint
-
-parseColor4 :: Parser (Color4 GLfloat)
-parseColor4 = liftM4 Color4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat
-
-parseTexCoord4 :: Parser (TexCoord4 GLfloat)
-parseTexCoord4 =
- liftM4 TexCoord4 parseGLfloat parseGLfloat parseGLfloat parseGLfloat
-
-parsePassThroughValue :: Parser PassThroughValue
-parsePassThroughValue = fmap PassThroughValue parseGLfloat
-
-parseGLenum :: Parser GLenum
-parseGLenum = fmap round parseGLfloat
-
-parseGLint :: Parser GLint
-parseGLint = fmap round parseGLfloat
-
-parseGLfloat :: Parser GLfloat
-parseGLfloat = peekIOState
-
---------------------------------------------------------------------------------
-
-newtype PassThroughValue = PassThroughValue GLfloat
- deriving ( Eq, Ord, Show )
-
-passThrough :: PassThroughValue -> IO ()
-passThrough (PassThroughValue ptv) = glPassThrough ptv
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Feedback
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FlushFinish.hs b/Graphics/Rendering/OpenGL/GL/FlushFinish.hs
--- a/Graphics/Rendering/OpenGL/GL/FlushFinish.hs
+++ b/Graphics/Rendering/OpenGL/GL/FlushFinish.hs
@@ -1,50 +1,50 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.FlushFinish
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 5.5 (Flush and Finish) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.FlushFinish (
- flush, finish
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | Different GL implementations buffer commands in several different
--- locations, including network buffers and the graphics accelerator itself.
--- 'flush' empties all of these buffers, causing all issued commands to be
--- executed as quickly as they are accepted by the actual rendering engine.
--- Though this execution may not be completed in any particular time period, it
--- does complete in finite time.
---
--- Because any GL program might be executed over a network, or on an accelerator
--- that buffers commands, all programs should call 'flush' whenever they count
--- on having all of their previously issued commands completed. For example,
--- call 'flush' before waiting for user input that depends on the generated
--- image.
---
--- Note that 'flush' can return at any time. It does not wait until the
--- execution of all previously issued GL commands is complete.
-
-flush :: IO ()
-flush = glFlush
-
--- | 'finish' does not return until the effects of all previously called GL
--- commands are complete. Such effects include all changes to GL state, all
--- changes to connection state, and all changes to the frame buffer contents.
---
--- Note that 'finish' requires a round trip to the server.
-
-finish :: IO ()
-finish = glFinish
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FlushFinish
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Fog.hs b/Graphics/Rendering/OpenGL/GL/Fog.hs
--- a/Graphics/Rendering/OpenGL/GL/Fog.hs
+++ b/Graphics/Rendering/OpenGL/GL/Fog.hs
@@ -1,207 +1,203 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Fog
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.10 (Fog) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Fog (
- fog,
- FogMode(..), fogMode,
- fogColor, fogIndex,
- FogCoordSrc(..), fogCoordSrc,
- FogDistanceMode(..), fogDistanceMode
-) where
-
-import Foreign.Marshal.Utils
-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.ARB.Compatibility (
- glFogf, glFogfv, glFogi, gl_EXP, gl_EXP2, gl_EYE_PLANE, gl_FOG_COLOR,
- gl_FOG_COORD, gl_FOG_COORD_SRC, gl_FOG_DENSITY, gl_FOG_END, gl_FOG_INDEX,
- gl_FOG_MODE, gl_FOG_START, gl_FRAGMENT_DEPTH )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-fog :: StateVar Capability
-fog = makeCapability CapFog
-
---------------------------------------------------------------------------------
-
-data FogParameter =
- FogIndex
- | FogDensity
- | FogStart
- | FogEnd
- | FogMode
- | FogColor
- | FogCoordSrc
- | FogDistanceMode
-
-marshalFogParameter :: FogParameter -> GLenum
-marshalFogParameter x = case x of
- FogIndex -> gl_FOG_INDEX
- FogDensity -> gl_FOG_DENSITY
- FogStart -> gl_FOG_START
- FogEnd -> gl_FOG_END
- FogMode -> gl_FOG_MODE
- FogColor -> gl_FOG_COLOR
- FogCoordSrc -> gl_FOG_COORD_SRC
- -- TODO: Use FOG_DISTANCE_MODE_NV from NV_fog_distance extension
- FogDistanceMode -> 0x855a
-
---------------------------------------------------------------------------------
-
-data FogMode' =
- Linear'
- | Exp'
- | Exp2'
-
-marshalFogMode' :: FogMode' -> GLint
-marshalFogMode' x = fromIntegral $ case x of
- Linear' -> gl_LINEAR
- Exp' -> gl_EXP
- Exp2' -> gl_EXP2
-
-unmarshalFogMode' :: GLint -> FogMode'
-unmarshalFogMode' x
- | y == gl_LINEAR = Linear'
- | y == gl_EXP = Exp'
- | y == gl_EXP2 = Exp2'
- | otherwise = error ("unmarshalFogMode': illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-data FogMode =
- Linear GLfloat GLfloat
- | Exp GLfloat
- | Exp2 GLfloat
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-fogMode :: StateVar FogMode
-fogMode = makeStateVar getFogMode setFogMode
-
-getFogMode :: IO FogMode
-getFogMode = do
- mode <- getInteger1 unmarshalFogMode' GetFogMode
- case mode of
- Linear' -> do
- start <- getFloat1 id GetFogStart
- end <- getFloat1 id GetFogEnd
- return $ Linear start end
- Exp' -> getFloat1 Exp GetFogDensity
- Exp2' -> getFloat1 Exp2 GetFogDensity
-
-setFogMode :: FogMode -> IO ()
-setFogMode (Linear start end) = do
- fogi FogMode (marshalFogMode' Linear')
- fogf FogStart start
- fogf FogEnd end
-setFogMode (Exp density) = do
- fogi FogMode (marshalFogMode' Exp')
- fogf FogDensity density
-setFogMode (Exp2 density) = do
- fogi FogMode (marshalFogMode' Exp2')
- fogf FogDensity density
-
---------------------------------------------------------------------------------
-
-fogi :: FogParameter -> GLint -> IO ()
-fogi = glFogi . marshalFogParameter
-
-fogf :: FogParameter -> GLfloat -> IO ()
-fogf = glFogf . marshalFogParameter
-
-fogfv :: FogParameter -> Ptr (Color4 GLfloat) -> IO ()
-fogfv param ptr = glFogfv (marshalFogParameter param) (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-fogColor :: StateVar (Color4 GLclampf)
-fogColor =
- makeStateVar
- (getClampf4 Color4 GetFogColor)
- (\c -> with c $ (fogfv FogColor . castPtr))
-
---------------------------------------------------------------------------------
-
-fogIndex :: StateVar (Index1 GLint)
-fogIndex =
- makeStateVar
- (getInteger1 Index1 GetFogIndex)
- (\(Index1 i) -> fogi FogIndex i)
-
---------------------------------------------------------------------------------
-
-data FogCoordSrc =
- FogCoord
- | FragmentDepth
- deriving ( Eq, Ord, Show )
-
-marshalFogCoordSrc :: FogCoordSrc -> GLint
-marshalFogCoordSrc x = fromIntegral $ case x of
- FogCoord -> gl_FOG_COORD
- FragmentDepth -> gl_FRAGMENT_DEPTH
-
-unmarshalFogCoordSrc :: GLint -> FogCoordSrc
-unmarshalFogCoordSrc x
- | y == gl_FOG_COORD = FogCoord
- | y == gl_FRAGMENT_DEPTH = FragmentDepth
- | otherwise = error ("unmarshalFogCoordSrc: illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-fogCoordSrc :: StateVar FogCoordSrc
-fogCoordSrc =
- makeStateVar
- (getInteger1 unmarshalFogCoordSrc GetFogCoordSrc)
- (fogi FogCoordSrc . marshalFogCoordSrc)
-
---------------------------------------------------------------------------------
-
-data FogDistanceMode =
- EyeRadial
- | EyePlaneSigned
- | EyePlaneAbsolute
- deriving ( Eq, Ord, Show )
-
-marshalFogDistanceMode :: FogDistanceMode -> GLint
-marshalFogDistanceMode x = fromIntegral $ case x of
- -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension
- EyeRadial -> 0x855b
- EyePlaneSigned ->gl_EYE_PLANE
- -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension
- EyePlaneAbsolute -> 0x855c
-
-unmarshalFogDistanceMode :: GLint -> FogDistanceMode
-unmarshalFogDistanceMode x
- -- TODO: Use EYE_RADIAL_NV from NV_fog_distance extension
- | y == 0x855b = EyeRadial
- | y == gl_EYE_PLANE = EyePlaneSigned
- -- TODO: Use EYE_PLANE_ABSOLUTE_NV from NV_fog_distance extension
- | y == 0x855c = EyePlaneAbsolute
- | otherwise = error ("unmarshalFogDistanceMode: illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-fogDistanceMode :: StateVar FogDistanceMode
-fogDistanceMode =
- makeStateVar
- (getInteger1 unmarshalFogDistanceMode GetFogDistanceMode)
- (fogi FogDistanceMode . marshalFogDistanceMode)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Fog
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Framebuffer.hs b/Graphics/Rendering/OpenGL/GL/Framebuffer.hs
--- a/Graphics/Rendering/OpenGL/GL/Framebuffer.hs
+++ b/Graphics/Rendering/OpenGL/GL/Framebuffer.hs
@@ -1,432 +1,429 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Framebuffer
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 4.2 (Whole Framebuffer Operations) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Framebuffer (
- -- * Querying the Buffer Configuration
- auxBuffers, doubleBuffer, stereoBuffer,
- rgbaBits, stencilBits, depthBits, accumBits, rgbaSignedComponents,
-
- -- * Selecting a Buffer for Writing
- 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.StateVar
-import Graphics.Rendering.OpenGL.GL.BufferMode
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.Face
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glAccum, glClearAccum, glClearIndex, glIndexMask, gl_ACCUM,
- gl_ACCUM_BUFFER_BIT, gl_ADD, gl_LOAD, gl_MULT, gl_RETURN )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | The implementation and context dependent number of auxiliary buffers.
-
-auxBuffers :: GettableStateVar GLsizei
-auxBuffers = makeGettableStateVar $ getSizei1 id GetAuxBuffers
-
--- | 'True' if front and back buffers exist.
-
-doubleBuffer :: GettableStateVar Bool
-doubleBuffer =
- makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetDoublebuffer
-
--- | 'True' if left and right buffers exist.
-
-stereoBuffer :: GettableStateVar Bool
-stereoBuffer =
- makeGettableStateVar $ getBoolean1 unmarshalGLboolean GetStereo
-
-rgbaBits :: GettableStateVar (Color4 GLsizei)
-rgbaBits =
- makeGettableStateVar $
- liftM4 Color4 (getSizei1 id GetRedBits)
- (getSizei1 id GetGreenBits)
- (getSizei1 id GetBlueBits)
- (getSizei1 id GetAlphaBits)
-
-stencilBits :: GettableStateVar GLsizei
-stencilBits = makeGettableStateVar $ getSizei1 id GetStencilBits
-
-depthBits :: GettableStateVar GLsizei
-depthBits = makeGettableStateVar $ getSizei1 id GetDepthBits
-
-accumBits :: GettableStateVar (Color4 GLsizei)
-accumBits =
- makeGettableStateVar $
- liftM4 Color4 (getSizei1 id GetAccumRedBits)
- (getSizei1 id GetAccumGreenBits)
- (getSizei1 id GetAccumBlueBits)
- (getSizei1 id GetAccumAlphaBits)
-
-rgbaSignedComponents :: GettableStateVar (Color4 Bool)
-rgbaSignedComponents =
- makeGettableStateVar $
- getInteger4 (\r g b a -> Color4 (unmarshalGLboolean r)
- (unmarshalGLboolean g)
- (unmarshalGLboolean b)
- (unmarshalGLboolean a))
- GetRGBASignedComponents
-
---------------------------------------------------------------------------------
-
--- | When colors are written to the framebuffer, they are written into the color
--- buffers specified by 'drawBuffer'.
---
--- If more than one color buffer is selected for drawing, then blending or
--- logical operations are computed and applied independently for each color
--- buffer and can produce different results in each buffer.
---
--- Monoscopic contexts include only left buffers, and stereoscopic contexts
--- include both left and right buffers. Likewise, single-buffered contexts
--- include only front buffers, and double-buffered contexts include both front
--- and back buffers. The context is selected at GL initialization.
---
--- The initial value is 'FrontBuffers' for single-buffered contexts, and
--- 'BackBuffers' for double-buffered contexts.
-
-drawBuffer :: StateVar BufferMode
-drawBuffer =
- makeStateVar
- (getEnum1 unmarshalBufferMode GetDrawBuffer)
- (maybe recordInvalidValue glDrawBuffer . marshalBufferMode)
-
---------------------------------------------------------------------------------
-
-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 = fromIntegral $ case x of
- ColorBuffer -> gl_COLOR_BUFFER_BIT
- AccumBuffer -> gl_ACCUM_BUFFER_BIT
- StencilBuffer -> gl_STENCIL_BUFFER_BIT
- DepthBuffer -> gl_DEPTH_BUFFER_BIT
-
---------------------------------------------------------------------------------
-
--- | Set the bitplane area of the window to values previously selected by
--- 'clearColor', 'clearIndex', 'clearDepth', 'clearStencil', and 'clearAccum'.
--- Multiple color buffers can be cleared simultaneously by selecting more than
--- one buffer at a time using 'drawBuffer'.
---
--- The pixel ownership test, the scissor test, dithering, and the buffer
--- writemasks affect the operation of 'clear'. The scissor box bounds the
--- cleared region. Alpha function, blend function, logical operation,
--- stenciling, texure mapping, and depth-buffering are ignored by 'clear'.
---
--- 'clear' takes a list of buffers, indicating which buffers are to be cleared.
--- If a buffer is not present, then a 'clear' directed at that buffer has no
--- effect.
---
--- The value to which each buffer is cleared depends on the setting of the clear
--- value for that buffer.
-
-clear :: [ClearBuffer] -> IO ()
-clear = glClear . sum . map marshalClearBuffer
-
---------------------------------------------------------------------------------
-
--- | Controls the red, green, blue, and alpha values used by 'clear' to clear
--- the color buffers. Values written into 'clearColor' are clamped to the range
--- [0, 1]. Initially, all values are 0.
-
-clearColor :: StateVar (Color4 GLclampf)
-clearColor = makeStateVar (getClampf4 Color4 GetColorClearValue)
- (\(Color4 r g b a) -> glClearColor r g b a)
-
---------------------------------------------------------------------------------
-
--- | Controls the index /c/ used by 'clear' to clear the color index buffers.
--- /c/ is not clamped. Rather, /c/ is converted to a fixed-point value with
--- unspecified precision to the right of the binary point. The integer part of
--- this value is then masked with 2^/m/-1, where /m/ is the number of bits in a
--- color index stored in the framebuffer. Initially, the value is 0.
-
-clearIndex :: StateVar (Index1 GLfloat)
-clearIndex = makeStateVar (getFloat1 Index1 GetIndexClearValue)
- (\(Index1 i) -> glClearIndex i)
-
---------------------------------------------------------------------------------
-
--- | Controls the depth value used by 'clear' to clear the depth buffer. Values
--- written into 'clearDepth' are clamped to the range [0, 1]. The initial value
--- is 1.
-
-clearDepth :: StateVar GLclampd
-clearDepth = makeStateVar (getClampd1 id GetDepthClearValue) glClearDepth
-
---------------------------------------------------------------------------------
-
--- | Controls the value /s/ used by 'clear' to clear the stencil buffer. /s/ is
--- masked with 2^/m/-1, where /m/ is the number of bits in the stencil buffer.
--- Initially, the value is 0.
-
-clearStencil :: StateVar GLint
-clearStencil = makeStateVar (getInteger1 id GetStencilClearValue) glClearStencil
-
---------------------------------------------------------------------------------
-
--- | Controls the red, green, blue, and alpha values used by 'clear' to clear
--- the accumulation buffer. Values written into 'clearAccum' are clamped to the
--- range [-1, 1]. The initial values are all 0.
-
-clearAccum :: StateVar (Color4 GLfloat)
-clearAccum =
- makeStateVar (getFloat4 Color4 GetAccumClearValue)
- (\(Color4 r g b a) -> glClearAccum r g b a)
-
---------------------------------------------------------------------------------
-
--- | An operation on the accumulation buffer.
-
-data AccumOp =
- Accum
- -- ^ Obtains /R/, /G/, /B/, and /A/ values from the buffer currently
- -- selected for reading (see
- -- 'Graphics.Rendering.OpenGL.GL.ReadCopyPixels.readBuffer'). Each
- -- component value is divided by 2^/n/-1, where /n/ is the number of bits
- -- allocated to each color component in the currently selected buffer. The
- -- result is a floating-point value in the range [0, 1], which is
- -- multiplied by the value given to 'accum' and added to the corresponding
- -- pixel component in the accumulation buffer, thereby updating the
- -- accumulation buffer.
- | Load
- -- ^ Similar to 'Accum', except that the current value in the accumulation
- -- buffer is not used in the calculation of the new value. That is, the
- -- /R/, /G/, /B/, and /A/ values from the currently selected buffer are
- -- divided by 2^/n/-1, multiplied by the value given to 'accum', and then
- -- stored in the corresponding accumulation buffer cell, overwriting the
- -- current value.
- | Return
- -- ^ Transfers accumulation buffer values to the color buffer or buffers
- -- currently selected for writing. Each /R/, /G/, /B/, and /A/ component
- -- is multiplied by the value given to 'accum', then multiplied by 2^/n/-1,
- -- clamped to the range [0, 2^/n/-1], and stored in the corresponding
- -- display buffer cell. The only fragment operations that are applied to
- -- this transfer are pixel ownership, scissor, dithering, and color
- -- writemasks.
- | Mult
- -- ^ Multiplies each /R/, /G/, /B/, and /A/ in the accumulation buffer by
- -- the value given to 'accum' and returns the scaled component to its
- -- corresponding accumulation buffer location.
- | Add
- -- ^ Adds the value given to 'accum' to each /R/, /G/, /B/, and /A/ in the
- -- accumulation buffer.
- deriving ( Eq, Ord, Show )
-
-marshalAccumOp :: AccumOp -> GLenum
-marshalAccumOp x = case x of
- Accum -> gl_ACCUM
- Load -> gl_LOAD
- Return -> gl_RETURN
- Mult -> gl_MULT
- Add -> gl_ADD
-
---------------------------------------------------------------------------------
-
--- | The accumulation buffer is an extended-range color buffer. Images are not
--- rendered into it. Rather, images rendered into one of the color buffers are
--- added to the contents of the accumulation buffer after rendering. Effects
--- such as antialiasing (of points, lines, and polygons), motion blur, and
--- depth of field can be created by accumulating images generated with different
--- transformation matrices.
---
--- Each pixel in the accumulation buffer consists of red, green, blue, and alpha
--- values. The number of bits per component in the accumulation buffer depends
--- on the implementation (see 'accumBits'). Regardless of the number of bits per
--- component, the range of values stored by each component is [-1, 1]. The
--- accumulation buffer pixels are mapped one-to-one with frame buffer pixels.
---
--- 'accum' operates on the accumulation buffer. The first argument selects an
--- accumulation buffer operation. The second argument, is a floating-point value
--- to be used in that operation, see 'AccumOp'.
---
--- All accumulation buffer operations are limited to the area of the current
--- scissor box and applied identically to the red, green, blue, and alpha
--- components of each pixel. If an 'accum' operation results in a value outside
--- the range [-1, 1], the contents of an accumulation buffer pixel component
--- are undefined.
---
--- To clear the accumulation buffer, use 'clearAccum' to specify the clear
--- value, then call 'clear' with the accumulation buffer enabled.
-
-accum :: AccumOp -> GLfloat -> IO ()
-accum = glAccum . marshalAccumOp
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Framebuffer
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs
--- a/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs
@@ -1,35 +1,25 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-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
- hiding (getFBAParameteriv)
--- import FramebufferObjects, hiding the constructor for FramebufferObject
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
- hiding ( FramebufferObject, marshalFramebufferTarget )
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
- (FramebufferObject)
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries
--- import RenderbufferObjects, hiding the constructor for RenderbufferObject
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects
- hiding ( RenderbufferObject, marshalRenderbufferTarget, getRBParameteriv )
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects
- (RenderbufferObject)
+-----------------------------------------------------------------------------
+-- |
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs
--- a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs
@@ -1,147 +1,67 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments (
- FramebufferObjectAttachment(..),
-
- fboaToBufferMode, fboaFromBufferMode,
-
- maxColorAttachments,
-
- FramebufferAttachment(..),
-
- framebufferRenderbuffer, framebufferTexture1D, framebufferTexture2D,
- framebufferTexture3D, framebufferTextureLayer,
-
- getFBAParameteriv,
-) where
-
-import Data.Maybe (fromMaybe)
-import Foreign.Marshal
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects
-
-import Graphics.Rendering.OpenGL.GL.BufferMode
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.Texturing.Objects
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
------------------------------------------------------------------------------
-
-data FramebufferObjectAttachment =
- ColorAttachment !GLuint
- | DepthAttachment
- | StencilAttachment
- | DepthStencilAttachment
- deriving (Eq, 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
-
-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
-
-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
-
------------------------------------------------------------------------------
-
-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
-
------------------------------------------------------------------------------
-
-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
- -> TextureObject -> Level -> IO ()
-framebufferTexture1D fbt fba (TextureObject t) l = maybe recordInvalidValue
- (\mfba -> glFramebufferTexture1D (marshalFramebufferTarget fbt) mfba
- (marshalTextureTarget Texture1D) t l) $ marshalFramebufferObjectAttachment fba
-
-framebufferTexture2D :: FramebufferTarget -> FramebufferObjectAttachment
- -> Maybe CubeMapTarget-> TextureObject -> Level -> IO ()
-framebufferTexture2D fbt fba mcmt (TextureObject t) l = maybe recordInvalidValue
- (\mfba -> glFramebufferTexture2D (marshalFramebufferTarget fbt) mfba
- (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mcmt) t l)
- $ marshalFramebufferObjectAttachment fba
-
-framebufferTexture3D :: FramebufferTarget -> FramebufferObjectAttachment
- -> TextureObject -> Level -> GLint -> IO ()
-framebufferTexture3D fbt fba (TextureObject t) le la = maybe recordInvalidValue
- (\mfba -> glFramebufferTexture3D (marshalFramebufferTarget fbt) mfba
- (marshalTextureTarget Texture1D) 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
-
-
------------------------------------------------------------------------------
-
-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)
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments
+-- Copyright : (c) Sven Panne, Lars Corbijn 2011-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObject.hs
@@ -0,0 +1,41 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObject
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjectAttachment.hs
@@ -0,0 +1,105 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjectAttachment
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs
--- a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs
@@ -1,111 +1,81 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects (
- FramebufferObject(FramebufferObject),
- defaultFramebufferObject,
- FramebufferTarget(..), marshalFramebufferTarget,
-
- bindFramebuffer,
-
- FramebufferStatus(..), framebufferStatus,
-) where
-
-import Foreign.Marshal
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-
-
------------------------------------------------------------------------------
-
-data FramebufferObject = FramebufferObject{ fbufferID :: GLuint }
-
-instance ObjectName FramebufferObject where
- genObjectNames n =
- allocaArray n $ \buf -> do
- glGenFramebuffers (fromIntegral n) buf
- fmap (map FramebufferObject) $ peekArray n buf
- deleteObjectNames objs = withArrayLen (map fbufferID objs) $
- glDeleteFramebuffers . fromIntegral
- isObjectName = fmap unmarshalGLboolean . glIsFramebuffer . fbufferID
-
-defaultFramebufferObject :: FramebufferObject
-defaultFramebufferObject = FramebufferObject 0
-
------------------------------------------------------------------------------
-
-data FramebufferTarget =
- DrawFramebuffer
- | ReadFramebuffer
- | Framebuffer
-
-marshalFramebufferTarget :: FramebufferTarget -> GLenum
-marshalFramebufferTarget xs = case xs of
- DrawFramebuffer -> gl_DRAW_FRAMEBUFFER
- ReadFramebuffer -> gl_READ_FRAMEBUFFER
- Framebuffer -> gl_FRAMEBUFFER
-
-marshalFramebufferTargetBinding :: FramebufferTarget -> PName1I
-marshalFramebufferTargetBinding x = case x of
- DrawFramebuffer -> GetDrawFramebufferBinding
- ReadFramebuffer -> GetReadFramebufferBinding
- Framebuffer -> GetFramebufferBinding
-
------------------------------------------------------------------------------
-
-bindFramebuffer :: FramebufferTarget -> StateVar FramebufferObject
-bindFramebuffer fbt =
- makeStateVar (getBoundFramebuffer fbt) (setFramebuffer fbt)
-
-getBoundFramebuffer :: FramebufferTarget -> IO FramebufferObject
-getBoundFramebuffer = getInteger1 (FramebufferObject . fromIntegral)
- . marshalFramebufferTargetBinding
-
-setFramebuffer :: FramebufferTarget -> FramebufferObject -> IO ()
-setFramebuffer fbt = glBindFramebuffer (marshalFramebufferTarget fbt) . fbufferID
-
------------------------------------------------------------------------------
-
-data FramebufferStatus =
- Complete
- | Undefined
- | IncompleteMissingAttachment
- | IncompleteDrawBuffer
- | IncompleteReadBuffer
- | IncompleteMultiSample
- | Unsupported
-
-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
+-- 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
+
+-----------------------------------------------------------------------------
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferTarget.hs
@@ -0,0 +1,34 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferTarget
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs
--- a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs
@@ -1,235 +1,232 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries (
- AttachmentObjectType(..), attachmentObjectType, attachmentObject,
- attachmentTextureLayer, attachmentTextureLevel,
- attachmentTextureCubeMapTarget,
-
- attachmentRedSize, attachmentBlueSize, attachmentGreenSize,
- attachmentAlphaSize, attachmentDepthSize, attachmentStencilSize,
-
- renderbufferWidth, renderbufferHeight,
- renderbufferInternalFormat, renderbufferSamples,
-
- renderbufferRedSize, renderbufferBlueSize, renderbufferGreenSize,
- renderbufferAlphaSize, renderbufferDepthSize, renderbufferStencilSize,
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Texturing.Objects(TextureObject(..))
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification(Level)
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments
-
-
------------------------------------------------------------------------------
-
-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
-
-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
-
-attachmentTextureCubeMapTarget :: FramebufferAttachment fba => FramebufferTarget -> fba
- -> GettableStateVar CubeMapTarget
-attachmentTextureCubeMapTarget fbt fba = makeGettableStateVar $
- getFBAPName fbt fba (unmarshalCubeMapTarget . 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObject.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObject.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObject.hs
@@ -0,0 +1,40 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObject
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs
--- a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs
@@ -1,107 +1,73 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.RendebufferObjects
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects (
- RenderbufferObject(RenderbufferObject),
- noRenderbufferObject,
- RenderbufferTarget(..), marshalRenderbufferTarget,
- RenderbufferSize(..), Samples(..),
-
- bindRenderbuffer,
-
- renderbufferStorage, renderbufferStorageMultiSample,
-
- getRBParameteriv,
-) where
-
-import Foreign.Marshal
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-
------------------------------------------------------------------------------
-
-data RenderbufferObject = RenderbufferObject{ rbufferID :: GLuint}
-
-instance ObjectName RenderbufferObject where
- genObjectNames n =
- allocaArray n $ \buf -> do
- glGenRenderbuffers (fromIntegral n) buf
- fmap (map RenderbufferObject) $ peekArray n buf
- deleteObjectNames objs = withArrayLen (map rbufferID objs) $
- glDeleteRenderbuffers . fromIntegral
- isObjectName = fmap unmarshalGLboolean . glIsRenderbuffer . rbufferID
-
-noRenderbufferObject :: RenderbufferObject
-noRenderbufferObject = RenderbufferObject 0
-
------------------------------------------------------------------------------
-
-data RenderbufferTarget =
- Renderbuffer
-
-marshalRenderbufferTarget :: RenderbufferTarget -> GLenum
-marshalRenderbufferTarget x = case x of
- Renderbuffer -> gl_RENDERBUFFER
-
-marshalRenderbufferTargetBinding :: RenderbufferTarget -> PName1I
-marshalRenderbufferTargetBinding x = case x of
- Renderbuffer -> GetRenderbufferBinding
------------------------------------------------------------------------------
-
-data RenderbufferSize = RenderbufferSize !GLsizei !GLsizei
-
-newtype Samples = Samples GLsizei
-
------------------------------------------------------------------------------
-
-bindRenderbuffer :: RenderbufferTarget -> StateVar RenderbufferObject
-bindRenderbuffer rbt =
- makeStateVar (getBoundRenderbuffer rbt) (setRenderbuffer rbt)
-
-getBoundRenderbuffer :: RenderbufferTarget -> IO RenderbufferObject
-getBoundRenderbuffer = getInteger1 (RenderbufferObject . fromIntegral)
- . marshalRenderbufferTargetBinding
-
-setRenderbuffer :: RenderbufferTarget -> RenderbufferObject -> IO ()
-setRenderbuffer rbt = glBindRenderbuffer (marshalRenderbufferTarget rbt)
- . rbufferID
-
------------------------------------------------------------------------------
-
-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
-
------------------------------------------------------------------------------
-
-getRBParameteriv :: RenderbufferTarget -> (GLint -> a) -> GLenum -> IO a
-getRBParameteriv rbt f p = alloca $ \buf -> do
- glGetRenderbufferParameteriv (marshalRenderbufferTarget rbt)
- p buf
- peek1 f buf
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.RendebufferObjects
+-- Copyright : (c) Sven Panne, Lars Corbijn 2011-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferTarget.hs b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferTarget.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferTarget.hs
@@ -0,0 +1,43 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferTarget
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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 )
diff --git a/Graphics/Rendering/OpenGL/GL/GLboolean.hs b/Graphics/Rendering/OpenGL/GL/GLboolean.hs
--- a/Graphics/Rendering/OpenGL/GL/GLboolean.hs
+++ b/Graphics/Rendering/OpenGL/GL/GLboolean.hs
@@ -1,30 +1,30 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.GLboolean
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling GLboolean.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.GLboolean (
- marshalGLboolean, unmarshalGLboolean
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-marshalGLboolean :: Num a => Bool -> a
-marshalGLboolean x = fromIntegral $ case x of
- False -> gl_FALSE
- True -> gl_TRUE
-
-unmarshalGLboolean :: (Eq a, Num a) => a -> Bool
-unmarshalGLboolean = (/= fromIntegral gl_FALSE)
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.GLboolean
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/GLstring.hs b/Graphics/Rendering/OpenGL/GL/GLstring.hs
deleted file mode 100644
--- a/Graphics/Rendering/OpenGL/GL/GLstring.hs
+++ /dev/null
@@ -1,51 +0,0 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.GLstring
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.GLstring (
- peekGLstringLen, withGLStringLen, withGLString,
- stringQuery
-) where
-
-import Foreign.C.String
-import Foreign.Marshal.Array
-import Foreign.Ptr
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-
------------------------------------------------------------------------------
-
-type GLStringLen = (Ptr GLchar, GLsizei)
-
-peekGLstringLen :: GLStringLen -> IO String
-peekGLstringLen (p,l) = peekCAStringLen (castPtr p, fromIntegral l)
-
-withGLStringLen :: String -> (GLStringLen -> IO a) -> IO a
-withGLStringLen s act =
- withCAStringLen s $ \(p,len) ->
- act (castPtr p, fromIntegral len)
-
-withGLString :: String -> (Ptr GLchar -> IO a) -> IO a
-withGLString s act = withCAString s $ act . castPtr
-
-stringQuery :: GettableStateVar GLsizei -> (GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()) -> GettableStateVar String
-stringQuery lengthVar getStr =
- makeGettableStateVar $ do
- len <- get lengthVar -- Note: This includes the NUL character!
- if len == 0
- then return ""
- else allocaArray (fromIntegral len) $ \buf -> do
- getStr len nullPtr buf
- peekGLstringLen (buf, len-1)
diff --git a/Graphics/Rendering/OpenGL/GL/Hints.hs b/Graphics/Rendering/OpenGL/GL/Hints.hs
--- a/Graphics/Rendering/OpenGL/GL/Hints.hs
+++ b/Graphics/Rendering/OpenGL/GL/Hints.hs
@@ -1,93 +1,88 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Hints
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 5.6 (Hints) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Hints (
- HintTarget(..), HintMode(..), hint
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_FOG_HINT, gl_GENERATE_MIPMAP_HINT, gl_PERSPECTIVE_CORRECTION_HINT,
- gl_POINT_SMOOTH_HINT )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka (
- gl_PACK_CMYK_HINT, gl_UNPACK_CMYK_HINT )
-
---------------------------------------------------------------------------------
-
-data HintTarget =
- PerspectiveCorrection
- | PointSmooth
- | LineSmooth
- | PolygonSmooth
- | Fog
- | GenerateMipmap
- | TextureCompression
- | PackCMYK
- | UnpackCMYK
- deriving ( Eq, Ord, Show )
-
-marshalHintTarget :: HintTarget -> GLenum
-marshalHintTarget x = case x of
- PerspectiveCorrection -> gl_PERSPECTIVE_CORRECTION_HINT
- PointSmooth -> gl_POINT_SMOOTH_HINT
- LineSmooth -> gl_LINE_SMOOTH_HINT
- PolygonSmooth -> gl_POLYGON_SMOOTH_HINT
- Fog -> gl_FOG_HINT
- GenerateMipmap -> gl_GENERATE_MIPMAP_HINT
- TextureCompression -> gl_TEXTURE_COMPRESSION_HINT
- PackCMYK -> gl_PACK_CMYK_HINT
- UnpackCMYK -> gl_UNPACK_CMYK_HINT
-
-hintTargetToGetPName :: HintTarget -> 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
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/IOState.hs b/Graphics/Rendering/OpenGL/GL/IOState.hs
--- a/Graphics/Rendering/OpenGL/GL/IOState.hs
+++ b/Graphics/Rendering/OpenGL/GL/IOState.hs
@@ -1,58 +1,57 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.IOState
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for an IO monad with a pointer as an
--- additional state, basically a /StateT (Ptr s) IO a/.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.IOState (
- IOState(..), getIOState, peekIOState, evalIOState, nTimes
-) where
-
-import 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
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/LineSegments.hs b/Graphics/Rendering/OpenGL/GL/LineSegments.hs
--- a/Graphics/Rendering/OpenGL/GL/LineSegments.hs
+++ b/Graphics/Rendering/OpenGL/GL/LineSegments.hs
@@ -1,151 +1,150 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.LineSegments
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.4 (Line Segments) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.LineSegments (
- -- * Line Rasterization
- lineWidth,
-
- -- * Line Stipple
- lineStipple,
-
- -- * Line Antialiasing
- lineSmooth,
-
- -- * Implementation-Dependent Limits
- aliasedLineWidthRange, smoothLineWidthRange, smoothLineWidthGranularity
-) where
-
-import Control.Monad
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glLineStipple )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | 'lineWidth' contains the rasterized width of both aliased and antialiased
--- lines. The initial value is 1. Using a line width other than 1 has different
--- effects, depending on whether line antialiasing is enabled (see
--- 'lineSmooth'). Line antialiasing is initially disabled.
---
--- If line antialiasing is disabled, the actual width is determined by rounding
--- the supplied width to the nearest integer. (If the rounding results in the
--- value 0, it is as if the line width were 1.) If /delta x/ >= /delta y/, /i/
--- pixels are filled in each column that is rasterized, where /i/ is the
--- rounded value of 'lineWidth'. Otherwise, /i/ pixels are filled in each row
--- that is rasterized.
---
--- If antialiasing is enabled, line rasterization produces a fragment for each
--- pixel square that intersects the region lying within the rectangle having
--- width equal to the current line width, length equal to the actual length of
--- the line, and centered on the mathematical line segment. The coverage value
--- for each fragment is the window coordinate area of the intersection of the
--- rectangular region with the corresponding pixel square. This value is saved
--- and used in the final rasterization step.
---
--- Not all widths can be supported when line antialiasing is enabled. If an
--- unsupported width is requested, the nearest supported width is used. Only
--- width 1 is guaranteed to be supported; others depend on the implementation.
--- Likewise, there is a range for aliased line widths as well. To query the
--- range of supported widths of antialiased lines and the size difference
--- between supported widths within the range, query 'smoothLineWidthRange' and
--- 'smoothLineWidthGranularity', respectively. For aliased lines, query the
--- supported range with 'aliasedLineWidthRange'.
---
--- The line width specified when 'lineWidth' is set is always returned when it
--- is queried. Clamping and rounding for aliased and antialiased lines have no
--- effect on the specified value.
---
--- A non-antialiased line width may be clamped to an implementation-dependent
--- maximum. Query 'aliasedLineWidthRange' to determine the maximum width.
---
--- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if
--- 'lineWidth' is set to a value less than or equal to zero.
---
--- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if
--- 'lineWidth' is set during
--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.
-
-lineWidth :: StateVar GLfloat
-lineWidth = makeStateVar (getFloat1 id GetLineWidth) glLineWidth
-
---------------------------------------------------------------------------------
-
--- | Line stippling masks out certain fragments produced by rasterization; those
--- fragments will not be drawn. The masking is achieved by using three
--- parameters: the repeat count (1st element of the 'lineStipple' pair, clamped
--- to the range [ 1 .. 256 ]), the 16-bit line stipple pattern (2nd element),
--- and an integer stipple counter /s/.
---
--- The counter /s/ is reset to 0 at before the first action during
--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is called and before
--- each line segment during
--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' is generated. It is
--- incremented after each fragment of a unit width aliased line segment is
--- generated or after each /i/ fragments of an /i/ width line segment are
--- generated. The /i/ fragments associated with count /s/ are masked out if
--- @'Data.Bits.testBit' /pattern/ (( /s/ \/ /factor/ ) /mod/ 16)@ is 'False',
--- otherwise these fragments are sent to the frame buffer. Bit zero of the
--- pattern is the least significant bit, i.e. it is used first.
---
--- Antialiased lines are treated as a sequence of rectangles of height 1 for
--- purposes of stippling. Whether rectangle /s/ is rasterized or not depends on
--- the fragment rule described for aliased lines, counting rectangles rather
--- than groups of fragments.
---
--- The initial value of 'lineStipple' is 'Nothing', i.e. line stippling is
--- disabled.
---
--- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if
--- 'lineStipple' is set during
--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.
-
-lineStipple :: StateVar (Maybe (GLint, GLushort))
-lineStipple =
- makeStateVarMaybe
- (return CapLineStipple)
- (liftM2 (,) (getInteger1 id GetLineStippleRepeat)
- (getInteger1 fromIntegral GetLineStipplePattern))
- (uncurry glLineStipple)
-
---------------------------------------------------------------------------------
-
--- | Controls whether line antialiasing is enabled. The initial state is
--- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.
-
-lineSmooth :: StateVar Capability
-lineSmooth = makeCapability CapLineSmooth
-
---------------------------------------------------------------------------------
-
--- | The smallest and largest supported width of aliased lines.
-
-aliasedLineWidthRange :: GettableStateVar (GLfloat, GLfloat)
-aliasedLineWidthRange =
- makeGettableStateVar $ getFloat2 (,) GetAliasedLineWidthRange
-
--- | The smallest and largest supported width of antialiased lines.
-
-smoothLineWidthRange :: GettableStateVar (GLfloat, GLfloat)
-smoothLineWidthRange =
- makeGettableStateVar $ getFloat2 (,) GetSmoothLineWidthRange
-
--- | The antialiased line width granularity, i.e. the size difference between
--- supported widths.
-
-smoothLineWidthGranularity :: GettableStateVar GLfloat
-smoothLineWidthGranularity =
- makeGettableStateVar $ getFloat1 id GetSmoothLineWidthGranularity
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.LineSegments
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/ObjectName.hs b/Graphics/Rendering/OpenGL/GL/ObjectName.hs
--- a/Graphics/Rendering/OpenGL/GL/ObjectName.hs
+++ b/Graphics/Rendering/OpenGL/GL/ObjectName.hs
@@ -1,31 +1,61 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.ObjectName
--- Copyright : (c) Sven Panne 2009
--- License : BSD-style (see the file LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- 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(..) ) where
-
--- | 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.
-
-class ObjectName a where
- -- | Generate a given number of object names, which are guaranteed to be
- -- unused. By generating the names, they become used.
- genObjectNames :: Int -> IO [a]
-
- -- | Make the given object names available again, declaring them as unused.
- deleteObjectNames:: [a] -> IO ()
-
- -- | 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
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.ObjectName
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PeekPoke.hs b/Graphics/Rendering/OpenGL/GL/PeekPoke.hs
--- a/Graphics/Rendering/OpenGL/GL/PeekPoke.hs
+++ b/Graphics/Rendering/OpenGL/GL/PeekPoke.hs
@@ -1,107 +1,107 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PeekPoke
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module with peek- and poke-related utilities.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PeekPoke (
- poke1, poke2, poke3, poke4,
- peek1, peek2, peek3, peek4,
- peek1M, peek2M, peek3M, peek4M
-) where
-
-import Foreign.Ptr
-import Foreign.Storable
-
---------------------------------------------------------------------------------
--- The implementation is little bit verbose/redundant, but seems to generate
--- better code than mapM/zipWithM_.
-
---------------------------------------------------------------------------------
-
-{-# INLINE poke1 #-}
-poke1 :: Storable a => Ptr a -> a -> IO ()
-poke1 ptr x =
- pokeElemOff ptr 0 x
-
-{-# INLINE poke2 #-}
-poke2 :: Storable a => Ptr a -> a -> a -> IO ()
-poke2 ptr x y = do
- pokeElemOff ptr 0 x
- pokeElemOff ptr 1 y
-
-{-# INLINE poke3 #-}
-poke3 :: Storable a => Ptr a -> a -> a -> a -> IO ()
-poke3 ptr x y z = do
- pokeElemOff ptr 0 x
- pokeElemOff ptr 1 y
- pokeElemOff ptr 2 z
-
-{-# INLINE poke4 #-}
-poke4 :: Storable a => Ptr a -> a -> a -> a -> a -> IO ()
-poke4 ptr x y z w = do
- pokeElemOff ptr 0 x
- pokeElemOff ptr 1 y
- pokeElemOff ptr 2 z
- pokeElemOff ptr 3 w
-
---------------------------------------------------------------------------------
-
-{-# INLINE peek1 #-}
-peek1 :: Storable a => (a -> b) -> Ptr a -> IO b
-peek1 f ptr = do
- x <- peekElemOff ptr 0
- return $ f x
-
-{-# INLINE peek2 #-}
-peek2 :: Storable a => (a -> a -> b) -> Ptr a -> IO b
-peek2 f = peek2M $ \x y -> return (f x y)
-
-{-# INLINE peek3 #-}
-peek3 :: Storable a => (a -> a -> a -> b) -> Ptr a -> IO b
-peek3 f = peek3M $ \x y z -> return (f x y z)
-
-{-# INLINE peek4 #-}
-peek4 :: Storable a => (a -> a -> a -> a -> b) -> Ptr a -> IO b
-peek4 f = peek4M $ \x y z w -> return (f x y z w)
-
---------------------------------------------------------------------------------
-
-{-# INLINE peek1M #-}
-peek1M :: Storable a => (a -> IO b) -> Ptr a -> IO b
-peek1M f ptr = do
- x <- peekElemOff ptr 0
- f x
-
-{-# INLINE peek2M #-}
-peek2M :: Storable a => (a -> a -> IO b) -> Ptr a -> IO b
-peek2M f ptr = do
- x <- peekElemOff ptr 0
- y <- peekElemOff ptr 1
- f x y
-
-{-# INLINE peek3M #-}
-peek3M :: Storable a => (a -> a -> a -> IO b) -> Ptr a -> IO b
-peek3M f ptr = do
- x <- peekElemOff ptr 0
- y <- peekElemOff ptr 1
- z <- peekElemOff ptr 2
- f x y z
-
-{-# INLINE peek4M #-}
-peek4M :: Storable a => (a -> a -> a -> a -> IO b) -> Ptr a -> IO b
-peek4M f ptr = do
- x <- peekElemOff ptr 0
- y <- peekElemOff ptr 1
- z <- peekElemOff ptr 2
- w <- peekElemOff ptr 3
- f x y z w
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PeekPoke
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PerFragment.hs b/Graphics/Rendering/OpenGL/GL/PerFragment.hs
--- a/Graphics/Rendering/OpenGL/GL/PerFragment.hs
+++ b/Graphics/Rendering/OpenGL/GL/PerFragment.hs
@@ -1,369 +1,375 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PerFragment
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 4.1 (Per-Fragment Operations) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PerFragment (
- -- * Scissor Test
- scissor,
-
- -- * Multisample Fragment Operations
- sampleAlphaToCoverage, sampleAlphaToOne, sampleCoverage,
-
- -- * Depth Bounds Test
- depthBounds,
-
- -- * Alpha Test
- ComparisonFunction(..), alphaFunc,
-
- -- * Stencil Test
- stencilTest, stencilFunc, stencilFuncSeparate, StencilOp(..), stencilOp,
- stencilOpSeparate, activeStencilFace,
-
- -- * Depth Buffer Test
- depthFunc,
-
- -- * Blending
- blend, blendBuffer, BlendEquation(..), blendEquation, blendEquationSeparate,
- BlendingFactor(..), blendFuncSeparate, blendFunc, blendColor,
-
- -- * Dithering
- dither,
-
- -- * Logical Operation
- LogicOp(..), logicOp,
-
- -- * for backward compatibility reasons
- module Graphics.Rendering.OpenGL.GL.QueryObjects
-) where
-
-import Control.Monad
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.BlendingFactor
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.ComparisonFunction
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.Face
-import Graphics.Rendering.OpenGL.GL.Framebuffer
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryObjects
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glAlphaFunc, gl_INDEX_LOGIC_OP )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( glDepthBounds )
-import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( glActiveStencilFace )
-
---------------------------------------------------------------------------------
-
-scissor :: StateVar (Maybe (Position, Size))
-scissor =
- makeStateVarMaybe
- (return CapScissorTest)
- (getInteger4 makeSB GetScissorBox)
- (\(Position x y, Size w h) -> glScissor x y w h)
- where makeSB x y w h = (Position x y, Size (fromIntegral w) (fromIntegral h))
-
---------------------------------------------------------------------------------
-
-sampleAlphaToCoverage :: StateVar Capability
-sampleAlphaToCoverage = makeCapability CapSampleAlphaToCoverage
-
-sampleAlphaToOne :: StateVar Capability
-sampleAlphaToOne = makeCapability CapSampleAlphaToOne
-
-sampleCoverage :: StateVar (Maybe (GLclampf, Bool))
-sampleCoverage =
- makeStateVarMaybe
- (return CapSampleCoverage)
- (liftM2 (,) (getClampf1 id GetSampleCoverageValue)
- (getBoolean1 unmarshalGLboolean GetSampleCoverageInvert))
- (\(value, invert) -> glSampleCoverage value (marshalGLboolean invert))
-
---------------------------------------------------------------------------------
-
-depthBounds :: StateVar (Maybe (GLclampd, GLclampd))
-depthBounds =
- makeStateVarMaybe
- (return CapDepthBoundsTest)
- (getClampd2 (,) GetDepthBounds)
- (uncurry glDepthBounds)
-
---------------------------------------------------------------------------------
-
-alphaFunc :: StateVar (Maybe (ComparisonFunction, GLclampf))
-alphaFunc =
- makeStateVarMaybe
- (return CapAlphaTest)
- (liftM2 (,) (getEnum1 unmarshalComparisonFunction GetAlphaTestFunc)
- (getClampf1 id GetAlphaTestRef))
- (uncurry (glAlphaFunc . marshalComparisonFunction))
-
---------------------------------------------------------------------------------
-
-stencilTest :: StateVar Capability
-stencilTest = makeCapability CapStencilTest
-
---------------------------------------------------------------------------------
-
-stencilFunc :: StateVar (ComparisonFunction, GLint, GLuint)
-stencilFunc =
- makeStateVar
- (liftM3 (,,) (getEnum1 unmarshalComparisonFunction GetStencilFunc)
- (getInteger1 id GetStencilRef)
- (getInteger1 fromIntegral GetStencilValueMask))
- (\(func, ref, mask) ->
- glStencilFunc (marshalComparisonFunction func) ref mask)
-
-stencilFuncSeparate :: Face -> SettableStateVar (ComparisonFunction, GLint, GLuint)
-stencilFuncSeparate face =
- makeSettableStateVar $ \(func, ref, mask) ->
- glStencilFuncSeparate (marshalFace face) (marshalComparisonFunction func) ref mask
-
---------------------------------------------------------------------------------
-
-data StencilOp =
- OpZero
- | OpKeep
- | OpReplace
- | OpIncr
- | OpIncrWrap
- | OpDecr
- | OpDecrWrap
- | OpInvert
- deriving ( Eq, Ord, Show )
-
-marshalStencilOp :: StencilOp -> GLenum
-marshalStencilOp x = case x of
- OpZero -> gl_ZERO
- OpKeep -> gl_KEEP
- OpReplace -> gl_REPLACE
- OpIncr -> gl_INCR
- OpIncrWrap -> gl_INCR_WRAP
- OpDecr -> gl_DECR
- OpDecrWrap -> gl_DECR_WRAP
- OpInvert -> gl_INVERT
-
-unmarshalStencilOp :: GLenum -> StencilOp
-unmarshalStencilOp x
- | x == gl_ZERO = OpZero
- | x == gl_KEEP = OpKeep
- | x == gl_REPLACE = OpReplace
- | x == gl_INCR = OpIncr
- | x == gl_INCR_WRAP = OpIncrWrap
- | x == gl_DECR = OpDecr
- | x == gl_DECR_WRAP = OpDecrWrap
- | x == gl_INVERT = OpInvert
- | otherwise = error ("unmarshalStencilOp: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-stencilOp :: StateVar (StencilOp, StencilOp, StencilOp)
-stencilOp =
- makeStateVar
- (liftM3 (,,) (getEnum1 unmarshalStencilOp GetStencilFail)
- (getEnum1 unmarshalStencilOp GetStencilPassDepthFail)
- (getEnum1 unmarshalStencilOp GetStencilPassDepthPass))
- (\(sf, spdf, spdp) -> glStencilOp (marshalStencilOp sf)
- (marshalStencilOp spdf)
- (marshalStencilOp spdp))
-
-stencilOpSeparate :: Face -> SettableStateVar (StencilOp, StencilOp, StencilOp)
-stencilOpSeparate face =
- makeSettableStateVar $ \(sf, spdf, spdp) ->
- glStencilOpSeparate (marshalFace face)
- (marshalStencilOp sf)
- (marshalStencilOp spdf)
- (marshalStencilOp spdp)
-
---------------------------------------------------------------------------------
-
-activeStencilFace :: StateVar (Maybe Face)
-activeStencilFace =
- makeStateVarMaybe
- (return CapStencilTestTwoSide)
- (getEnum1 unmarshalFace GetActiveStencilFace)
- (glActiveStencilFace . marshalFace)
-
---------------------------------------------------------------------------------
-
-depthFunc :: StateVar (Maybe ComparisonFunction)
-depthFunc =
- makeStateVarMaybe
- (return CapDepthTest)
- (getEnum1 unmarshalComparisonFunction GetDepthFunc)
- (glDepthFunc . marshalComparisonFunction)
-
---------------------------------------------------------------------------------
-
-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
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/PixelData.hs b/Graphics/Rendering/OpenGL/GL/PixelData.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelData.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelData.hs
@@ -1,32 +1,32 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelData
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal helper module.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelData (
- PixelData(..), withPixelData
-) where
-
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.DataType
-import Graphics.Rendering.OpenGL.GL.PixelFormat
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data PixelData a = PixelData PixelFormat DataType (Ptr a)
- deriving ( Eq, Ord, Show )
-
-withPixelData :: PixelData a -> (GLenum -> GLenum -> Ptr a -> b) -> b
-withPixelData (PixelData pixelFormat dataType ptr) f =
- f (marshalPixelFormat pixelFormat) (marshalDataType dataType) ptr
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelData
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixelFormat.hs b/Graphics/Rendering/OpenGL/GL/PixelFormat.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelFormat.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelFormat.hs
@@ -1,136 +1,130 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelFormat
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling PixelFormat.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelFormat (
- PixelFormat(..), marshalPixelFormat, unmarshalPixelFormat
-) where
-
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_COLOR_INDEX, gl_LUMINANCE, gl_LUMINANCE_ALPHA, gl_ALPHA_INTEGER )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.Abgr ( gl_ABGR )
-import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka ( gl_CMYK, gl_CMYKA )
-import Graphics.Rendering.OpenGL.Raw.EXT.FourTwoTwoPixels (
- gl_422, gl_422_AVERAGE, gl_422_REV, gl_422_REV_AVERAGE )
-
---------------------------------------------------------------------------------
-
-data PixelFormat =
- ColorIndex
- | StencilIndex
- | DepthComponent
- | 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
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles.hs
@@ -1,34 +1,34 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.6 (Pixel Rectangles) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles (
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage,
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer,
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap,
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable,
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution,
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram,
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax,
- module Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization
-) where
-
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs
@@ -1,262 +1,249 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of
--- the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable (
- ColorTableStage(..), colorTableStage,
- Proxy(..), ColorTable(..), PixelInternalFormat(..),
- colorTable, getColorTable, copyColorTable, colorSubTable, copyColorSubTable,
- colorTableScale, colorTableBias, colorTableFormat, colorTableWidth,
- colorTableRGBASizes, colorTableLuminanceSize, colorTableIntesitySize,
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glColorSubTable, glColorTable, glColorTableParameterfv, glCopyColorSubTable,
- glCopyColorTable, glGetColorTable, glGetColorTableParameterfv,
- glGetColorTableParameteriv, gl_COLOR_TABLE, gl_COLOR_TABLE_ALPHA_SIZE,
- gl_COLOR_TABLE_BIAS, gl_COLOR_TABLE_BLUE_SIZE, gl_COLOR_TABLE_FORMAT,
- gl_COLOR_TABLE_GREEN_SIZE, gl_COLOR_TABLE_INTENSITY_SIZE,
- gl_COLOR_TABLE_LUMINANCE_SIZE, gl_COLOR_TABLE_RED_SIZE, gl_COLOR_TABLE_SCALE,
- gl_COLOR_TABLE_WIDTH, gl_POST_COLOR_MATRIX_COLOR_TABLE,
- gl_POST_CONVOLUTION_COLOR_TABLE, gl_PROXY_COLOR_TABLE,
- gl_PROXY_POST_COLOR_MATRIX_COLOR_TABLE,
- gl_PROXY_POST_CONVOLUTION_COLOR_TABLE )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.SharedTexturePalette (
- gl_SHARED_TEXTURE_PALETTE )
-
---------------------------------------------------------------------------------
-
-data ColorTableStage =
- ColorTableStage
- | PostConvolutionColorTableStage
- | PostColorMatrixColorTableStage
- | TextureColorTableStage
- deriving ( Eq, Ord, Show )
-
-colorTableStageToColorTable :: ColorTableStage -> ColorTable
-colorTableStageToColorTable x = case x of
- ColorTableStage -> ColorTable
- PostConvolutionColorTableStage -> PostConvolutionColorTable
- PostColorMatrixColorTableStage -> PostColorMatrixColorTable
- TextureColorTableStage -> TextureColorTable
-
-colorTableStageToEnableCap :: ColorTableStage -> EnableCap
-colorTableStageToEnableCap x = case x of
- ColorTableStage -> CapColorTable
- PostConvolutionColorTableStage -> CapPostConvolutionColorTable
- PostColorMatrixColorTableStage -> CapPostColorMatrixColorTable
- TextureColorTableStage -> CapTextureColorTable
-
---------------------------------------------------------------------------------
-
-colorTableStage :: ColorTableStage -> StateVar Capability
-colorTableStage = makeCapability . colorTableStageToEnableCap
-
---------------------------------------------------------------------------------
-
-data ColorTable =
- ColorTable
- | PostConvolutionColorTable
- | PostColorMatrixColorTable
- | Texture1DColorTable
- | Texture2DColorTable
- | Texture3DColorTable
- | TextureCubeMapColorTable
- | TextureColorTable
- | SharedTexturePalette
- deriving ( Eq, Ord, Show )
-
-marshalColorTable :: ColorTable -> GLenum
-marshalColorTable x = case x of
- ColorTable -> gl_COLOR_TABLE
- PostConvolutionColorTable -> gl_POST_CONVOLUTION_COLOR_TABLE
- PostColorMatrixColorTable -> gl_POST_COLOR_MATRIX_COLOR_TABLE
- Texture1DColorTable -> gl_TEXTURE_1D
- Texture2DColorTable -> gl_TEXTURE_2D
- Texture3DColorTable -> gl_TEXTURE_3D
- TextureCubeMapColorTable -> gl_TEXTURE_CUBE_MAP
- -- TODO: Use TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension
- TextureColorTable -> 0x80bc
- SharedTexturePalette -> gl_SHARED_TEXTURE_PALETTE
-
---------------------------------------------------------------------------------
-
-data Proxy =
- NoProxy
- | Proxy
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-marshalProxyColorTable :: Proxy -> ColorTable -> Maybe GLenum
-marshalProxyColorTable NoProxy x = Just (marshalColorTable x)
-marshalProxyColorTable Proxy x = case x of
- ColorTable -> Just gl_PROXY_COLOR_TABLE
- PostConvolutionColorTable -> Just gl_PROXY_POST_CONVOLUTION_COLOR_TABLE
- PostColorMatrixColorTable -> Just gl_PROXY_POST_COLOR_MATRIX_COLOR_TABLE
- Texture1DColorTable -> Just gl_PROXY_TEXTURE_1D
- Texture2DColorTable -> Just gl_PROXY_TEXTURE_2D
- Texture3DColorTable -> Just gl_PROXY_TEXTURE_3D
- TextureCubeMapColorTable -> Just gl_PROXY_TEXTURE_CUBE_MAP
- -- TODO: Use PROXY_TEXTURE_COLOR_TABLE_SGI from SGI_texture_color_table extension
- TextureColorTable -> Just 0x80bd
- SharedTexturePalette -> Nothing
-
---------------------------------------------------------------------------------
-
-colorTable ::
- Proxy -> ColorTable -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()
-colorTable proxy ct int w pd =
- maybe recordInvalidEnum
- (\target -> withPixelData pd $
- glColorTable target (marshalPixelInternalFormat' int) w)
- (marshalProxyColorTable proxy ct)
-
---------------------------------------------------------------------------------
-
-getColorTable :: ColorTable -> PixelData a -> IO ()
-getColorTable ct pd =
- withPixelData pd $ glGetColorTable (marshalColorTable ct)
-
---------------------------------------------------------------------------------
-
-copyColorTable :: ColorTable -> PixelInternalFormat -> Position -> GLsizei -> IO ()
-copyColorTable ct int (Position x y) =
- glCopyColorTable (marshalColorTable ct) (marshalPixelInternalFormat' int) x y
-
---------------------------------------------------------------------------------
-
-colorSubTable :: ColorTable -> GLsizei -> GLsizei -> PixelData a -> IO ()
-colorSubTable ct start count pd =
- withPixelData pd $ glColorSubTable (marshalColorTable ct) start count
-
---------------------------------------------------------------------------------
-
-copyColorSubTable :: ColorTable -> GLsizei -> Position -> GLsizei -> IO ()
-copyColorSubTable ct start (Position x y) =
- glCopyColorSubTable (marshalColorTable ct) start x y
-
---------------------------------------------------------------------------------
-
-data ColorTablePName =
- ColorTableScale
- | ColorTableBias
- | ColorTableFormat
- | ColorTableWidth
- | ColorTableRedSize
- | ColorTableGreenSize
- | ColorTableBlueSize
- | ColorTableAlphaSize
- | ColorTableLuminanceSize
- | ColorTableIntensitySize
-
-marshalColorTablePName :: ColorTablePName -> GLenum
-marshalColorTablePName x = case x of
- ColorTableScale -> gl_COLOR_TABLE_SCALE
- ColorTableBias -> gl_COLOR_TABLE_BIAS
- ColorTableFormat -> gl_COLOR_TABLE_FORMAT
- ColorTableWidth -> gl_COLOR_TABLE_WIDTH
- ColorTableRedSize -> gl_COLOR_TABLE_RED_SIZE
- ColorTableGreenSize -> gl_COLOR_TABLE_GREEN_SIZE
- ColorTableBlueSize -> gl_COLOR_TABLE_BLUE_SIZE
- ColorTableAlphaSize -> gl_COLOR_TABLE_ALPHA_SIZE
- ColorTableLuminanceSize -> gl_COLOR_TABLE_LUMINANCE_SIZE
- ColorTableIntensitySize -> gl_COLOR_TABLE_INTENSITY_SIZE
-
---------------------------------------------------------------------------------
-
-colorTableScale :: ColorTableStage -> StateVar (Color4 GLfloat)
-colorTableScale = colorTableScaleBias ColorTableScale
-
-colorTableBias :: ColorTableStage -> StateVar (Color4 GLfloat)
-colorTableBias = colorTableScaleBias ColorTableBias
-
-colorTableScaleBias ::
- ColorTablePName -> ColorTableStage -> StateVar (Color4 GLfloat)
-colorTableScaleBias p s =
- makeStateVar (getColorTableParameterC4f ct p) (colorTableParameterC4f ct p)
- where ct = colorTableStageToColorTable s
-
-getColorTableParameterC4f ::
- ColorTable -> ColorTablePName -> IO (Color4 GLfloat)
-getColorTableParameterC4f ct p =
- alloca $ \buf -> do
- glGetColorTableParameterfv
- (marshalColorTable ct)
- (marshalColorTablePName p)
- (castPtr buf)
- peek buf
-
-colorTableParameterC4f ::
- ColorTable -> ColorTablePName -> Color4 GLfloat -> IO ()
-colorTableParameterC4f ct p c =
- with c $ \ptr ->
- glColorTableParameterfv (marshalColorTable ct) (marshalColorTablePName p) (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-colorTableFormat :: ColorTable -> GettableStateVar PixelInternalFormat
-colorTableFormat ct =
- makeGettableStateVar $
- getColorTableParameteri unmarshalPixelInternalFormat ct ColorTableFormat
-
-getColorTableParameteri :: (GLint -> a) -> ColorTable -> ColorTablePName -> IO a
-getColorTableParameteri f ct p =
- alloca $ \buf -> do
- glGetColorTableParameteriv
- (marshalColorTable ct)
- (marshalColorTablePName p)
- buf
- peek1 f buf
-
---------------------------------------------------------------------------------
-
-colorTableWidth :: ColorTable -> GettableStateVar GLsizei
-colorTableWidth ct =
- makeGettableStateVar $
- getColorTableParameteri fromIntegral ct ColorTableWidth
-
---------------------------------------------------------------------------------
-
-colorTableRGBASizes :: ColorTable -> GettableStateVar (Color4 GLsizei)
-colorTableRGBASizes ct =
- makeGettableStateVar $ do
- r <- getColorTableParameteri fromIntegral ct ColorTableRedSize
- g <- getColorTableParameteri fromIntegral ct ColorTableGreenSize
- b <- getColorTableParameteri fromIntegral ct ColorTableBlueSize
- a <- getColorTableParameteri fromIntegral ct ColorTableAlphaSize
- return $ Color4 r g b a
-
-colorTableLuminanceSize :: ColorTable -> GettableStateVar GLsizei
-colorTableLuminanceSize ct =
- makeGettableStateVar $
- getColorTableParameteri fromIntegral ct ColorTableLuminanceSize
-
-colorTableIntesitySize :: ColorTable -> GettableStateVar GLsizei
-colorTableIntesitySize ct =
- makeGettableStateVar $
- getColorTableParameteri fromIntegral ct ColorTableIntensitySize
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs
@@ -1,292 +1,281 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of
--- the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution (
- ConvolutionTarget(..), convolution,
- convolutionFilter1D, getConvolutionFilter1D,
- convolutionFilter2D, getConvolutionFilter2D,
- separableFilter2D, getSeparableFilter2D,
- copyConvolutionFilter1D, copyConvolutionFilter2D,
- convolutionWidth, convolutionHeight,
- maxConvolutionWidth, maxConvolutionHeight,
- ConvolutionBorderMode(..), convolutionBorderMode,
- convolutionFilterScale, convolutionFilterBias,
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glConvolutionFilter1D, glConvolutionFilter2D, glConvolutionParameterfv,
- glConvolutionParameteri, glCopyConvolutionFilter1D,
- glCopyConvolutionFilter2D, glGetConvolutionFilter,
- glGetConvolutionParameterfv, glGetConvolutionParameteriv,
- glGetSeparableFilter, glSeparableFilter2D, gl_CONSTANT_BORDER,
- gl_CONVOLUTION_1D, gl_CONVOLUTION_2D, gl_CONVOLUTION_BORDER_COLOR,
- gl_CONVOLUTION_BORDER_MODE, gl_CONVOLUTION_FILTER_BIAS,
- gl_CONVOLUTION_FILTER_SCALE, gl_CONVOLUTION_FORMAT, gl_CONVOLUTION_HEIGHT,
- gl_CONVOLUTION_WIDTH, gl_MAX_CONVOLUTION_HEIGHT, gl_MAX_CONVOLUTION_WIDTH,
- gl_REDUCE, gl_REPLICATE_BORDER, gl_SEPARABLE_2D )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data ConvolutionTarget =
- Convolution1D
- | Convolution2D
- | Separable2D
- deriving ( Eq, Ord, Show )
-
-marshalConvolutionTarget :: ConvolutionTarget -> GLenum
-marshalConvolutionTarget x = case x of
- Convolution1D -> gl_CONVOLUTION_1D
- Convolution2D -> gl_CONVOLUTION_2D
- Separable2D -> gl_SEPARABLE_2D
-
-convolutionTargetToEnableCap :: ConvolutionTarget -> EnableCap
-convolutionTargetToEnableCap x = case x of
- Convolution1D -> CapConvolution1D
- Convolution2D -> CapConvolution2D
- Separable2D -> CapSeparable2D
-
---------------------------------------------------------------------------------
-
-convolution :: ConvolutionTarget -> StateVar Capability
-convolution = makeCapability . convolutionTargetToEnableCap
-
---------------------------------------------------------------------------------
-
-convolutionFilter1D :: PixelInternalFormat -> GLsizei -> PixelData a -> IO ()
-convolutionFilter1D int w pd =
- withPixelData pd $
- glConvolutionFilter1D
- (marshalConvolutionTarget Convolution1D)
- (marshalPixelInternalFormat' int) w
-
---------------------------------------------------------------------------------
-
-getConvolutionFilter1D :: PixelData a -> IO ()
-getConvolutionFilter1D = getConvolutionFilter Convolution1D
-
-getConvolutionFilter :: ConvolutionTarget -> PixelData a -> IO ()
-getConvolutionFilter t pd =
- withPixelData pd $ glGetConvolutionFilter (marshalConvolutionTarget t)
-
---------------------------------------------------------------------------------
-
-convolutionFilter2D :: PixelInternalFormat -> Size -> PixelData a -> IO ()
-convolutionFilter2D int (Size w h) pd =
- withPixelData pd $
- glConvolutionFilter2D
- (marshalConvolutionTarget Convolution2D)
- (marshalPixelInternalFormat' int) w h
-
---------------------------------------------------------------------------------
-
-getConvolutionFilter2D :: PixelData a -> IO ()
-getConvolutionFilter2D = getConvolutionFilter Convolution2D
-
---------------------------------------------------------------------------------
-
-separableFilter2D ::
- PixelInternalFormat -> Size -> PixelData a -> PixelData a -> IO ()
-separableFilter2D int (Size w h) pdRow pdCol =
- withPixelData pdRow $ \f1 d1 p1 ->
- withPixelData pdCol $ \f2 d2 p2 ->
- if f1 == f2 && d1 == d2
- then glSeparableFilter2D
- (marshalConvolutionTarget Separable2D)
- (marshalPixelInternalFormat' int) w h f1 d1 p1 p2
- else recordInvalidValue
-
---------------------------------------------------------------------------------
-
-getSeparableFilter2D :: PixelData a -> PixelData a -> IO ()
-getSeparableFilter2D pdRow pdCol =
- withPixelData pdRow $ \f1 d1 p1 ->
- withPixelData pdCol $ \f2 d2 p2 ->
- if f1 == f2 && d1 == d2
- then glGetSeparableFilter
- (marshalConvolutionTarget Separable2D) f1 d1 p1 p2 nullPtr
- else recordInvalidValue
-
---------------------------------------------------------------------------------
-
-copyConvolutionFilter1D :: PixelInternalFormat -> Position -> GLsizei -> IO ()
-copyConvolutionFilter1D int (Position x y) =
- glCopyConvolutionFilter1D
- (marshalConvolutionTarget Convolution1D) (marshalPixelInternalFormat' int)
- x y
-
---------------------------------------------------------------------------------
-
-copyConvolutionFilter2D :: PixelInternalFormat -> Position -> Size -> IO ()
-copyConvolutionFilter2D int (Position x y) (Size w h) =
- glCopyConvolutionFilter2D
- (marshalConvolutionTarget Convolution2D) (marshalPixelInternalFormat' int)
- x y w h
-
---------------------------------------------------------------------------------
-
-data ConvolutionParameter =
- ConvolutionBorderColor
- | ConvolutionBorderMode
- | ConvolutionFilterScale
- | ConvolutionFilterBias
- | ConvolutionFormat
- | ConvolutionWidth
- | ConvolutionHeight
- | MaxConvolutionWidth
- | MaxConvolutionHeight
- deriving ( Eq, Ord, Show )
-
-marshalConvolutionParameter :: ConvolutionParameter -> GLenum
-marshalConvolutionParameter x = case x of
- ConvolutionBorderColor -> gl_CONVOLUTION_BORDER_COLOR
- ConvolutionBorderMode -> gl_CONVOLUTION_BORDER_MODE
- ConvolutionFilterScale -> gl_CONVOLUTION_FILTER_SCALE
- ConvolutionFilterBias -> gl_CONVOLUTION_FILTER_BIAS
- ConvolutionFormat -> gl_CONVOLUTION_FORMAT
- ConvolutionWidth -> gl_CONVOLUTION_WIDTH
- ConvolutionHeight -> gl_CONVOLUTION_HEIGHT
- MaxConvolutionWidth -> gl_MAX_CONVOLUTION_WIDTH
- MaxConvolutionHeight -> gl_MAX_CONVOLUTION_HEIGHT
-
---------------------------------------------------------------------------------
-
-convolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei
-convolutionWidth t = convolutionParameteri t ConvolutionWidth
-
-convolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei
-convolutionHeight t = convolutionParameteri t ConvolutionHeight
-
-maxConvolutionWidth :: ConvolutionTarget -> GettableStateVar GLsizei
-maxConvolutionWidth t = convolutionParameteri t MaxConvolutionWidth
-
-maxConvolutionHeight :: ConvolutionTarget -> GettableStateVar GLsizei
-maxConvolutionHeight t = convolutionParameteri t MaxConvolutionHeight
-
-convolutionParameteri ::
- ConvolutionTarget -> ConvolutionParameter -> GettableStateVar GLsizei
-convolutionParameteri t p =
- makeGettableStateVar (getConvolutionParameteri fromIntegral t p)
-
-getConvolutionParameteri ::
- (GLint -> a) -> ConvolutionTarget -> ConvolutionParameter -> IO a
-getConvolutionParameteri f t p =
- alloca $ \buf -> do
- glGetConvolutionParameteriv
- (marshalConvolutionTarget t) (marshalConvolutionParameter p) buf
- peek1 f buf
-
---------------------------------------------------------------------------------
-
-data ConvolutionBorderMode' =
- Reduce'
- | ConstantBorder'
- | ReplicateBorder'
-
-marshalConvolutionBorderMode' :: ConvolutionBorderMode' -> GLint
-marshalConvolutionBorderMode' x = fromIntegral $ case x of
- Reduce' -> gl_REDUCE
- ConstantBorder' -> gl_CONSTANT_BORDER
- ReplicateBorder' -> gl_REPLICATE_BORDER
-
-unmarshalConvolutionBorderMode' :: GLint -> ConvolutionBorderMode'
-unmarshalConvolutionBorderMode' x
- | y == gl_REDUCE = Reduce'
- | y == gl_CONSTANT_BORDER = ConstantBorder'
- | y == gl_REPLICATE_BORDER = ReplicateBorder'
- | otherwise = error ("unmarshalConvolutionBorderMode': illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-data ConvolutionBorderMode =
- Reduce
- | ConstantBorder (Color4 GLfloat)
- | ReplicateBorder
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-convolutionBorderMode :: ConvolutionTarget -> StateVar ConvolutionBorderMode
-convolutionBorderMode t =
- makeStateVar (getConvolutionBorderMode t) (setConvolutionBorderMode t)
-
-getConvolutionBorderMode :: ConvolutionTarget -> IO ConvolutionBorderMode
-getConvolutionBorderMode t = do
- mode <- getConvolutionParameteri
- unmarshalConvolutionBorderMode' t ConvolutionBorderMode
- case mode of
- Reduce' -> return Reduce
- ConstantBorder' -> do
- c <- getConvolutionParameterC4f t ConvolutionBorderColor
- return $ ConstantBorder c
- ReplicateBorder' -> return ReplicateBorder
-
-setConvolutionBorderMode :: ConvolutionTarget -> ConvolutionBorderMode -> IO ()
-setConvolutionBorderMode t mode = do
- let setBM = setConvolutionParameteri
- marshalConvolutionBorderMode' t ConvolutionBorderMode
- case mode of
- Reduce -> setBM Reduce'
- ConstantBorder c -> do
- setBM ConstantBorder'
- convolutionParameterC4f t ConvolutionBorderColor c
- ReplicateBorder -> setBM ReplicateBorder'
-
-setConvolutionParameteri ::
- (a -> GLint) -> ConvolutionTarget -> ConvolutionParameter -> a -> IO ()
-setConvolutionParameteri f t p x =
- glConvolutionParameteri
- (marshalConvolutionTarget t) (marshalConvolutionParameter p) (f x)
-
---------------------------------------------------------------------------------
-
-convolutionFilterScale :: ConvolutionTarget -> StateVar (Color4 GLfloat)
-convolutionFilterScale = convolutionC4f ConvolutionFilterScale
-
-convolutionFilterBias :: ConvolutionTarget -> StateVar (Color4 GLfloat)
-convolutionFilterBias = convolutionC4f ConvolutionFilterBias
-
-convolutionC4f ::
- ConvolutionParameter -> ConvolutionTarget -> StateVar (Color4 GLfloat)
-convolutionC4f p t =
- makeStateVar (getConvolutionParameterC4f t p) (convolutionParameterC4f t p)
-
-getConvolutionParameterC4f ::
- ConvolutionTarget -> ConvolutionParameter -> IO (Color4 GLfloat)
-getConvolutionParameterC4f t p =
- alloca $ \buf -> do
- glGetConvolutionParameterfv
- (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr buf)
- peek buf
-
-convolutionParameterC4f ::
- ConvolutionTarget -> ConvolutionParameter -> Color4 GLfloat -> IO ()
-convolutionParameterC4f t p c =
- with c $ \ptr ->
- glConvolutionParameterfv
- (marshalConvolutionTarget t) (marshalConvolutionParameter p) (castPtr ptr)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs
@@ -1,138 +1,132 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of
--- the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram (
- Sink(..), histogram, Reset(..), getHistogram, resetHistogram,
- histogramRGBASizes, histogramLuminanceSize
-) where
-
-import Foreign.Marshal.Alloc
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glGetHistogram, glGetHistogramParameteriv, glHistogram, glResetHistogram,
- gl_HISTOGRAM, gl_HISTOGRAM_ALPHA_SIZE, gl_HISTOGRAM_BLUE_SIZE,
- gl_HISTOGRAM_FORMAT, gl_HISTOGRAM_GREEN_SIZE, gl_HISTOGRAM_LUMINANCE_SIZE,
- gl_HISTOGRAM_RED_SIZE, gl_HISTOGRAM_SINK, gl_HISTOGRAM_WIDTH,
- gl_PROXY_HISTOGRAM )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data HistogramTarget =
- Histogram
- | ProxyHistogram
-
-marshalHistogramTarget :: HistogramTarget -> GLenum
-marshalHistogramTarget x = case x of
- Histogram -> gl_HISTOGRAM
- ProxyHistogram -> gl_PROXY_HISTOGRAM
-
-proxyToHistogramTarget :: Proxy -> HistogramTarget
-proxyToHistogramTarget x = case x of
- NoProxy -> Histogram
- Proxy -> ProxyHistogram
-
---------------------------------------------------------------------------------
-
-histogram :: Proxy -> StateVar (Maybe (GLsizei, PixelInternalFormat, Sink))
-histogram proxy =
- makeStateVarMaybe
- (return CapHistogram) (getHistogram' proxy) (setHistogram proxy)
-
-getHistogram' :: Proxy -> IO (GLsizei, PixelInternalFormat, Sink)
-getHistogram' proxy = do
- w <- getHistogramParameteri fromIntegral proxy HistogramWidth
- f <- getHistogramParameteri unmarshalPixelInternalFormat proxy HistogramFormat
- s <- getHistogramParameteri unmarshalSink proxy HistogramSink
- return (w, f, s)
-
-getHistogramParameteri ::
- (GLint -> a) -> Proxy -> GetHistogramParameterPName -> IO a
-getHistogramParameteri f proxy p =
- alloca $ \buf -> do
- glGetHistogramParameteriv
- (marshalHistogramTarget (proxyToHistogramTarget proxy))
- (marshalGetHistogramParameterPName p)
- buf
- peek1 f buf
-
-setHistogram :: Proxy -> (GLsizei, PixelInternalFormat, Sink) -> IO ()
-setHistogram proxy (w, int, sink) =
- glHistogram
- (marshalHistogramTarget (proxyToHistogramTarget proxy))
- w
- (marshalPixelInternalFormat' int)
- (marshalSink sink)
-
---------------------------------------------------------------------------------
-
-getHistogram :: Reset -> PixelData a -> IO ()
-getHistogram reset pd =
- withPixelData pd $
- glGetHistogram
- (marshalHistogramTarget Histogram)
- (marshalReset reset)
-
---------------------------------------------------------------------------------
-
-resetHistogram :: IO ()
-resetHistogram = glResetHistogram (marshalHistogramTarget Histogram)
-
---------------------------------------------------------------------------------
-
-data GetHistogramParameterPName =
- HistogramWidth
- | HistogramFormat
- | HistogramRedSize
- | HistogramGreenSize
- | HistogramBlueSize
- | HistogramAlphaSize
- | HistogramLuminanceSize
- | HistogramSink
-
-marshalGetHistogramParameterPName :: GetHistogramParameterPName -> GLenum
-marshalGetHistogramParameterPName x = case x of
- HistogramWidth -> gl_HISTOGRAM_WIDTH
- HistogramFormat -> gl_HISTOGRAM_FORMAT
- HistogramRedSize -> gl_HISTOGRAM_RED_SIZE
- HistogramGreenSize -> gl_HISTOGRAM_GREEN_SIZE
- HistogramBlueSize -> gl_HISTOGRAM_BLUE_SIZE
- HistogramAlphaSize -> gl_HISTOGRAM_ALPHA_SIZE
- HistogramLuminanceSize -> gl_HISTOGRAM_LUMINANCE_SIZE
- HistogramSink -> gl_HISTOGRAM_SINK
-
---------------------------------------------------------------------------------
-
-histogramRGBASizes :: Proxy -> GettableStateVar (Color4 GLsizei)
-histogramRGBASizes proxy =
- makeGettableStateVar $ do
- r <- getHistogramParameteri fromIntegral proxy HistogramRedSize
- g <- getHistogramParameteri fromIntegral proxy HistogramGreenSize
- b <- getHistogramParameteri fromIntegral proxy HistogramBlueSize
- a <- getHistogramParameteri fromIntegral proxy HistogramAlphaSize
- return $ Color4 r g b a
-
-histogramLuminanceSize :: Proxy -> GettableStateVar GLsizei
-histogramLuminanceSize proxy =
- makeGettableStateVar $
- getHistogramParameteri fromIntegral proxy HistogramLuminanceSize
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs
@@ -1,92 +1,89 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of
--- the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax (
- minmax, getMinmax, resetMinmax
-) where
-
-import Foreign.Marshal.Alloc
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
-import Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glGetMinmax, glGetMinmaxParameteriv, glMinmax, glResetMinmax, gl_MINMAX,
- gl_MINMAX_FORMAT, gl_MINMAX_SINK )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data MinmaxTarget =
- Minmax
-
-marshalMinmaxTarget :: MinmaxTarget -> GLenum
-marshalMinmaxTarget x = case x of
- Minmax -> gl_MINMAX
-
---------------------------------------------------------------------------------
-
-minmax :: StateVar (Maybe (PixelInternalFormat, Sink))
-minmax = makeStateVarMaybe (return CapMinmax) getMinmax' setMinmax
-
-getMinmax' :: IO (PixelInternalFormat, Sink)
-getMinmax' = do
- f <- getMinmaxParameteri unmarshalPixelInternalFormat MinmaxFormat
- s <- getMinmaxParameteri unmarshalSink MinmaxSink
- return (f, s)
-
-setMinmax :: (PixelInternalFormat, Sink) -> IO ()
-setMinmax (int, sink) =
- glMinmax
- (marshalMinmaxTarget Minmax)
- (marshalPixelInternalFormat' int)
- (marshalSink sink)
-
---------------------------------------------------------------------------------
-
-getMinmax :: Reset -> PixelData a -> IO ()
-getMinmax reset pd =
- withPixelData pd $
- glGetMinmax (marshalMinmaxTarget Minmax) (marshalReset reset)
-
---------------------------------------------------------------------------------
-
-resetMinmax :: IO ()
-resetMinmax = glResetMinmax (marshalMinmaxTarget Minmax)
-
---------------------------------------------------------------------------------
-
-data GetMinmaxParameterPName =
- MinmaxFormat
- | MinmaxSink
-
-marshalGetMinmaxParameterPName :: GetMinmaxParameterPName -> GLenum
-marshalGetMinmaxParameterPName x = case x of
- MinmaxFormat -> gl_MINMAX_FORMAT
- MinmaxSink -> gl_MINMAX_SINK
-
---------------------------------------------------------------------------------
-
-getMinmaxParameteri :: (GLint -> a) -> GetMinmaxParameterPName -> IO a
-getMinmaxParameteri f p =
- alloca $ \buf -> do
- glGetMinmaxParameteriv
- (marshalMinmaxTarget Minmax)
- (marshalGetMinmaxParameterPName p)
- buf
- peek1 f buf
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs
@@ -1,214 +1,208 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of
--- the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-{-# 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.StateVar
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glGetPixelMapfv, glGetPixelMapuiv, glGetPixelMapusv, glPixelMapfv,
- glPixelMapuiv, glPixelMapusv, gl_PIXEL_MAP_A_TO_A, gl_PIXEL_MAP_B_TO_B,
- gl_PIXEL_MAP_G_TO_G, gl_PIXEL_MAP_I_TO_A, gl_PIXEL_MAP_I_TO_B,
- gl_PIXEL_MAP_I_TO_G, gl_PIXEL_MAP_I_TO_I, gl_PIXEL_MAP_I_TO_R,
- gl_PIXEL_MAP_R_TO_R, gl_PIXEL_MAP_S_TO_S )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data PixelMapTarget =
- IToI
- | SToS
- | IToR
- | IToG
- | IToB
- | IToA
- | RToR
- | GToG
- | BToB
- | AToA
-
-marshalPixelMapTarget :: PixelMapTarget -> GLenum
-marshalPixelMapTarget x = case x of
- IToI -> gl_PIXEL_MAP_I_TO_I
- SToS -> gl_PIXEL_MAP_S_TO_S
- IToR -> gl_PIXEL_MAP_I_TO_R
- IToG -> gl_PIXEL_MAP_I_TO_G
- IToB -> gl_PIXEL_MAP_I_TO_B
- IToA -> gl_PIXEL_MAP_I_TO_A
- RToR -> gl_PIXEL_MAP_R_TO_R
- GToG -> gl_PIXEL_MAP_G_TO_G
- BToB -> gl_PIXEL_MAP_B_TO_B
- AToA -> gl_PIXEL_MAP_A_TO_A
-
-pixelMapTargetToGetPName :: PixelMapTarget -> 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs
@@ -1,118 +1,118 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.6.1 (Pixel Storage Modes) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage (
- PixelStoreDirection(..), swapBytes, lsbFirst, rowLength, skipRows,
- skipPixels, rowAlignment, imageHeight, skipImages
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data PixelStoreDirection =
- Pack
- | Unpack
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-data PixelStore =
- UnpackSwapBytes
- | UnpackLSBFirst
- | UnpackRowLength
- | UnpackSkipRows
- | UnpackSkipPixels
- | UnpackAlignment
- | PackSwapBytes
- | PackLSBFirst
- | PackRowLength
- | PackSkipRows
- | PackSkipPixels
- | PackAlignment
- | PackSkipImages
- | PackImageHeight
- | UnpackSkipImages
- | UnpackImageHeight
-
-marshalPixelStore :: PixelStore -> GLenum
-marshalPixelStore x = case x of
- UnpackSwapBytes -> gl_UNPACK_SWAP_BYTES
- UnpackLSBFirst -> gl_UNPACK_LSB_FIRST
- UnpackRowLength -> gl_UNPACK_ROW_LENGTH
- UnpackSkipRows -> gl_UNPACK_SKIP_ROWS
- UnpackSkipPixels -> gl_UNPACK_SKIP_PIXELS
- UnpackAlignment -> gl_UNPACK_ALIGNMENT
- PackSwapBytes -> gl_PACK_SWAP_BYTES
- PackLSBFirst -> gl_PACK_LSB_FIRST
- PackRowLength -> gl_PACK_ROW_LENGTH
- PackSkipRows -> gl_PACK_SKIP_ROWS
- PackSkipPixels -> gl_PACK_SKIP_PIXELS
- PackAlignment -> gl_PACK_ALIGNMENT
- PackSkipImages -> gl_PACK_SKIP_IMAGES
- PackImageHeight -> gl_PACK_IMAGE_HEIGHT
- UnpackSkipImages -> gl_UNPACK_SKIP_IMAGES
- UnpackImageHeight -> gl_UNPACK_IMAGE_HEIGHT
-
---------------------------------------------------------------------------------
-
-swapBytes :: PixelStoreDirection -> StateVar Bool
-swapBytes Pack = pixelStoreb GetPackSwapBytes PackSwapBytes
-swapBytes Unpack = pixelStoreb GetUnpackSwapBytes UnpackSwapBytes
-
-lsbFirst :: PixelStoreDirection -> StateVar Bool
-lsbFirst Pack = pixelStoreb GetPackLSBFirst PackLSBFirst
-lsbFirst Unpack = pixelStoreb GetUnpackLSBFirst UnpackLSBFirst
-
-rowLength :: PixelStoreDirection -> StateVar GLint
-rowLength Pack = pixelStorei GetPackRowLength PackRowLength
-rowLength Unpack = pixelStorei GetUnpackRowLength UnpackRowLength
-
-skipRows :: PixelStoreDirection -> StateVar GLint
-skipRows Pack = pixelStorei GetPackSkipRows PackSkipRows
-skipRows Unpack = pixelStorei GetUnpackSkipRows UnpackSkipRows
-
-skipPixels :: PixelStoreDirection -> StateVar GLint
-skipPixels Pack = pixelStorei GetPackSkipPixels PackSkipPixels
-skipPixels Unpack = pixelStorei GetUnpackSkipPixels UnpackSkipPixels
-
-rowAlignment :: PixelStoreDirection -> StateVar GLint
-rowAlignment Pack = pixelStorei GetPackAlignment PackAlignment
-rowAlignment Unpack = pixelStorei GetUnpackAlignment UnpackAlignment
-
-imageHeight :: PixelStoreDirection -> StateVar GLint
-imageHeight Pack = pixelStorei GetPackImageHeight PackImageHeight
-imageHeight Unpack = pixelStorei GetUnpackImageHeight UnpackImageHeight
-
-skipImages :: PixelStoreDirection -> StateVar GLint
-skipImages Pack = pixelStorei GetPackSkipImages PackSkipImages
-skipImages Unpack = pixelStorei GetUnpackSkipImages UnpackSkipImages
-
---------------------------------------------------------------------------------
-
-pixelStoreb :: 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
+-- 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))
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs
@@ -1,246 +1,233 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to a part of section 3.6.1 (Pixel Storage Modes) of
--- the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer (
- PixelTransferStage(..),
- mapColor, mapStencil, indexShift, indexOffset, depthScale, depthBias,
- rgbaScale, rgbaBias
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glPixelTransferf, glPixelTransferi, gl_ALPHA_BIAS, gl_ALPHA_SCALE,
- gl_BLUE_BIAS, gl_BLUE_SCALE, gl_DEPTH_BIAS, gl_DEPTH_SCALE, gl_GREEN_BIAS,
- gl_GREEN_SCALE, gl_INDEX_OFFSET, gl_INDEX_SHIFT, gl_MAP_COLOR,
- gl_MAP_STENCIL, gl_POST_COLOR_MATRIX_ALPHA_BIAS,
- gl_POST_COLOR_MATRIX_ALPHA_SCALE, gl_POST_COLOR_MATRIX_BLUE_BIAS,
- gl_POST_COLOR_MATRIX_BLUE_SCALE, gl_POST_COLOR_MATRIX_GREEN_BIAS,
- gl_POST_COLOR_MATRIX_GREEN_SCALE, gl_POST_COLOR_MATRIX_RED_BIAS,
- gl_POST_COLOR_MATRIX_RED_SCALE, gl_POST_CONVOLUTION_ALPHA_BIAS,
- gl_POST_CONVOLUTION_ALPHA_SCALE, gl_POST_CONVOLUTION_BLUE_BIAS,
- gl_POST_CONVOLUTION_BLUE_SCALE, gl_POST_CONVOLUTION_GREEN_BIAS,
- gl_POST_CONVOLUTION_GREEN_SCALE, gl_POST_CONVOLUTION_RED_BIAS,
- gl_POST_CONVOLUTION_RED_SCALE, gl_RED_BIAS, gl_RED_SCALE )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data PixelTransfer =
- MapColor
- | MapStencil
- | IndexShift
- | IndexOffset
- | RedScale
- | RedBias
- | GreenScale
- | GreenBias
- | BlueScale
- | BlueBias
- | AlphaScale
- | AlphaBias
- | DepthScale
- | DepthBias
- | PostConvolutionRedScale
- | PostConvolutionGreenScale
- | PostConvolutionBlueScale
- | PostConvolutionAlphaScale
- | PostConvolutionRedBias
- | PostConvolutionGreenBias
- | PostConvolutionBlueBias
- | PostConvolutionAlphaBias
- | PostColorMatrixRedScale
- | PostColorMatrixGreenScale
- | PostColorMatrixBlueScale
- | PostColorMatrixAlphaScale
- | PostColorMatrixRedBias
- | PostColorMatrixGreenBias
- | PostColorMatrixBlueBias
- | PostColorMatrixAlphaBias
-
-marshalPixelTransfer :: PixelTransfer -> GLenum
-marshalPixelTransfer x = case x of
- MapColor -> gl_MAP_COLOR
- MapStencil -> gl_MAP_STENCIL
- IndexShift -> gl_INDEX_SHIFT
- IndexOffset -> gl_INDEX_OFFSET
- RedScale -> gl_RED_SCALE
- RedBias -> gl_RED_BIAS
- GreenScale -> gl_GREEN_SCALE
- GreenBias -> gl_GREEN_BIAS
- BlueScale -> gl_BLUE_SCALE
- BlueBias -> gl_BLUE_BIAS
- AlphaScale -> gl_ALPHA_SCALE
- AlphaBias -> gl_ALPHA_BIAS
- DepthScale -> gl_DEPTH_SCALE
- DepthBias -> gl_DEPTH_BIAS
- PostConvolutionRedScale -> gl_POST_CONVOLUTION_RED_SCALE
- PostConvolutionGreenScale -> gl_POST_CONVOLUTION_GREEN_SCALE
- PostConvolutionBlueScale -> gl_POST_CONVOLUTION_BLUE_SCALE
- PostConvolutionAlphaScale -> gl_POST_CONVOLUTION_ALPHA_SCALE
- PostConvolutionRedBias -> gl_POST_CONVOLUTION_RED_BIAS
- PostConvolutionGreenBias -> gl_POST_CONVOLUTION_GREEN_BIAS
- PostConvolutionBlueBias -> gl_POST_CONVOLUTION_BLUE_BIAS
- PostConvolutionAlphaBias -> gl_POST_CONVOLUTION_ALPHA_BIAS
- PostColorMatrixRedScale -> gl_POST_COLOR_MATRIX_RED_SCALE
- PostColorMatrixGreenScale -> gl_POST_COLOR_MATRIX_GREEN_SCALE
- PostColorMatrixBlueScale -> gl_POST_COLOR_MATRIX_BLUE_SCALE
- PostColorMatrixAlphaScale -> gl_POST_COLOR_MATRIX_ALPHA_SCALE
- PostColorMatrixRedBias -> gl_POST_COLOR_MATRIX_RED_BIAS
- PostColorMatrixGreenBias -> gl_POST_COLOR_MATRIX_GREEN_BIAS
- PostColorMatrixBlueBias -> gl_POST_COLOR_MATRIX_BLUE_BIAS
- PostColorMatrixAlphaBias -> gl_POST_COLOR_MATRIX_ALPHA_BIAS
-
---------------------------------------------------------------------------------
-
-data PixelTransferStage =
- PreConvolution
- | PostConvolution
- | PostColorMatrix
- deriving ( Eq, Ord, Show )
-
-stageToGetScales ::
- PixelTransferStage
- -> (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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs
@@ -1,41 +1,39 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to a part of section 3.6.4 (Rasterization of Pixel
--- Rectangles) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization (
- PixelData(..), PixelFormat(..), drawPixels, pixelZoom
-) where
-
-import Control.Monad
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.PixelFormat
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glDrawPixels, glPixelZoom )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-drawPixels :: Size -> PixelData a -> IO ()
-drawPixels (Size w h) pd = withPixelData pd $ glDrawPixels w h
-
---------------------------------------------------------------------------------
-
-pixelZoom :: StateVar (GLfloat, GLfloat)
-pixelZoom =
- makeStateVar
- (liftM2 (,) (getFloat1 id GetZoomX) (getFloat1 id GetZoomY))
- (uncurry glPixelZoom)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs
@@ -1,31 +1,31 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling Reset.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset (
- Reset(..), marshalReset
-) where
-
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data Reset =
- NoReset
- | Reset
- deriving ( Eq, Ord, Show )
-
-marshalReset :: Reset -> GLboolean
-marshalReset x = marshalGLboolean (x == Reset)
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs
--- a/Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs
@@ -1,34 +1,34 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling Sink.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink (
- Sink(..), marshalSink, unmarshalSink
-) where
-
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data Sink =
- PassThrough
- | Sink
- deriving ( Eq, Ord, Show )
-
-marshalSink :: Sink -> GLboolean
-marshalSink x = marshalGLboolean (x == Sink)
-
-unmarshalSink :: GLint -> Sink
-unmarshalSink s = if unmarshalGLboolean s then Sink else PassThrough
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs b/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs
--- a/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs
+++ b/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs
@@ -1,84 +1,82 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.PixellikeObject
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PixellikeObject (
- PixellikeObjectGetPName(..),
- PixellikeObjectTarget(pixellikeObjTarParam),
-) where
-
-import Foreign.Marshal.Alloc
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.Attachments
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects
-import Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects
-
-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 = TextureTargetFull (Either TextureTarget CubeMapTarget) Level
-instance PixellikeObjectTarget TextureTargetFull 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 (marshalTarget t) level p buf
- peek1 id buf
- where marshalTarget = either marshalTextureTarget marshalCubeMapTarget
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PixellikeObject
+-- Copyright : (c) Sven Panne, Lars Corbijn 2011-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PointParameter.hs b/Graphics/Rendering/OpenGL/GL/PointParameter.hs
--- a/Graphics/Rendering/OpenGL/GL/PointParameter.hs
+++ b/Graphics/Rendering/OpenGL/GL/PointParameter.hs
@@ -1,46 +1,44 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PointParameter
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for setting point parameters.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PointParameter (
- PointParameter(..), pointParameterf, pointParameterfv
-) where
-
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_POINT_DISTANCE_ATTENUATION, gl_POINT_SIZE_MAX, gl_POINT_SIZE_MIN )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data PointParameter =
- PointSizeMin
- | PointSizeMax
- | PointFadeThresholdSize
- | PointDistanceAttenuation
-
-marshalPointParameter :: PointParameter -> GLenum
-marshalPointParameter x = case x of
- PointSizeMin -> gl_POINT_SIZE_MIN
- PointSizeMax -> gl_POINT_SIZE_MAX
- PointFadeThresholdSize -> gl_POINT_FADE_THRESHOLD_SIZE
- PointDistanceAttenuation -> gl_POINT_DISTANCE_ATTENUATION
-
---------------------------------------------------------------------------------
-
-pointParameterf :: PointParameter -> GLfloat -> IO ()
-pointParameterf = glPointParameterf . marshalPointParameter
-
-pointParameterfv :: PointParameter -> Ptr GLfloat -> IO ()
-pointParameterfv = glPointParameterfv . marshalPointParameter
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PointParameter
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Points.hs b/Graphics/Rendering/OpenGL/GL/Points.hs
--- a/Graphics/Rendering/OpenGL/GL/Points.hs
+++ b/Graphics/Rendering/OpenGL/GL/Points.hs
@@ -1,217 +1,217 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Points
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.3 (Points) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Points (
- -- * Point Rasterization
- pointSize, vertexProgramPointSize,
-
- -- * Controlling the Derived Size
- pointSizeRange, pointDistanceAttenuation,
-
- -- * Fading Points
- pointFadeThresholdSize,
-
- -- * Point Antialiasing
- pointSmooth,
-
- -- * Point Sprites
- pointSprite,
-
- -- * Implementation-Dependent Limits
- aliasedPointSizeRange, smoothPointSizeRange, smoothPointSizeGranularity
-) where
-
-import Control.Monad
-import Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.PointParameter
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | 'pointSize' contains the rasterized diameter of both aliased and
--- antialiased points. The initial value is 1. Using a point size other than 1
--- has different effects, depending on whether point antialiasing is enabled
--- (see 'pointSmooth') or point sprites are enabled (see 'pointSprite'). Both
--- are initially disabled.
---
--- The specified point size is multiplied with a distance attenuation factor
--- and clamped to the specified 'pointSizeRange', and further clamped to the
--- implementation-dependent point size range to produce the derived point size
--- using
---
--- @ /derivedSize/ = /clamp/ (/size/ * /sqrt/ (1 \/ (/a/ + /b/ * /d/ + /c/ * /d/^2)))@
---
--- where /d/ is the eye-coordinate distance from the eye to the vertex, and /a/,
--- /b/, and /c/ are the distance attenuation coefficients (see
--- 'pointDistanceAttenuation').
---
--- If multisampling is disabled, the computed point size is used as the point\'s
--- width.
---
--- If multisampling is enabled, the point may be faded by modifying the point
--- alpha value (see 'Graphics.Rendering.OpenGL.GL.PerFragment.sampleCoverage')
--- instead of allowing the point width to go below a given
--- 'pointFadeThresholdSize'. In this case, the width is further modified in
--- the following manner:
---
--- @ /width/ = if /derivedSize/ >= /threshold/ then /derivedSize/ else /threshold/@
---
--- The point alpha value is modified by computing:
---
--- @ /alpha/ = if /derivedSize/ >= /threshold/ then 1 else (/derivedSize/ \/ /threshold/)^2@
---
--- If point antialiasing is disabled, the actual size is determined by rounding
--- the supplied size to the nearest integer. (If the rounding results in the
--- value 0, it is as if the point size were 1.) If the rounded size is odd,
--- then the center point (/x/, /y/) of the pixel fragment that represents
--- the point is computed as
---
--- @ (/x/, /y/) = (/floor/ /xw/ + 0.5, /floor/ /yw/ + 0.5)@
---
--- where /xw/ and /yw/ indicate window coordinates. All pixels that lie within
--- the square grid of the rounded size centered at (/x/, /y/) make up the
--- fragment. If the size is even, the center point is
---
--- @ (/x/, /y/) = (/floor/ (/xw/ + 0.5), /floor/ (/yw/ + 0.5))@
---
--- and the rasterized fragment\'s centers are the half-integer window
--- coordinates within the square of the rounded size centered at (/x/, /y/). All
--- pixel fragments produced in rasterizing a nonantialiased point are assigned
--- the same associated data, that of the vertex corresponding to the point.
---
--- If antialiasing is enabled, then point rasterization produces a fragment for
--- each pixel square that intersects the region lying within the circle having
--- diameter equal to the current point size and centered at the point\'s
--- (/xw/, /yw/). The coverage value for each fragment is the window coordinate
--- area of the intersection of the circular region with the corresponding pixel
--- square. This value is saved and used in the final rasterization step. The
--- data associated with each fragment is the data associated with the point
--- being rasterized.
---
--- Not all sizes are supported when point antialiasing is enabled. If an
--- unsupported size is requested, the nearest supported size is used. Only size
--- 1 is guaranteed to be supported; others depend on the implementation. To
--- query the range of supported sizes for antialiased points and the size
--- difference between supported sizes within the range, query
--- 'smoothPointSizeRange' and 'smoothPointSizeGranularity', respectively. For
--- aliased points, query the supported range with 'aliasedPointSizeRange'.
---
--- The point size specified when 'pointSize' is set is always returned when it
--- is queried. Clamping and rounding for aliased and antialiased points have no
--- effect on the specified value.
---
--- A non-antialiased point size may be clamped to an implementation-dependent
--- maximum. Although this maximum cannot be queried, it must be no less than the
--- maximum value for antialiased points, rounded to the nearest integer value.
---
--- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if
--- 'pointSize' is set to a value less than or equal to zero.
---
--- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidOperation' is generated if
--- 'pointSize' is set during
--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive'.
-
-pointSize :: StateVar GLfloat
-pointSize = makeStateVar (getFloat1 id GetPointSize) glPointSize
-
---------------------------------------------------------------------------------
-
-vertexProgramPointSize :: StateVar Capability
-vertexProgramPointSize = makeCapability CapVertexProgramPointSize
-
---------------------------------------------------------------------------------
-
--- | The range to which the derived point size is clamped, see 'pointSize'. Note
--- that the size is further clamped to the implementation-dependent limits, see
--- 'aliasedPointSizeRange' and 'smoothPointSizeRange'. The initial range is
--- (0, 1).
---
--- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the
--- lower or upper bound of the range is set to a value less than zero. If the
--- lower bound is greater than the upper bound, the point size after clamping is
--- undefined, but no error is generated.
-
-pointSizeRange :: StateVar (GLfloat, GLfloat)
-pointSizeRange =
- makeStateVar
- (liftM2 (,) (getFloat1 id GetPointSizeMin) (getFloat1 id GetPointSizeMax))
- (\(sizeMin, sizeMax) -> do pointParameterf PointSizeMin sizeMin
- pointParameterf PointSizeMax sizeMax)
-
---------------------------------------------------------------------------------
-
--- | The constant, linear, and quadratic distance attenuation coefficients, see
--- 'pointSize'. The initial coefficients are (1, 0, 0).
-
-pointDistanceAttenuation :: StateVar (GLfloat, GLfloat, GLfloat)
-pointDistanceAttenuation =
- makeStateVar
- (getFloat3 (,,) GetPointDistanceAttenuation)
- (\(a, b, c) -> withArray [a, b, c] $
- pointParameterfv PointDistanceAttenuation)
-
---------------------------------------------------------------------------------
-
--- | The threshold for alpha attenuation of points when multisampling is used,
--- see 'pointSize'. The initial threshold is 1.
---
--- An 'Graphics.Rendering.OpenGL.GLU.Errors.InvalidValue' is generated if the
--- threshold is set to a value less than zero.
-
-pointFadeThresholdSize :: StateVar GLfloat
-pointFadeThresholdSize =
- makeStateVar
- (getFloat1 id GetPointFadeThresholdSize)
- (pointParameterf PointFadeThresholdSize)
-
---------------------------------------------------------------------------------
-
--- | Controls whether point antialiasing is enabled. The initial state is
--- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'.
-
-pointSmooth :: StateVar Capability
-pointSmooth = makeCapability CapPointSmooth
-
---------------------------------------------------------------------------------
-
--- | Controls whether point sprites are enabled. The initial state is
--- 'Graphics.Rendering.OpenGL.GL.Capability.Disabled'. When point sprites are
--- enabled, the state of point antialiasing (i.e. 'pointSmooth') is ignored.
-
-pointSprite :: StateVar Capability
-pointSprite = makeCapability CapPointSprite
-
---------------------------------------------------------------------------------
-
--- | The smallest and largest supported size of aliased points.
-
-aliasedPointSizeRange :: GettableStateVar (GLfloat, GLfloat)
-aliasedPointSizeRange =
- makeGettableStateVar $ getFloat2 (,) GetAliasedPointSizeRange
-
--- | The smallest and largest supported size of antialiased points.
-
-smoothPointSizeRange :: GettableStateVar (GLfloat, GLfloat)
-smoothPointSizeRange =
- makeGettableStateVar $ getFloat2 (,) GetSmoothPointSizeRange
-
--- | The antialiased point size granularity, i.e. the size difference between
--- supported sizes.
-
-smoothPointSizeGranularity :: GettableStateVar GLfloat
-smoothPointSizeGranularity =
- makeGettableStateVar $ getFloat1 id GetSmoothPointSizeGranularity
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Points
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PolygonMode.hs b/Graphics/Rendering/OpenGL/GL/PolygonMode.hs
--- a/Graphics/Rendering/OpenGL/GL/PolygonMode.hs
+++ b/Graphics/Rendering/OpenGL/GL/PolygonMode.hs
@@ -1,41 +1,41 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PolygonMode
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling PolygonMode.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PolygonMode (
- PolygonMode(..), marshalPolygonMode, unmarshalPolygonMode
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data PolygonMode =
- Point
- | Line
- | Fill
- deriving ( Eq, Ord, Show )
-
-marshalPolygonMode :: PolygonMode -> GLenum
-marshalPolygonMode x = case x of
- Point -> gl_POINT
- Line -> gl_LINE
- Fill -> gl_FILL
-
-unmarshalPolygonMode :: GLenum -> PolygonMode
-unmarshalPolygonMode x
- | x == gl_POINT = Point
- | x == gl_LINE = Line
- | x == gl_FILL = Fill
- | otherwise = error ("unmarshalPolygonMode: illegal value " ++ show x)
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PolygonMode
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Polygons.hs b/Graphics/Rendering/OpenGL/GL/Polygons.hs
--- a/Graphics/Rendering/OpenGL/GL/Polygons.hs
+++ b/Graphics/Rendering/OpenGL/GL/Polygons.hs
@@ -1,139 +1,139 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Polygons
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.5 (Polygons) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Polygons (
- polygonSmooth, cullFace,
- PolygonStipple(..), GLpolygonstipple, polygonStipple,
- PolygonMode(..), polygonMode, polygonOffset,
- polygonOffsetPoint, polygonOffsetLine, polygonOffsetFill
-) where
-
-import Control.Monad
-import Foreign.ForeignPtr
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.Face
-import Graphics.Rendering.OpenGL.GL.PixelRectangles
-import Graphics.Rendering.OpenGL.GL.PolygonMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.SavingState
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glPolygonStipple, glGetPolygonStipple )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-polygonSmooth :: StateVar Capability
-polygonSmooth = makeCapability CapPolygonSmooth
-
---------------------------------------------------------------------------------
-
-cullFace :: StateVar (Maybe Face)
-cullFace = makeStateVarMaybe (return CapCullFace)
- (getEnum1 unmarshalFace GetCullFaceMode)
- (glCullFace . marshalFace)
-
---------------------------------------------------------------------------------
-
-numPolygonStippleBytes :: Int
-numPolygonStippleBytes = 128 -- 32x32 bits divided into GLubytes
-
-class PolygonStipple s where
- withNewPolygonStipple :: (Ptr GLubyte -> IO ()) -> IO s
- withPolygonStipple :: s -> (Ptr GLubyte -> IO a) -> IO a
- newPolygonStipple :: [GLubyte] -> IO s
- getPolygonStippleComponents :: s -> IO [GLubyte]
-
- withNewPolygonStipple act =
- allocaArray numPolygonStippleBytes $ \p -> do
- act p
- components <- peekArray numPolygonStippleBytes p
- newPolygonStipple components
-
- withPolygonStipple s act = do
- components <- getPolygonStippleComponents s
- withArray components act
-
- newPolygonStipple components =
- withNewPolygonStipple $
- flip pokeArray (take numPolygonStippleBytes components)
-
- getPolygonStippleComponents s =
- withPolygonStipple s $ peekArray numPolygonStippleBytes
-
---------------------------------------------------------------------------------
-
-data GLpolygonstipple = GLpolygonstipple (ForeignPtr GLubyte)
- deriving ( Eq, Ord, Show )
-
-instance PolygonStipple GLpolygonstipple where
- withNewPolygonStipple f = do
- fp <- mallocForeignPtrArray numPolygonStippleBytes
- withForeignPtr fp f
- return $ GLpolygonstipple fp
-
- withPolygonStipple (GLpolygonstipple fp) = withForeignPtr fp
-
---------------------------------------------------------------------------------
-
-polygonStipple :: PolygonStipple s => StateVar (Maybe s)
-polygonStipple =
- makeStateVarMaybe (return CapPolygonStipple)
- (withoutGaps Pack $ withNewPolygonStipple glGetPolygonStipple)
- (\s -> withoutGaps Unpack $ withPolygonStipple s glPolygonStipple)
-
--- Note: No need to set rowAlignment, our memory allocator always returns a
--- region which is at least 8-byte aligned (the maximum)
-withoutGaps :: PixelStoreDirection -> IO a -> IO a
-withoutGaps direction action =
- preservingClientAttrib [ PixelStoreAttributes ] $ do
- rowLength direction $= 0
- skipRows direction $= 0
- skipPixels direction $= 0
- action
-
---------------------------------------------------------------------------------
-
-polygonMode :: StateVar (PolygonMode, PolygonMode)
-polygonMode = makeStateVar getPolygonMode setPolygonMode
-
-getPolygonMode :: IO (PolygonMode, PolygonMode)
-getPolygonMode = getInteger2 (\front back -> (un front, un back)) GetPolygonMode
- where un = unmarshalPolygonMode . fromIntegral
-
-setPolygonMode :: (PolygonMode, PolygonMode) -> IO ()
-setPolygonMode (front, back) = do
- glPolygonMode (marshalFace Front) (marshalPolygonMode front)
- glPolygonMode (marshalFace Back ) (marshalPolygonMode back )
-
---------------------------------------------------------------------------------
-
-polygonOffset :: StateVar (GLfloat, GLfloat)
-polygonOffset =
- makeStateVar (liftM2 (,) (getFloat1 id GetPolygonOffsetFactor)
- (getFloat1 id GetPolygonOffsetUnits))
- (uncurry glPolygonOffset)
-
---------------------------------------------------------------------------------
-
-polygonOffsetPoint :: StateVar Capability
-polygonOffsetPoint = makeCapability CapPolygonOffsetPoint
-
-polygonOffsetLine :: StateVar Capability
-polygonOffsetLine = makeCapability CapPolygonOffsetLine
-
-polygonOffsetFill :: StateVar Capability
-polygonOffsetFill = makeCapability CapPolygonOffsetFill
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Polygons
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs b/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs
--- a/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs
+++ b/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs
@@ -1,98 +1,96 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.PrimitiveMode
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling PrimitiveMode.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.PrimitiveMode (
- PrimitiveMode(..), marshalPrimitiveMode, unmarshalPrimitiveMode
-) where
-
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_QUADS, gl_QUAD_STRIP, gl_POLYGON )
-
---------------------------------------------------------------------------------
-
--- | Specification of the way the vertices given during 'renderPrimitive' are
--- interpreted. In the description of the constructors, /n/ is an integer count
--- starting at one, and /N/ is the total number of vertices specified.
-
-data PrimitiveMode =
- Points
- -- ^ Treats each vertex as a single point. Vertex /n/ defines point /n/.
- -- /N/ points are drawn.
- | Lines
- -- ^ Treats each pair of vertices as an independent line segment. Vertices
- -- 2/n/-1 and 2/n/ define line /n/. /N/\/2 lines are drawn.
- | LineLoop
- -- ^ Draws a connected group of line segments from the first vertex to the
- -- last, then back to the first. Vertices /n/ and /n/+1 define line /n/.
- -- The last line, however, is defined by vertices /N/ and 1. /N/ lines
- -- are drawn.
- | LineStrip
- -- ^ Draws a connected group of line segments from the first vertex to the
- -- last. Vertices /n/ and /n/+1 define line /n/. /N/-1 lines are drawn.
- | Triangles
- -- ^ Treats each triplet of vertices as an independent triangle. Vertices
- -- /3n-2/, /3n-1/, and /3n/ define triangle /n/. /N\/3/ triangles are drawn.
- | TriangleStrip
- -- ^ Draws a connected group of triangles. One triangle is defined for each
- -- vertex presented after the first two vertices. For odd /n/, vertices
- -- /n/, /n/+1, and /n/+2 define triangle /n/. For even /n/, vertices /n/+1,
- -- /n/, and /n/+2 define triangle /n/. /N/-2 triangles are drawn.
- | TriangleFan
- -- ^ Draws a connected group of triangles. One triangle is defined for each
- -- vertex presented after the first two vertices. Vertices 1, /n/+1, and
- -- /n/+2 define triangle /n/. /N/-2 triangles are drawn.
- | Quads
- -- ^ Treats each group of four vertices as an independent quadrilateral.
- -- Vertices 4/n/-3, 4/n/-2, 4/n/-1, and 4/n/ define quadrilateral /n/.
- -- /N/\/4 quadrilaterals are drawn.
- | QuadStrip
- -- ^ Draws a connected group of quadrilaterals. One quadrilateral is
- --defined for each pair of vertices presented after the first pair.
- -- Vertices 2/n/-1, 2/n/, 2/n/+2, and 2/n/+1 define quadrilateral /n/.
- -- /N/\/2-1 quadrilaterals are drawn. Note that the order in which vertices
- -- are used to construct a quadrilateral from strip data is different from
- -- that used with independent data.
- | Polygon
- -- ^ Draws a single, convex polygon. Vertices 1 through /N/ define this
- -- polygon.
- deriving ( Eq, Ord, Show )
-
-marshalPrimitiveMode :: PrimitiveMode -> GLenum
-marshalPrimitiveMode x = case x of
- Points -> gl_POINTS
- Lines -> gl_LINES
- LineLoop -> gl_LINE_LOOP
- LineStrip -> gl_LINE_STRIP
- Triangles -> gl_TRIANGLES
- TriangleStrip -> gl_TRIANGLE_STRIP
- TriangleFan -> gl_TRIANGLE_FAN
- Quads -> gl_QUADS
- QuadStrip -> gl_QUAD_STRIP
- Polygon -> gl_POLYGON
-
-unmarshalPrimitiveMode :: GLenum -> PrimitiveMode
-unmarshalPrimitiveMode x
- | x == gl_POINTS = Points
- | x == gl_LINES = Lines
- | x == gl_LINE_LOOP = LineLoop
- | x == gl_LINE_STRIP = LineStrip
- | x == gl_TRIANGLES = Triangles
- | x == gl_TRIANGLE_STRIP = TriangleStrip
- | x == gl_TRIANGLE_FAN = TriangleFan
- | x == gl_QUADS = Quads
- | x == gl_QUAD_STRIP = QuadStrip
- | x == gl_POLYGON = Polygon
- | otherwise = error ("unmarshalPrimitiveMode: illegal value " ++ show x)
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.PrimitiveMode
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/QueryObject.hs b/Graphics/Rendering/OpenGL/GL/QueryObject.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/QueryObject.hs
@@ -0,0 +1,46 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.QueryObject
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/QueryObjects.hs b/Graphics/Rendering/OpenGL/GL/QueryObjects.hs
--- a/Graphics/Rendering/OpenGL/GL/QueryObjects.hs
+++ b/Graphics/Rendering/OpenGL/GL/QueryObjects.hs
@@ -1,166 +1,174 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.QueryObject
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.QueryObjects (
-QueryObject, QueryTarget(..), marshalQueryTarget,
-
-beginQuery, endQuery, withQuery,
-
-queryCounterBits, currentQuery,
-
-queryResult, queryResultAvailable,
--- * Conditional rendering
-ConditionalRenderMode(..),
-
-beginConditionalRender, endConditionalRender, withConditionalRender
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-newtype QueryObject = QueryObject { queryID :: GLuint }
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-instance ObjectName QueryObject where
- genObjectNames n =
- allocaArray n $ \buf -> do
- glGenQueries (fromIntegral n) buf
- fmap (map QueryObject) $ peekArray n buf
-
- deleteObjectNames queryObjects =
- withArrayLen (map queryID queryObjects) $
- glDeleteQueries . fromIntegral
-
- isObjectName = fmap unmarshalGLboolean . glIsQuery . queryID
-
---------------------------------------------------------------------------------
-
-data QueryTarget =
- SamplesPassed
- | TransformFeedbackPrimitivesWritten
- | PrimitivesGenerated
- deriving ( Eq, Ord, Show )
-
-marshalQueryTarget :: QueryTarget -> GLenum
-marshalQueryTarget x = case x of
- SamplesPassed -> gl_SAMPLES_PASSED
- TransformFeedbackPrimitivesWritten -> gl_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN
- PrimitivesGenerated -> gl_PRIMITIVES_GENERATED
-
---------------------------------------------------------------------------------
-
-beginQuery :: QueryTarget -> QueryObject -> IO ()
-beginQuery t = glBeginQuery (marshalQueryTarget t) . queryID
-
-endQuery :: QueryTarget -> IO ()
-endQuery = glEndQuery . marshalQueryTarget
-
--- | Convenience function for an exception-safe combination of 'beginQuery' and
--- 'endQuery'.
-withQuery :: QueryTarget -> QueryObject -> IO a -> IO a
-withQuery t q = bracket_ (beginQuery t q) (endQuery t)
-
---------------------------------------------------------------------------------
-
-data GetQueryPName =
- QueryCounterBits
- | CurrentQuery
-
-marshalGetQueryPName :: GetQueryPName -> GLenum
-marshalGetQueryPName x = case x of
- QueryCounterBits -> gl_QUERY_COUNTER_BITS
- CurrentQuery -> gl_CURRENT_QUERY
-
---------------------------------------------------------------------------------
-
-queryCounterBits :: QueryTarget -> GettableStateVar GLsizei
-queryCounterBits = getQueryi fromIntegral QueryCounterBits
-
-currentQuery :: QueryTarget -> GettableStateVar (Maybe QueryObject)
-currentQuery =
- getQueryi
- (\q -> if q == 0 then Nothing else Just (QueryObject (fromIntegral q)))
- CurrentQuery
-
-getQueryi :: (GLint -> a) -> GetQueryPName -> QueryTarget -> GettableStateVar a
-getQueryi f p t =
- makeGettableStateVar $
- alloca $ \buf -> do
- glGetQueryiv (marshalQueryTarget t) (marshalGetQueryPName p) buf
- peek1 f buf
-
---------------------------------------------------------------------------------
-
-data GetQueryObjectPName =
- QueryResult
- | QueryResultAvailable
-
-marshalGetQueryObjectPName :: GetQueryObjectPName -> GLenum
-marshalGetQueryObjectPName x = case x of
- QueryResult -> gl_QUERY_RESULT
- QueryResultAvailable -> gl_QUERY_RESULT_AVAILABLE
-
---------------------------------------------------------------------------------
-
-queryResult :: QueryObject -> GettableStateVar GLuint
-queryResult = getQueryObjectui id QueryResult
-
-queryResultAvailable :: QueryObject -> GettableStateVar Bool
-queryResultAvailable = getQueryObjectui unmarshalGLboolean QueryResultAvailable
-
-getQueryObjectui ::
- (GLuint -> a) -> GetQueryObjectPName -> QueryObject -> GettableStateVar a
-getQueryObjectui f p q =
- makeGettableStateVar $
- alloca $ \buf -> do
- glGetQueryObjectuiv (queryID q) (marshalGetQueryObjectPName p) buf
- peek1 f buf
-
---------------------------------------------------------------------------------
-
-data ConditionalRenderMode =
- QueryWait
- | QueryNoWait
- | QueryByRegionWait
- | QueryByRegionNoWait
-
-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 m = glBeginConditionalRender (queryID q) (marshalConditionalRenderMode m)
-
-endConditionalRender :: IO ()
-endConditionalRender = glEndConditionalRender
-
-withConditionalRender :: QueryObject -> ConditionalRenderMode -> IO a -> IO a
-withConditionalRender q m = bracket_ (beginConditionalRender q m) endConditionalRender
-
-
-
-
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.QueryObjects
+-- Copyright : (c) Sven Panne, Lars Corbijn 2004-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/QueryUtils.hs b/Graphics/Rendering/OpenGL/GL/QueryUtils.hs
--- a/Graphics/Rendering/OpenGL/GL/QueryUtils.hs
+++ b/Graphics/Rendering/OpenGL/GL/QueryUtils.hs
@@ -1,335 +1,65 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.QueryUtils
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module with utilities to query OpenGL state.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.QueryUtils (
- 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.Raw.ARB.Compatibility (
- gl_LIGHT0, gl_MODELVIEW)
-import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend (
- gl_MODELVIEW1, gl_MODELVIEW2, gl_MODELVIEW31 )
-import Graphics.Rendering.OpenGL.Raw.Core32
-
-import Graphics.Rendering.OpenGL.GL.QueryUtils.PName
-import Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib
-
---------------------------------------------------------------------------------
-
---data GetPNameO =
--- GetCurrentMatrixIndex
--- | GetPointSmooth
--- | GetPointSizeRange
--- | GetPointSizeGranularity
--- | GetLineSmooth
--- | GetLineWidthRange
--- | GetLineWidthGranularity
--- | GetLineStipple
--- | GetPolygonSmooth
--- | GetPolygonStipple
--- | GetCullFace
--- | GetLighting
--- | GetFog
--- | GetDepthTest
--- | GetStencilTest
--- | GetNormalize
--- | GetAttribStackDepth
--- | GetClientAttribStackDepth
--- | GetAlphaTest
--- | GetDither
--- | GetBlend
--- | GetIndexLogicOp
--- | GetLogicOp
--- | GetColorLogicOp
--- | GetScissorTest
--- | GetIndexMode
--- | GetTextureGenS
--- | GetTextureGenT
--- | GetTextureGenR
--- | GetTextureGenQ
--- | GetMaxClipDistances
--- | GetMaxAttribStackDepth
--- | GetMaxClientAttribStackDepth
--- | GetIndexBits
--- | GetAutoNormal
--- | GetMap1Color4
--- | GetMap1Index
--- | GetMap1Normal
--- | GetMap1TextureCoord1
--- | GetMap1TextureCoord2
--- | GetMap1TextureCoord3
--- | GetMap1TextureCoord4
--- | GetMap1Vertex3
--- | GetMap1Vertex4
--- | GetMap2Color4
--- | GetMap2Index
--- | GetMap2Normal
--- | GetMap2TextureCoord1
--- | GetMap2TextureCoord2
--- | GetMap2TextureCoord3
--- | GetMap2TextureCoord4
--- | GetMap2Vertex3
--- | GetMap2Vertex4
--- | GetTexture1D
--- | GetTexture2D
--- | GetFeedbackBufferSize
--- | GetFeedbackBufferType
--- | GetSelectionBufferSize
--- | GetPolygonOffsetPoint
--- | GetPolygonOffsetLine
--- | GetPolygonOffsetFill
--- | GetVertexArray
--- | GetNormalArray
--- | GetColorArray
--- | GetIndexArray
--- | GetTextureCoordArray
--- | GetEdgeFlagArray
--- | GetFogCoordArray
--- | GetSecondaryColorArray
--- | GetMatrixIndexArray
--- | GetMatrixIndexArraySize
--- | GetMatrixIndexArrayType
--- | GetMatrixIndexArrayStride
--- | GetClipDistance GLsizei
--- | GetLight GLsizei
--- | GetTransposeModelviewMatrix
--- | GetTransposeProjectionMatrix
--- | GetTransposeTextureMatrix
--- | GetTransposeColorMatrix
--- | GetColorTable
--- | GetPostConvolutionColorTable
--- | GetPostColorMatrixColorTable
--- | GetConvolution1D
--- | GetConvolution2D
--- | GetSeparable2D
--- | GetMaxConvolutionWidth
--- | GetMaxConvolutionHeight
--- | GetHistogram
--- | GetMinmax
--- | GetColorSum
--- | GetRescaleNormal
--- | GetSharedTexturePalette
--- | GetTexture3DBinding
--- | GetTexture3D
--- | GetMultisample
--- | GetSampleAlphaToCoverage
--- | GetSampleAlphaToOne
--- | GetSampleCoverage
--- | GetTextureCubeMap
--- | GetMaxVertexUnits
--- | GetActiveVertexUnits
--- | GetWeightSumUnity
--- | GetVertexBlend
--- | GetModelview GLsizei
--- | GetCurrentWeight
--- | GetWeightArrayType
--- | GetWeightArrayStride
--- | GetWeightArraySize
--- | GetWeightArray
--- | GetMaxPaletteMatrices
--- | GetCurrentPaletteMatrix
--- | GetCurrentMatrix
--- | GetMaxVaryingComponents
--- | GetColorMaterial
--- -- GetWeightArrayBufferBinding
--- -- transform feedback stuff
--- -- FramebufferObject
--- -- RenderbufferObject
--- -- Color clamping
--- -- VertexArrayObject
---
---_marshalGetPNameO :: GetPNameO -> Maybe GLenum
---_marshalGetPNameO x = case x of
--- GetCurrentMatrixIndex -> Just gl_CURRENT_MATRIX_INDEX
--- GetPointSmooth -> Just gl_POINT_SMOOTH
--- GetPointSizeRange -> Just gl_POINT_SIZE_RANGE
--- GetPointSizeGranularity -> Just gl_POINT_SIZE_GRANULARITY
--- GetLineSmooth -> Just gl_LINE_SMOOTH
--- GetLineWidthRange -> Just gl_SMOOTH_LINE_WIDTH_RANGE
--- GetLineWidthGranularity -> Just gl_SMOOTH_LINE_WIDTH_GRANULARITY
--- GetLineStipple -> Just gl_LINE_STIPPLE
--- GetPolygonSmooth -> Just gl_POLYGON_SMOOTH
--- GetPolygonStipple -> Just gl_POLYGON_STIPPLE
--- GetCullFace -> Just gl_CULL_FACE
--- GetLighting -> Just gl_LIGHTING
--- GetFog -> Just gl_FOG
--- GetDepthTest -> Just gl_DEPTH_TEST
--- GetStencilTest -> Just gl_STENCIL_TEST
--- GetPolygonOffsetPoint -> Just gl_POLYGON_OFFSET_POINT
--- GetNormalize -> Just gl_NORMALIZE
--- GetAttribStackDepth -> Just gl_ATTRIB_STACK_DEPTH
--- GetClientAttribStackDepth -> Just gl_CLIENT_ATTRIB_STACK_DEPTH
--- GetAlphaTest -> Just gl_ALPHA_TEST
--- GetDither -> Just gl_DITHER
--- GetBlend -> Just gl_BLEND
--- GetIndexLogicOp -> Just gl_INDEX_LOGIC_OP
--- GetLogicOp -> Just gl_INDEX_LOGIC_OP
--- GetColorLogicOp -> Just gl_COLOR_LOGIC_OP
--- GetScissorTest -> Just gl_SCISSOR_TEST
--- GetIndexMode -> Just gl_INDEX_MODE
--- GetTextureGenS -> Just gl_TEXTURE_GEN_S
--- GetTextureGenT -> Just gl_TEXTURE_GEN_T
--- GetTextureGenR -> Just gl_TEXTURE_GEN_R
--- GetTextureGenQ -> Just gl_TEXTURE_GEN_Q
--- GetMaxClipDistances -> Just gl_MAX_CLIP_DISTANCES
--- GetMaxAttribStackDepth -> Just gl_MAX_ATTRIB_STACK_DEPTH
--- GetMaxClientAttribStackDepth -> Just gl_MAX_CLIENT_ATTRIB_STACK_DEPTH
--- GetIndexBits -> Just gl_INDEX_BITS
--- GetAutoNormal -> Just gl_AUTO_NORMAL
--- GetMap1Color4 -> Just gl_MAP1_COLOR_4
--- GetMap1Index -> Just gl_MAP1_INDEX
--- GetMap1Normal -> Just gl_MAP1_NORMAL
--- GetMap1TextureCoord1 -> Just gl_MAP1_TEXTURE_COORD_1
--- GetMap1TextureCoord2 -> Just gl_MAP1_TEXTURE_COORD_2
--- GetMap1TextureCoord3 -> Just gl_MAP1_TEXTURE_COORD_3
--- GetMap1TextureCoord4 -> Just gl_MAP1_TEXTURE_COORD_4
--- GetMap1Vertex3 -> Just gl_MAP1_VERTEX_3
--- GetMap1Vertex4 -> Just gl_MAP1_VERTEX_4
--- GetMap2Color4 -> Just gl_MAP2_COLOR_4
--- GetMap2Index -> Just gl_MAP2_INDEX
--- GetMap2Normal -> Just gl_MAP2_NORMAL
--- GetMap2TextureCoord1 -> Just gl_MAP2_TEXTURE_COORD_1
--- GetMap2TextureCoord2 -> Just gl_MAP2_TEXTURE_COORD_2
--- GetMap2TextureCoord3 -> Just gl_MAP2_TEXTURE_COORD_3
--- GetMap2TextureCoord4 -> Just gl_MAP2_TEXTURE_COORD_4
--- GetMap2Vertex3 -> Just gl_MAP2_VERTEX_3
--- GetMap2Vertex4 -> Just gl_MAP2_VERTEX_4
--- GetTexture1D -> Just gl_TEXTURE_1D
--- GetTexture2D -> Just gl_TEXTURE_2D
--- GetFeedbackBufferSize -> Just gl_FEEDBACK_BUFFER_SIZE
--- GetFeedbackBufferType -> Just gl_FEEDBACK_BUFFER_TYPE
--- GetSelectionBufferSize -> Just gl_SELECTION_BUFFER_SIZE
--- GetPolygonOffsetLine -> Just gl_POLYGON_OFFSET_LINE
--- GetPolygonOffsetFill -> Just gl_POLYGON_OFFSET_FILL
--- GetVertexArray -> Just gl_VERTEX_ARRAY
--- GetNormalArray -> Just gl_NORMAL_ARRAY
--- GetColorArray -> Just gl_COLOR_ARRAY
--- GetIndexArray -> Just gl_INDEX_ARRAY
--- GetTextureCoordArray -> Just gl_TEXTURE_COORD_ARRAY
--- GetEdgeFlagArray -> Just gl_EDGE_FLAG_ARRAY
--- GetFogCoordArray -> Just gl_FOG_COORD_ARRAY
--- GetSecondaryColorArray -> Just gl_SECONDARY_COLOR_ARRAY
--- GetMatrixIndexArray -> Just gl_MATRIX_INDEX_ARRAY
--- GetMatrixIndexArraySize -> Just gl_MATRIX_INDEX_ARRAY_SIZE
--- GetMatrixIndexArrayType -> Just gl_MATRIX_INDEX_ARRAY_TYPE
--- GetMatrixIndexArrayStride -> Just gl_MATRIX_INDEX_ARRAY_STRIDE
--- GetClipDistance i -> clipPlaneIndexToEnum i
--- GetLight i -> lightIndexToEnum i
--- GetTransposeModelviewMatrix -> Just gl_TRANSPOSE_MODELVIEW_MATRIX
--- GetTransposeProjectionMatrix -> Just gl_TRANSPOSE_PROJECTION_MATRIX
--- GetTransposeTextureMatrix -> Just gl_TRANSPOSE_TEXTURE_MATRIX
--- GetTransposeColorMatrix -> Just gl_TRANSPOSE_COLOR_MATRIX
--- GetColorTable -> Just gl_COLOR_TABLE
--- GetPostConvolutionColorTable -> Just gl_POST_CONVOLUTION_COLOR_TABLE
--- GetPostColorMatrixColorTable -> Just gl_POST_COLOR_MATRIX_COLOR_TABLE
--- GetConvolution1D -> Just gl_CONVOLUTION_1D
--- GetConvolution2D -> Just gl_CONVOLUTION_2D
--- GetSeparable2D -> Just gl_SEPARABLE_2D
--- GetMaxConvolutionWidth -> Just gl_MAX_CONVOLUTION_WIDTH
--- GetMaxConvolutionHeight -> Just gl_MAX_CONVOLUTION_HEIGHT
--- GetHistogram -> Just gl_HISTOGRAM
--- GetMinmax -> Just gl_MINMAX
--- GetColorSum -> Just gl_COLOR_SUM
--- GetRescaleNormal -> Just gl_RESCALE_NORMAL
--- GetSharedTexturePalette -> Just gl_SHARED_TEXTURE_PALETTE
--- GetTexture3DBinding -> Just gl_TEXTURE_BINDING_3D
--- GetTexture3D -> Just gl_TEXTURE_3D
--- GetMultisample -> Just gl_MULTISAMPLE
--- GetSampleAlphaToCoverage -> Just gl_SAMPLE_ALPHA_TO_COVERAGE
--- GetSampleAlphaToOne -> Just gl_SAMPLE_ALPHA_TO_ONE
--- GetSampleCoverage -> Just gl_SAMPLE_COVERAGE
--- GetColorMaterial -> Just gl_COLOR_MATERIAL
--- GetTextureCubeMap -> Just gl_TEXTURE_CUBE_MAP
---
--- GetMaxVertexUnits -> Just gl_MAX_VERTEX_UNITS
--- GetActiveVertexUnits -> Just gl_ACTIVE_VERTEX_UNITS
--- GetWeightSumUnity -> Just gl_WEIGHT_SUM_UNITY
--- GetVertexBlend -> Just gl_VERTEX_BLEND
--- GetModelview i -> modelviewIndexToEnum i
--- GetCurrentWeight -> Just gl_CURRENT_WEIGHT
--- GetWeightArrayType -> Just gl_WEIGHT_ARRAY_TYPE
--- GetWeightArrayStride -> Just gl_WEIGHT_ARRAY_STRIDE
--- GetWeightArraySize -> Just gl_WEIGHT_ARRAY_SIZE
--- GetWeightArray -> Just gl_WEIGHT_ARRAY
--- GetMaxPaletteMatrices -> Just gl_MAX_PALETTE_MATRICES
--- GetCurrentPaletteMatrix -> Just gl_CURRENT_PALETTE_MATRIX
--- GetCurrentMatrix -> Just gl_CURRENT_MATRIX
--- GetMaxVaryingComponents -> Just gl_MAX_VARYING_COMPONENTS
-
- -- GetWeightArrayBufferBinding -> Just gl_WEIGHT_ARRAY_BUFFER_BINDING
- -- transform feedback
- -- FramebufferObject
- -- RenderbufferObject
- -- Color clamping
- -- VertexArrayObject
-
---------------------------------------------------------------------------------
-
---data GetIndexedPName =
--- GetTransformFeedbackBuffer
--- | GetTransformFeedbackBufferStart
--- | GetTransformFeedbackBufferSize
---
---marshalGetIndexedPName :: GetIndexedPName -> GLenum
---marshalGetIndexedPName x = case x of
--- GetTransformFeedbackBuffer -> gl_TRANSFORM_FEEDBACK_BUFFER
--- GetTransformFeedbackBufferSize -> gl_TRANSFORM_FEEDBACK_BUFFER_SIZE
--- GetTransformFeedbackBufferStart -> gl_TRANSFORM_FEEDBACK_BUFFER_START
-
---------------------------------------------------------------------------------
-
--- 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs b/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs
--- a/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs
+++ b/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs
@@ -1,1159 +1,1157 @@
--- #hide
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.QueryUtils.PName
--- Copyright : (c) Sven Panne 2002-2009, Lars Corbijn 2012
--- License : BSD3
---
--- Maintainer : Jason Dagit , Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-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.ARB.Compatibility (
- gl_ACCUM_ALPHA_BITS, gl_ACCUM_BLUE_BITS, gl_ACCUM_CLEAR_VALUE,
- gl_ACCUM_GREEN_BITS, gl_ACCUM_RED_BITS, gl_ALIASED_POINT_SIZE_RANGE,
- gl_ALPHA_BIAS, gl_ALPHA_BITS, gl_ALPHA_SCALE,
- gl_ALPHA_TEST_FUNC, gl_ALPHA_TEST_REF,
- gl_AUX_BUFFERS, gl_BLUE_BIAS, gl_BLUE_BITS, gl_BLUE_SCALE,
- gl_CLAMP_FRAGMENT_COLOR, gl_CLAMP_VERTEX_COLOR,
- gl_CLIENT_ACTIVE_TEXTURE,
- gl_COLOR_ARRAY_BUFFER_BINDING, gl_COLOR_ARRAY_SIZE, gl_COLOR_ARRAY_STRIDE,
- gl_COLOR_ARRAY_TYPE, gl_COLOR_MATERIAL_FACE,
- gl_COLOR_MATERIAL_PARAMETER, gl_COLOR_MATRIX, gl_COLOR_MATRIX_STACK_DEPTH,
- gl_CURRENT_COLOR, gl_CURRENT_FOG_COORD, gl_CURRENT_INDEX, gl_CURRENT_NORMAL,
- gl_CURRENT_RASTER_COLOR, gl_CURRENT_RASTER_DISTANCE, gl_CURRENT_RASTER_INDEX,
- gl_CURRENT_RASTER_POSITION, gl_CURRENT_RASTER_POSITION_VALID,
- gl_CURRENT_RASTER_SECONDARY_COLOR, gl_CURRENT_RASTER_TEXTURE_COORDS,
- gl_CURRENT_SECONDARY_COLOR, gl_CURRENT_TEXTURE_COORDS, gl_DEPTH_BIAS,
- gl_DEPTH_BITS, gl_DEPTH_SCALE, gl_EDGE_FLAG,
- gl_EDGE_FLAG_ARRAY_BUFFER_BINDING, gl_EDGE_FLAG_ARRAY_STRIDE,
- gl_FOG_COLOR, gl_FOG_COORD_ARRAY_BUFFER_BINDING,
- gl_FOG_COORD_ARRAY_STRIDE, gl_FOG_COORD_ARRAY_TYPE, gl_FOG_COORD_SRC,
- gl_FOG_DENSITY, gl_FOG_END, gl_FOG_HINT, gl_FOG_INDEX, gl_FOG_MODE,
- gl_FOG_START, gl_GENERATE_MIPMAP_HINT, gl_GREEN_BIAS, gl_GREEN_BITS,
- gl_GREEN_SCALE, gl_INDEX_ARRAY_BUFFER_BINDING,
- gl_INDEX_ARRAY_STRIDE, gl_INDEX_ARRAY_TYPE,
- gl_INDEX_CLEAR_VALUE, gl_INDEX_OFFSET,
- gl_INDEX_SHIFT, gl_INDEX_WRITEMASK,
- gl_LIGHT_MODEL_AMBIENT, gl_LIGHT_MODEL_COLOR_CONTROL,
- gl_LIGHT_MODEL_LOCAL_VIEWER, gl_LIGHT_MODEL_TWO_SIDE,
- gl_LINE_STIPPLE_PATTERN, gl_LINE_STIPPLE_REPEAT, gl_LIST_BASE, gl_LIST_INDEX,
- gl_LIST_MODE, gl_MAP1_GRID_DOMAIN, gl_MAP1_GRID_SEGMENTS,
- gl_MAP2_GRID_DOMAIN, gl_MAP2_GRID_SEGMENTS, gl_MAP_COLOR,
- gl_MAP_STENCIL, gl_MATRIX_MODE, gl_MAX_COLOR_MATRIX_STACK_DEPTH,
- gl_MAX_EVAL_ORDER,
- gl_MAX_LIGHTS, gl_MAX_LIST_NESTING, gl_MAX_MODELVIEW_STACK_DEPTH,
- gl_MAX_NAME_STACK_DEPTH, gl_MAX_PIXEL_MAP_TABLE,
- gl_MAX_PROJECTION_STACK_DEPTH, gl_MAX_TEXTURE_COORDS,
- gl_MAX_TEXTURE_STACK_DEPTH, gl_MAX_TEXTURE_UNITS,
- gl_MODELVIEW_MATRIX, gl_MODELVIEW_STACK_DEPTH, gl_NAME_STACK_DEPTH,
- gl_NORMAL_ARRAY_BUFFER_BINDING,
- gl_NORMAL_ARRAY_STRIDE, gl_NORMAL_ARRAY_TYPE, gl_PERSPECTIVE_CORRECTION_HINT,
- gl_PIXEL_MAP_A_TO_A_SIZE, gl_PIXEL_MAP_B_TO_B_SIZE, gl_PIXEL_MAP_G_TO_G_SIZE,
- gl_PIXEL_MAP_I_TO_A_SIZE, gl_PIXEL_MAP_I_TO_B_SIZE, gl_PIXEL_MAP_I_TO_G_SIZE,
- gl_PIXEL_MAP_I_TO_I_SIZE, gl_PIXEL_MAP_I_TO_R_SIZE, gl_PIXEL_MAP_R_TO_R_SIZE,
- gl_PIXEL_MAP_S_TO_S_SIZE, gl_POINT_DISTANCE_ATTENUATION, gl_POINT_SIZE_MAX,
- gl_POINT_SIZE_MIN, gl_POINT_SMOOTH_HINT, gl_POLYGON_MODE,
- gl_POST_COLOR_MATRIX_ALPHA_BIAS, gl_POST_COLOR_MATRIX_ALPHA_SCALE,
- gl_POST_COLOR_MATRIX_BLUE_BIAS, gl_POST_COLOR_MATRIX_BLUE_SCALE,
- gl_POST_COLOR_MATRIX_GREEN_BIAS, gl_POST_COLOR_MATRIX_GREEN_SCALE,
- gl_POST_COLOR_MATRIX_RED_BIAS, gl_POST_COLOR_MATRIX_RED_SCALE,
- gl_POST_CONVOLUTION_ALPHA_BIAS, gl_POST_CONVOLUTION_ALPHA_SCALE,
- gl_POST_CONVOLUTION_BLUE_BIAS, gl_POST_CONVOLUTION_BLUE_SCALE,
- gl_POST_CONVOLUTION_GREEN_BIAS,
- gl_POST_CONVOLUTION_GREEN_SCALE, gl_POST_CONVOLUTION_RED_BIAS,
- gl_POST_CONVOLUTION_RED_SCALE, gl_PROJECTION_MATRIX,
- gl_PROJECTION_STACK_DEPTH, gl_RED_BIAS, gl_RED_BITS, gl_RED_SCALE,
- gl_RENDER_MODE, gl_RGBA_MODE,
- gl_SECONDARY_COLOR_ARRAY_BUFFER_BINDING, gl_SECONDARY_COLOR_ARRAY_SIZE,
- gl_SECONDARY_COLOR_ARRAY_STRIDE, gl_SECONDARY_COLOR_ARRAY_TYPE,
- gl_SHADE_MODEL, gl_STENCIL_BITS,
- gl_TEXTURE_COORD_ARRAY_BUFFER_BINDING,
- gl_TEXTURE_COORD_ARRAY_SIZE, gl_TEXTURE_COORD_ARRAY_STRIDE,
- gl_TEXTURE_COORD_ARRAY_TYPE, gl_TEXTURE_MATRIX,
- gl_TEXTURE_STACK_DEPTH, gl_VERTEX_ARRAY_BUFFER_BINDING,
- gl_VERTEX_ARRAY_SIZE, gl_VERTEX_ARRAY_STRIDE, gl_VERTEX_ARRAY_TYPE,
- gl_ZOOM_X, gl_ZOOM_Y )
-import Graphics.Rendering.OpenGL.Raw.ARB.FragmentProgram (
- gl_CURRENT_MATRIX_STACK_DEPTH )
-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette (
- gl_MATRIX_PALETTE, gl_MAX_MATRIX_PALETTE_STACK_DEPTH)
-import Graphics.Rendering.OpenGL.Raw.Core32
-import Graphics.Rendering.OpenGL.Raw.EXT ( gl_RGBA_SIGNED_COMPONENTS )
-import Graphics.Rendering.OpenGL.Raw.EXT.Cmyka ( gl_PACK_CMYK_HINT, gl_UNPACK_CMYK_HINT )
-import Graphics.Rendering.OpenGL.Raw.EXT.CompiledVertexArray ( gl_ARRAY_ELEMENT_LOCK_FIRST, gl_ARRAY_ELEMENT_LOCK_COUNT )
-import Graphics.Rendering.OpenGL.Raw.EXT.DepthBoundsTest ( gl_DEPTH_BOUNDS, )
-import Graphics.Rendering.OpenGL.Raw.EXT.StencilTwoSide ( gl_ACTIVE_STENCIL_FACE )
-import Graphics.Rendering.OpenGL.Raw.EXT.TextureFilterAnisotropic ( gl_MAX_TEXTURE_MAX_ANISOTROPY )
-import Graphics.Rendering.OpenGL.Raw.NV.FogDistance ( gl_FOG_DISTANCE_MODE )
-import Graphics.Rendering.OpenGL.Raw.NV.LightMaxExponent ( gl_MAX_SHININESS, gl_MAX_SPOT_EXPONENT )
-import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart ( gl_PRIMITIVE_RESTART_INDEX_NV, gl_PRIMITIVE_RESTART_NV )
-
------------------------------------------------------------------------------
-
-class GetPName p where
- marshalGetPName :: p -> Maybe GLenum
-
------------------------------------------------------------------------------
-
-getIntegerv :: GetPName p => p -> Ptr GLint -> IO ()
-getIntegerv = maybe (const recordInvalidEnum) glGetIntegerv . marshalGetPName
-
-getFloatv :: GetPName p => p -> Ptr GLfloat -> IO ()
-getFloatv = maybe (const recordInvalidEnum) glGetFloatv . marshalGetPName
-
-getDoublev :: GetPName p => p -> Ptr GLdouble -> IO ()
-getDoublev = maybe (const recordInvalidEnum) glGetDoublev . marshalGetPName
-
-getBooleanv :: GetPName p => p-> Ptr GLboolean -> IO ()
-getBooleanv = makeGetter glGetBooleanv
-
-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 = maybe (\_ _ -> recordInvalidEnum) glGetIntegeri_v . marshalGetPName
-
-{-# 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
-
-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
- getIntegerN :: (GLint -> a) -> p -> Int -> IO [a]
- getIntegerN f p n = allocaArray n $ \buf -> do
- getIntegerv p buf
- (map f) `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
- | GetElementArrayBufferBinding -- ^ int
- | GetCopyReadBuffer -- ^ int
- | GetCopyWriteBuffer -- ^ int
- | GetPixelPackBufferBinding -- ^ int
- | GetPixelUnpackBufferBinding -- ^ int
- | GetTransformFeedbackBufferBinding -- ^ 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
- -- ReadCopyPixels
- | GetReadBuffer -- ^ enum
- -- Texture Objects
- | GetTextureBinding1D -- ^ int\/enum
- | GetTextureBinding2D -- ^ int\/enum
- | GetTextureBinding3D -- ^ int\/enum
- | GetTextureBindingCubeMap -- ^ int\/enum
- | GetTextureBindingRectangle -- ^ int\/enum
- -- Antialiasing
- | GetSubpixelBits -- ^ sizei
- | GetSamples -- ^ sizei
- | GetSampleBuffers -- ^ sizei
-
-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
- GetElementArrayBufferBinding -> Just gl_ELEMENT_ARRAY_BUFFER_BINDING
- GetCopyReadBuffer -> Just gl_COPY_READ_BUFFER
- GetCopyWriteBuffer -> Just gl_COPY_WRITE_BUFFER
- GetPixelPackBufferBinding -> Just gl_PIXEL_PACK_BUFFER_BINDING
- GetPixelUnpackBufferBinding -> Just gl_PIXEL_UNPACK_BUFFER_BINDING
- GetTransformFeedbackBufferBinding -> Just gl_TRANSFORM_FEEDBACK_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
- -- 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
- GetTextureBindingCubeMap -> Just gl_TEXTURE_BINDING_CUBE_MAP
- GetTextureBindingRectangle -> Just gl_TEXTURE_BINDING_RECTANGLE
- -- Antialiasing
- GetSubpixelBits -> Just gl_SUBPIXEL_BITS
- GetSampleBuffers -> Just gl_SAMPLE_BUFFERS
- GetSamples -> Just gl_SAMPLES
-
-
--- 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
- -- clipping
- | GetClipPlane GLsizei -- ^ double
- -- 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
- -- clipping
- GetClipPlane i -> clipPlaneIndexToEnum i
- -- 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
-
-instance GetPNameNI PNameNI where
-instance GetPName PNameNI where
- marshalGetPName pn = case pn of
- GetCompressedTextureFormats -> Just gl_COMPRESSED_TEXTURE_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 , Jason Dagit
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs b/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs
--- a/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs
+++ b/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs
@@ -1,97 +1,97 @@
--- #hide
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib
--- Copyright :
--- License : BSD3
---
--- Maintainer : Jason Dagit , Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-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.Core32
-
-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 , Jason Dagit
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/RasterPos.hs b/Graphics/Rendering/OpenGL/GL/RasterPos.hs
--- a/Graphics/Rendering/OpenGL/GL/RasterPos.hs
+++ b/Graphics/Rendering/OpenGL/GL/RasterPos.hs
@@ -1,196 +1,187 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.RasterPos
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.13 (Current Raster Position) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-{-# 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glRasterPos2d, glRasterPos2dv, glRasterPos2f, glRasterPos2fv, glRasterPos2i,
- glRasterPos2iv, glRasterPos2s, glRasterPos2sv, glRasterPos3d, glRasterPos3dv,
- glRasterPos3f, glRasterPos3fv, glRasterPos3i, glRasterPos3iv, glRasterPos3s,
- glRasterPos3sv, glRasterPos4d, glRasterPos4dv, glRasterPos4f, glRasterPos4fv,
- glRasterPos4i, glRasterPos4iv, glRasterPos4s, glRasterPos4sv, glWindowPos2d,
- glWindowPos2dv, glWindowPos2f, glWindowPos2fv, glWindowPos2i, glWindowPos2iv,
- glWindowPos2s, glWindowPos2sv, glWindowPos3d, glWindowPos3dv, glWindowPos3f,
- glWindowPos3fv, glWindowPos3i, glWindowPos3iv, glWindowPos3s, glWindowPos3sv )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-currentRasterPosition :: StateVar (Vertex4 GLfloat)
-currentRasterPosition =
- makeStateVar (getFloat4 Vertex4 GetCurrentRasterPosition) rasterPos
-
---------------------------------------------------------------------------------
-
-class RasterPosComponent a where
- rasterPos2 :: a -> a -> IO ()
- rasterPos3 :: a -> a -> a -> IO ()
- rasterPos4 :: a -> a -> a -> a -> IO ()
-
- rasterPos2v :: Ptr a -> IO ()
- rasterPos3v :: Ptr a -> IO ()
- rasterPos4v :: Ptr a -> IO ()
-
-instance RasterPosComponent GLshort where
- rasterPos2 = glRasterPos2s
- rasterPos3 = glRasterPos3s
- rasterPos4 = glRasterPos4s
-
- rasterPos2v = glRasterPos2sv
- rasterPos3v = glRasterPos3sv
- rasterPos4v = glRasterPos4sv
-
-instance RasterPosComponent GLint where
- rasterPos2 = glRasterPos2i
- rasterPos3 = glRasterPos3i
- rasterPos4 = glRasterPos4i
-
- rasterPos2v = glRasterPos2iv
- rasterPos3v = glRasterPos3iv
- rasterPos4v = glRasterPos4iv
-
-instance RasterPosComponent GLfloat where
- rasterPos2 = glRasterPos2f
- rasterPos3 = glRasterPos3f
- rasterPos4 = glRasterPos4f
-
- rasterPos2v = glRasterPos2fv
- rasterPos3v = glRasterPos3fv
- rasterPos4v = glRasterPos4fv
-
-instance RasterPosComponent GLdouble where
- rasterPos2 = glRasterPos2d
- rasterPos3 = glRasterPos3d
- rasterPos4 = glRasterPos4d
-
- rasterPos2v = glRasterPos2dv
- rasterPos3v = glRasterPos3dv
- rasterPos4v = glRasterPos4dv
-
---------------------------------------------------------------------------------
-
-class RasterPos a where
- rasterPos :: a -> IO ()
- rasterPosv :: Ptr a -> IO ()
-
-instance RasterPosComponent a => RasterPos (Vertex2 a) where
- rasterPos (Vertex2 x y) = rasterPos2 x y
- rasterPosv = rasterPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)
-
-instance RasterPosComponent a => RasterPos (Vertex3 a) where
- rasterPos (Vertex3 x y z) = rasterPos3 x y z
- rasterPosv = rasterPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
-
-instance RasterPosComponent a => RasterPos (Vertex4 a) where
- rasterPos (Vertex4 x y z w) = rasterPos4 x y z w
- rasterPosv = rasterPos4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)
-
---------------------------------------------------------------------------------
-
-class WindowPosComponent a where
- windowPos2 :: a -> a -> IO ()
- windowPos3 :: a -> a -> a -> IO ()
-
- windowPos2v :: Ptr a -> IO ()
- windowPos3v :: Ptr a -> IO ()
-
-instance WindowPosComponent GLshort where
- windowPos2 = glWindowPos2s
- windowPos3 = glWindowPos3s
-
- windowPos2v = glWindowPos2sv
- windowPos3v = glWindowPos3sv
-
-instance WindowPosComponent GLint where
- windowPos2 = glWindowPos2i
- windowPos3 = glWindowPos3i
-
- windowPos2v = glWindowPos2iv
- windowPos3v = glWindowPos3iv
-
-instance WindowPosComponent GLfloat where
- windowPos2 = glWindowPos2f
- windowPos3 = glWindowPos3f
-
- windowPos2v = glWindowPos2fv
- windowPos3v = glWindowPos3fv
-
-instance WindowPosComponent GLdouble where
- windowPos2 = glWindowPos2d
- windowPos3 = glWindowPos3d
-
- windowPos2v = glWindowPos2dv
- windowPos3v = glWindowPos3dv
-
---------------------------------------------------------------------------------
-
-class WindowPos a where
- windowPos :: a -> IO ()
- windowPosv :: Ptr a -> IO ()
-
-instance WindowPosComponent a => WindowPos (Vertex2 a) where
- windowPos (Vertex2 x y) = windowPos2 x y
- windowPosv = windowPos2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)
-
-instance WindowPosComponent a => WindowPos (Vertex3 a) where
- windowPos (Vertex3 x y z) = windowPos3 x y z
- windowPosv = windowPos3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
-
---------------------------------------------------------------------------------
-
-currentRasterDistance :: GettableStateVar GLfloat
-currentRasterDistance =
- makeGettableStateVar (getFloat1 id GetCurrentRasterDistance)
-
-currentRasterColor :: GettableStateVar (Color4 GLfloat)
-currentRasterColor =
- makeGettableStateVar (getFloat4 Color4 GetCurrentRasterColor)
-
-currentRasterSecondaryColor :: GettableStateVar (Color4 GLfloat)
-currentRasterSecondaryColor =
- makeGettableStateVar (getFloat4 Color4 GetCurrentRasterSecondaryColor)
-
-currentRasterIndex :: GettableStateVar (Index1 GLint)
-currentRasterIndex =
- makeGettableStateVar (getInteger1 Index1 GetCurrentRasterIndex)
-
-currentRasterTexCoords :: GettableStateVar (TexCoord4 GLfloat)
-currentRasterTexCoords =
- makeGettableStateVar (getFloat4 TexCoord4 GetCurrentRasterTextureCoords)
-
-currentRasterPositionValid :: GettableStateVar Bool
-currentRasterPositionValid =
- makeGettableStateVar
- (getBoolean1 unmarshalGLboolean GetCurrentRasterPositionValid)
-
---------------------------------------------------------------------------------
-
-rasterPositionUnclipped :: StateVar Capability
-rasterPositionUnclipped = makeCapability CapRasterPositionUnclipped
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.RasterPos
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs b/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs
--- a/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs
+++ b/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs
@@ -1,92 +1,103 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.ReadCopyPixels
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 4.3 (Drawing, Reading, and Copying Pixels)
--- of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.ReadCopyPixels (
- -- * Reading Pixels
- readPixels, readBuffer,
-
- -- * Copying Pixels
- PixelCopyType(..), copyPixels,
-
- -- * Copying Pixels for framebuffers
- BlitFramebufferMask(..), blitFramebuffer
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.BufferMode
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.Parameters
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( glCopyPixels )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-readPixels :: Position -> Size -> PixelData a -> IO ()
-readPixels (Position x y) (Size w h) pd =
- withPixelData pd $ glReadPixels x y w h
-
---------------------------------------------------------------------------------
-
-readBuffer :: StateVar BufferMode
-readBuffer =
- makeStateVar
- (getEnum1 unmarshalBufferMode GetReadBuffer)
- (maybe recordInvalidValue glReadBuffer . marshalBufferMode)
-
---------------------------------------------------------------------------------
-
-data PixelCopyType =
- CopyColor
- | CopyDepth
- | CopyStencil
- deriving ( Eq, Ord, Show )
-
-marshalPixelCopyType :: PixelCopyType -> GLenum
-marshalPixelCopyType x = case x of
- CopyColor -> gl_COLOR
- CopyDepth -> gl_DEPTH
- CopyStencil -> gl_STENCIL
-
---------------------------------------------------------------------------------
-
-copyPixels :: Position -> Size -> PixelCopyType -> IO ()
-copyPixels (Position x y) (Size w h) t =
- glCopyPixels x y w h (marshalPixelCopyType t)
-
---------------------------------------------------------------------------------
-
-data BlitFramebufferMask
- = BlitColorBuffer
- | BlitStencilBuffer
- | BlitDepthBuffer
-
-marshalBlitFramebufferMask :: [BlitFramebufferMask] -> GLbitfield
-marshalBlitFramebufferMask = fromIntegral . sum . map marshal
- where marshal x = case x of
- BlitColorBuffer -> gl_COLOR_BUFFER_BIT
- BlitStencilBuffer -> gl_STENCIL_BUFFER_BIT
- BlitDepthBuffer -> gl_DEPTH_BUFFER_BIT
-
-blitFramebuffer :: Position -> Position -> Position -> Position -> [BlitFramebufferMask]
- -> TextureFilter -> IO ()
-blitFramebuffer (Position sx0 sy0) (Position sx1 sy1) (Position dx0 dy0) (Position dx1 dy1)
- bfbm filt = glBlitFramebuffer sx0 sy0 sx1 sy1 dx0 dy0 dx1 dy1
- (marshalBlitFramebufferMask bfbm) (marshalTextureFilter filt)
- where marshalTextureFilter x = case x of
- Nearest -> gl_NEAREST
- Linear' -> gl_LINEAR
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.ReadCopyPixels
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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))
diff --git a/Graphics/Rendering/OpenGL/GL/Rectangles.hs b/Graphics/Rendering/OpenGL/GL/Rectangles.hs
--- a/Graphics/Rendering/OpenGL/GL/Rectangles.hs
+++ b/Graphics/Rendering/OpenGL/GL/Rectangles.hs
@@ -1,67 +1,65 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Rectangles
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.10 (Rectangles) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-{-# LANGUAGE TypeSynonymInstances #-}
-
-module Graphics.Rendering.OpenGL.GL.Rectangles (
- Rect(..)
-) where
-
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glRectd, glRectdv, glRectf, glRectfv, glRecti, glRectiv, glRects, glRectsv )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | 'rect' and 'rectv' support efficient specification of rectangles as two
--- corner points. Each rectangle command takes four arguments, organized either
--- as two consecutive pairs of (/x/, /y/) coordinates, or as two pointers to
--- arrays, each containing an (/x/, /y/) pair. The resulting rectangle is
--- defined in the /z/ = 0 plane.
---
--- @'rect' ('Vertex2' x1 y1) ('Vertex2' x2, y2)@ is exactly equivalent to the
--- following sequence:
---
--- @
--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive' 'Graphics.Rendering.OpenGL.GL.BeginEnd.Polygon' $ do
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y1)
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y1)
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x2 y2)
--- 'Graphics.Rendering.OpenGL.GL.VertexSpec.vertex' ('Vertex2' x1 y2)
--- @
---
--- Note that if the second vertex is above and to the right of the first vertex,
--- the rectangle is constructed with a counterclockwise winding.
-
-class Rect a where
- rect :: Vertex2 a -> Vertex2 a -> IO ()
- rectv :: Ptr a -> Ptr a -> IO ()
-
-instance Rect GLshort where
- rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRects x1 y1 x2 y2
- rectv ptr1 ptr2 = glRectsv ptr1 ptr2
-
-instance Rect GLint where
- rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRecti x1 y1 x2 y2
- rectv ptr1 ptr2 = glRectiv ptr1 ptr2
-
-instance Rect GLfloat where
- rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectf x1 y1 x2 y2
- rectv ptr1 ptr2 = glRectfv ptr1 ptr2
-
-instance Rect GLdouble where
- rect (Vertex2 x1 y1) (Vertex2 x2 y2) = glRectd x1 y1 x2 y2
- rectv ptr1 ptr2 = glRectdv ptr1 ptr2
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Rectangles
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/RenderMode.hs b/Graphics/Rendering/OpenGL/GL/RenderMode.hs
--- a/Graphics/Rendering/OpenGL/GL/RenderMode.hs
+++ b/Graphics/Rendering/OpenGL/GL/RenderMode.hs
@@ -1,62 +1,60 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.RenderMode
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module related to the current render mode.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.RenderMode (
- RenderMode(..), withRenderMode, renderMode
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glRenderMode, gl_FEEDBACK, gl_RENDER, gl_SELECT )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data RenderMode =
- Render
- | Feedback
- | Select
- deriving ( Eq, Ord, Show )
-
-marshalRenderMode :: RenderMode -> GLenum
-marshalRenderMode x = case x of
- Render -> gl_RENDER
- Feedback -> gl_FEEDBACK
- Select -> gl_SELECT
-
-unmarshalRenderMode :: GLenum -> RenderMode
-unmarshalRenderMode x
- | x == gl_RENDER = Render
- | x == gl_FEEDBACK = Feedback
- | x == gl_SELECT = Select
- | otherwise = error ("unmarshalRenderMode: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-withRenderMode :: RenderMode -> IO a -> IO (a, GLint)
-withRenderMode newMode action = do
- oldMode <- get renderMode
- _ <- setRenderMode newMode
- action `finallyRet` setRenderMode oldMode
-
-setRenderMode :: RenderMode -> IO GLint
-setRenderMode = glRenderMode . marshalRenderMode
-
---------------------------------------------------------------------------------
-
-renderMode :: GettableStateVar RenderMode
-renderMode = makeGettableStateVar $ getEnum1 unmarshalRenderMode GetRenderMode
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.RenderMode
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/SavingState.hs b/Graphics/Rendering/OpenGL/GL/SavingState.hs
--- a/Graphics/Rendering/OpenGL/GL/SavingState.hs
+++ b/Graphics/Rendering/OpenGL/GL/SavingState.hs
@@ -1,114 +1,105 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.SavingState
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 6.1.14 (Saving and Restoring State) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.SavingState (
- ServerAttributeGroup(..), preservingAttrib,
- ClientAttributeGroup(..), preservingClientAttrib
-) where
-
-import Graphics.Rendering.OpenGL.GL.Exception ( bracket_ )
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glPopAttrib, glPopClientAttrib, glPushAttrib, glPushClientAttrib,
- gl_ACCUM_BUFFER_BIT, gl_ALL_ATTRIB_BITS, gl_CLIENT_ALL_ATTRIB_BITS,
- gl_CLIENT_PIXEL_STORE_BIT, gl_CLIENT_VERTEX_ARRAY_BIT,
- gl_CURRENT_BIT, gl_ENABLE_BIT, gl_EVAL_BIT, gl_FOG_BIT,
- gl_HINT_BIT, gl_LIGHTING_BIT, gl_LINE_BIT, gl_LIST_BIT,
- gl_MULTISAMPLE_BIT, gl_PIXEL_MODE_BIT, gl_POINT_BIT,
- gl_POLYGON_BIT, gl_POLYGON_STIPPLE_BIT, gl_SCISSOR_BIT,
- gl_TEXTURE_BIT, gl_TRANSFORM_BIT, gl_VIEWPORT_BIT )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data ServerAttributeGroup =
- CurrentAttributes
- | PointAttributes
- | LineAttributes
- | PolygonAttributes
- | PolygonStippleAttributes
- | PixelModeAttributes
- | LightingAttributes
- | FogAttributes
- | DepthBufferAttributes
- | AccumBufferAttributes
- | StencilBufferAttributes
- | ViewportAttributes
- | TransformAttributes
- | EnableAttributes
- | ColorBufferAttributes
- | HintAttributes
- | EvalAttributes
- | ListAttributes
- | TextureAttributes
- | ScissorAttributes
- | MultisampleAttributes
- | AllServerAttributes
- deriving ( Eq, Ord, Show )
-
-marshalServerAttributeGroup :: ServerAttributeGroup -> GLbitfield
-marshalServerAttributeGroup x = fromIntegral $ case x of
- CurrentAttributes -> gl_CURRENT_BIT
- PointAttributes -> gl_POINT_BIT
- LineAttributes -> gl_LINE_BIT
- PolygonAttributes -> gl_POLYGON_BIT
- PolygonStippleAttributes -> gl_POLYGON_STIPPLE_BIT
- PixelModeAttributes -> gl_PIXEL_MODE_BIT
- LightingAttributes -> gl_LIGHTING_BIT
- FogAttributes -> gl_FOG_BIT
- DepthBufferAttributes -> gl_DEPTH_BUFFER_BIT
- AccumBufferAttributes -> gl_ACCUM_BUFFER_BIT
- StencilBufferAttributes -> gl_STENCIL_BUFFER_BIT
- ViewportAttributes -> gl_VIEWPORT_BIT
- TransformAttributes -> gl_TRANSFORM_BIT
- EnableAttributes -> gl_ENABLE_BIT
- ColorBufferAttributes -> gl_COLOR_BUFFER_BIT
- HintAttributes -> gl_HINT_BIT
- EvalAttributes -> gl_EVAL_BIT
- ListAttributes -> gl_LIST_BIT
- TextureAttributes -> gl_TEXTURE_BIT
- ScissorAttributes -> gl_SCISSOR_BIT
- MultisampleAttributes -> gl_MULTISAMPLE_BIT
- AllServerAttributes -> gl_ALL_ATTRIB_BITS
-
---------------------------------------------------------------------------------
-
-preservingAttrib :: [ServerAttributeGroup] -> IO a -> IO a
-preservingAttrib groups = bracket_ (pushAttrib groups) glPopAttrib
-
-pushAttrib :: [ServerAttributeGroup] -> IO ()
-pushAttrib = glPushAttrib . sum . map marshalServerAttributeGroup
-
---------------------------------------------------------------------------------
-
-data ClientAttributeGroup =
- PixelStoreAttributes
- | VertexArrayAttributes
- | AllClientAttributes
- deriving ( Eq, Ord, Show )
-
-marshalClientAttributeGroup :: ClientAttributeGroup -> GLbitfield
-marshalClientAttributeGroup x = fromIntegral $ case x of
- PixelStoreAttributes -> gl_CLIENT_PIXEL_STORE_BIT
- VertexArrayAttributes -> gl_CLIENT_VERTEX_ARRAY_BIT
- AllClientAttributes -> gl_CLIENT_ALL_ATTRIB_BITS
-
---------------------------------------------------------------------------------
-
-preservingClientAttrib :: [ClientAttributeGroup] -> IO a -> IO a
-preservingClientAttrib groups =
- bracket_ (pushClientAttrib groups) glPopClientAttrib
-
-pushClientAttrib :: [ClientAttributeGroup] -> IO ()
-pushClientAttrib = glPushClientAttrib . sum . map marshalClientAttributeGroup
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.SavingState
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Selection.hs b/Graphics/Rendering/OpenGL/GL/Selection.hs
--- a/Graphics/Rendering/OpenGL/GL/Selection.hs
+++ b/Graphics/Rendering/OpenGL/GL/Selection.hs
@@ -1,90 +1,88 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Selection
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 5.2 (Selection) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Selection (
- HitRecord(..), getHitRecords,
- Name(..), withName, loadName, maxNameStackDepth, nameStackDepth,
- RenderMode(..), renderMode
-) where
-
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Exception
-import Graphics.Rendering.OpenGL.GL.IOState
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.RenderMode
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glSelectBuffer, glInitNames, glPushName, glPopName, glLoadName )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data HitRecord = HitRecord GLfloat GLfloat [Name]
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-getHitRecords :: GLsizei -> IO a -> IO (a, Maybe [HitRecord])
-getHitRecords bufSize action =
- allocaArray (fromIntegral bufSize) $ \buf -> do
- glSelectBuffer bufSize buf
- (value, numHits) <- withRenderMode Select $ do
- glInitNames
- action
- hits <- parseSelectionBuffer numHits buf
- return (value, hits)
-
---------------------------------------------------------------------------------
-
-parseSelectionBuffer :: GLint -> Ptr GLuint -> IO (Maybe [HitRecord])
-parseSelectionBuffer numHits buf
- | numHits < 0 = return Nothing
- | otherwise = fmap Just $ evalIOState (nTimes numHits parseSelectionHit) buf
-
-type Parser a = IOState GLuint a
-
-parseSelectionHit :: Parser HitRecord
-parseSelectionHit = do
- numNames <- parseGLuint
- minZ <- parseGLfloat
- maxZ <- parseGLfloat
- nameStack <- nTimes numNames parseName
- return $ HitRecord minZ maxZ nameStack
-
-parseGLuint :: Parser GLuint
-parseGLuint = peekIOState
-
-parseGLfloat :: Parser GLfloat
-parseGLfloat = fmap (\x -> fromIntegral x / 0xffffffff) parseGLuint
-
-parseName :: Parser Name
-parseName = fmap Name parseGLuint
-
---------------------------------------------------------------------------------
-
-newtype Name = Name GLuint
- deriving ( Eq, Ord, Show )
-
-withName :: Name -> IO a -> IO a
-withName (Name name) = bracket_ (glPushName name) glPopName
-
-loadName :: Name -> IO ()
-loadName (Name n) = glLoadName n
-
-maxNameStackDepth :: GettableStateVar GLsizei
-maxNameStackDepth = makeGettableStateVar (getSizei1 id GetMaxNameStackDepth)
-
-nameStackDepth :: GettableStateVar GLsizei
-nameStackDepth = makeGettableStateVar (getSizei1 id GetNameStackDepth)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Selection
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders.hs b/Graphics/Rendering/OpenGL/GL/Shaders.hs
--- a/Graphics/Rendering/OpenGL/GL/Shaders.hs
+++ b/Graphics/Rendering/OpenGL/GL/Shaders.hs
@@ -1,49 +1,32 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Shaders
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to sections 2.15 (Vertex Shaders) and section 3.11
--- (Fragment Shaders) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Shaders (
- -- * Shader Objects
- Shader, VertexShader, FragmentShader, shaderDeleteStatus, shaderSource,
- compileShader, compileStatus, shaderInfoLog,
-
- -- * Program Objects
- Program, programDeleteStatus, attachedShaders, linkProgram, linkStatus,
- programInfoLog, validateProgram, validateStatus, currentProgram,
-
-
- -- * FragmentData
- bindFragDataLocation,
- getFragDataLocation,
-
- -- * Vertex attributes
- attribLocation, VariableType(..), activeAttribs,
-
- -- * Uniform variables
- UniformLocation, uniformLocation, activeUniforms, Uniform(..),
- UniformComponent,
-
- -- * Implementation limits related to GLSL
- maxVertexTextureImageUnits, maxTextureImageUnits,
- maxCombinedTextureImageUnits, maxTextureCoords, maxVertexUniformComponents,
- maxFragmentUniformComponents, maxVertexAttribs, maxVaryingFloats
-) where
-
-import Graphics.Rendering.OpenGL.GL.Shaders.Shaders
-import Graphics.Rendering.OpenGL.GL.Shaders.Attribs
-import Graphics.Rendering.OpenGL.GL.Shaders.Limits
-import Graphics.Rendering.OpenGL.GL.Shaders.Program
-import Graphics.Rendering.OpenGL.GL.Shaders.Uniform
-import Graphics.Rendering.OpenGL.GL.Shaders.Variables
-
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs
--- a/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs
@@ -1,58 +1,61 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Shaders.Attribs
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- This module contains functions related to shader attributes, this corresponds
--- to section 2.20.3 of the OpenGL 3.1 spec (Shader Variables).
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Shaders.Attribs (
- attribLocation, activeAttribs,
-) where
-
-import Graphics.Rendering.OpenGL.GL.GLstring
-
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.Shaders.Program
-import Graphics.Rendering.OpenGL.GL.Shaders.Variables
-
---------------------------------------------------------------------------------
-
-activeAttributes :: Program -> GettableStateVar GLuint
-activeAttributes = programVar fromIntegral ActiveAttributes
-
-activeAttributeMaxLength :: Program -> GettableStateVar GLsizei
-activeAttributeMaxLength = programVar 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
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Attribs
+-- Copyright : (c) Sven Panne 2006-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs
--- a/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs
@@ -1,79 +1,80 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.Shaders.Limits
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-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.Core31
-
-
--- | 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs
--- a/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs
@@ -1,197 +1,114 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Shaders.Program
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- This module correspons with section 2.20.2 (Program Objects) of the OpenGL
--- 3.1 spec.
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Shaders.Program (
-
- -- * Program Objects
- Program(..), programDeleteStatus, attachedShaders, linkProgram, linkStatus,
- programInfoLog, validateProgram, validateStatus, currentProgram,
-
- bindFragDataLocation, getFragDataLocation,
-
- -- * internals
- GetProgramPName(..), programVar, getCurrentProgram
-) where
-
-import Control.Monad
-import Data.List
-import Data.Maybe (fromMaybe)
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Framebuffer
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.GLstring
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.Shaders.Shaders
-
---------------------------------------------------------------------------------
-
-newtype Program = Program { programID :: GLuint }
- deriving ( Eq, Ord, Show )
-
-instance ObjectName Program where
- genObjectNames n = replicateM n $ fmap Program glCreateProgram
- deleteObjectNames = mapM_ (glDeleteProgram . programID)
- isObjectName = fmap unmarshalGLboolean . glIsProgram . programID
-
---------------------------------------------------------------------------------
-
-attachedShaders :: Program -> StateVar ([VertexShader],[FragmentShader])
-attachedShaders program =
- makeStateVar (getAttachedShaders program) (setAttachedShaders program)
-
-getAttachedShaders :: Program -> IO ([VertexShader],[FragmentShader])
-getAttachedShaders program = getAttachedShaderIDs program >>= splitShaderIDs
-
-getAttachedShaderIDs :: Program -> IO [GLuint]
-getAttachedShaderIDs program = do
- numShaders <- get (numAttachedShaders program)
- allocaArray (fromIntegral numShaders) $ \buf -> do
- glGetAttachedShaders (programID program) numShaders nullPtr buf
- peekArray (fromIntegral numShaders) buf
-
-splitShaderIDs :: [GLuint] -> IO ([VertexShader],[FragmentShader])
-splitShaderIDs ids = do
- (vs, fs) <- partitionM isVertexShaderID ids
- return (map VertexShader vs, map FragmentShader fs)
-
-isVertexShaderID :: GLuint -> IO Bool
-isVertexShaderID x = do
- t <- get (shaderTypeEnum (VertexShader x))
- return $ t == shaderType (undefined :: VertexShader)
-
-partitionM :: (a -> IO Bool) -> [a] -> IO ([a],[a])
-partitionM p = foldM select ([],[])
- where select (ts, fs) x = do
- b <- p x
- return $ if b then (x:ts, fs) else (ts, x:fs)
-
-setAttachedShaders :: Program -> ([VertexShader],[FragmentShader]) -> IO ()
-setAttachedShaders p@(Program program) (vs, fs) = do
- currentIDs <- getAttachedShaderIDs p
- let newIDs = map shaderID vs ++ map shaderID fs
- mapM_ (glAttachShader program) (newIDs \\ currentIDs)
- mapM_ (glDetachShader program) (currentIDs \\ newIDs)
-
---------------------------------------------------------------------------------
-
-linkProgram :: Program -> IO ()
-linkProgram (Program program) = glLinkProgram program
-
-currentProgram :: StateVar (Maybe Program)
-currentProgram =
- makeStateVar
- (do p <- getCurrentProgram
- return $ if p == noProgram then Nothing else Just p)
- ((\(Program p) -> glUseProgram p) . fromMaybe noProgram)
-
-getCurrentProgram :: IO Program
-getCurrentProgram = fmap Program $ getInteger1 fromIntegral GetCurrentProgram
-
-noProgram :: Program
-noProgram = Program 0
-
-validateProgram :: Program -> IO ()
-validateProgram (Program program) = glValidateProgram program
-
-programInfoLog :: Program -> GettableStateVar String
-programInfoLog p =
- stringQuery (programInfoLogLength p) (glGetProgramInfoLog (programID p))
-
---------------------------------------------------------------------------------
-
-programDeleteStatus :: Program -> GettableStateVar Bool
-programDeleteStatus = programVar unmarshalGLboolean ProgramDeleteStatus
-
-linkStatus :: Program -> GettableStateVar Bool
-linkStatus = programVar unmarshalGLboolean LinkStatus
-
-validateStatus :: Program -> GettableStateVar Bool
-validateStatus = programVar unmarshalGLboolean ValidateStatus
-
-programInfoLogLength :: Program -> GettableStateVar GLsizei
-programInfoLogLength = programVar fromIntegral ProgramInfoLogLength
-
-numAttachedShaders :: Program -> GettableStateVar GLsizei
-numAttachedShaders = programVar fromIntegral AttachedShaders
-
---------------------------------------------------------------------------------
-
-data GetProgramPName =
- ProgramDeleteStatus
- | LinkStatus
- | ValidateStatus
- | ProgramInfoLogLength
- | AttachedShaders
- | ActiveAttributes
- | ActiveAttributeMaxLength
- | ActiveUniforms
- | ActiveUniformMaxLength
- | TransformFeedbackBufferMode
- | TransformFeedbackVaryings
- | TransformFeedbackVaryingMaxLength
-
-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
-
-programVar :: (GLint -> a) -> GetProgramPName -> Program -> GettableStateVar a
-programVar f p program =
- makeGettableStateVar $
- alloca $ \buf -> do
- glGetProgramiv (programID program) (marshalGetProgramPName p) buf
- peek1 f buf
-
---------------------------------------------------------------------------------
-
--- | '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
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Program
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/ProgramBinaries.hs b/Graphics/Rendering/OpenGL/GL/Shaders/ProgramBinaries.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/ProgramBinaries.hs
@@ -0,0 +1,63 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.ProgramBinaries
+-- Copyright : (c) Sven Panne 2006-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/ProgramObjects.hs b/Graphics/Rendering/OpenGL/GL/Shaders/ProgramObjects.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/ProgramObjects.hs
@@ -0,0 +1,163 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.ProgramObjects
+-- Copyright : (c) Sven Panne 2006-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Shader.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Shader.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/Shader.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Shader
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/ShaderBinaries.hs b/Graphics/Rendering/OpenGL/GL/Shaders/ShaderBinaries.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/ShaderBinaries.hs
@@ -0,0 +1,47 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.ShaderBinaries
+-- Copyright : (c) Sven Panne 2006-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/ShaderObjects.hs b/Graphics/Rendering/OpenGL/GL/Shaders/ShaderObjects.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/ShaderObjects.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE FlexibleInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.ShaderObjects
+-- Copyright : (c) Sven Panne 2006-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Shaders.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Shaders.hs
deleted file mode 100644
--- a/Graphics/Rendering/OpenGL/GL/Shaders/Shaders.hs
+++ /dev/null
@@ -1,157 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Shaders.Shaders
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- This module correspons with section 2.20.1 (Shader Objects) of the OpenGL
--- 3.1 spec.
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Shaders.Shaders (
-
- Shader(..), VertexShader(..), FragmentShader(..), shaderDeleteStatus, shaderSource,
- compileShader, compileStatus, shaderInfoLog,
-
- -- * internals
- shaderTypeEnum
-
-) where
-
-import Control.Monad
-import Control.Monad.Fix
-import Data.List
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Marshal.Utils
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.GLstring
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-newtype VertexShader = VertexShader { vertexShaderID :: GLuint }
- deriving ( Eq, Ord, Show )
-
-newtype FragmentShader = FragmentShader { fragmentShaderID :: GLuint }
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-class (Eq s, Ord s, Show s, ObjectName s) => Shader s where
- shaderID :: s -> GLuint
- makeShader :: GLuint -> s
- shaderType :: s -> GLenum
-
-instance Shader VertexShader where
- makeShader = VertexShader
- shaderID = vertexShaderID
- shaderType = const gl_VERTEX_SHADER
-
-instance Shader FragmentShader where
- makeShader = FragmentShader
- shaderID = fragmentShaderID
- shaderType = const gl_FRAGMENT_SHADER
-
---------------------------------------------------------------------------------
-
-instance ObjectName VertexShader where
- genObjectNames = genShaderNames
- deleteObjectNames = deleteShaderNames
- isObjectName = isShaderName
-
-instance ObjectName FragmentShader where
- genObjectNames = genShaderNames
- deleteObjectNames = deleteShaderNames
- isObjectName = isShaderName
-
-genShaderNames :: Shader s => Int -> IO [s]
-genShaderNames n = replicateM n createShader
-
-createShader :: Shader s => IO s
-createShader = mfix (fmap makeShader . glCreateShader . shaderType)
-
-deleteShaderNames :: Shader s => [s] -> IO ()
-deleteShaderNames = mapM_ (glDeleteShader . shaderID)
-
-isShaderName :: Shader s => s -> IO Bool
-isShaderName = fmap unmarshalGLboolean . glIsShader . shaderID
-
---------------------------------------------------------------------------------
-
-compileShader :: Shader s => s -> IO ()
-compileShader = glCompileShader . shaderID
-
---------------------------------------------------------------------------------
-
-shaderSource :: Shader s => s -> StateVar [String]
-shaderSource shader =
- makeStateVar (getShaderSource shader) (setShaderSource shader)
-
-setShaderSource :: Shader s => s -> [String] -> IO ()
-setShaderSource shader srcs = do
- let len = genericLength srcs
- withMany withGLStringLen srcs $ \charBufsAndLengths -> do
- let (charBufs, lengths) = unzip charBufsAndLengths
- withArray charBufs $ \charBufsBuf ->
- withArray (map fromIntegral lengths) $ \lengthsBuf ->
- glShaderSource (shaderID shader) len charBufsBuf lengthsBuf
-
-getShaderSource :: Shader s => s -> IO [String]
-getShaderSource shader = do
- src <- get (stringQuery (shaderSourceLength shader)
- (glGetShaderSource (shaderID shader)))
- return [src]
-
---------------------------------------------------------------------------------
-
-shaderInfoLog :: Shader s => s -> GettableStateVar String
-shaderInfoLog shader =
- stringQuery (shaderInfoLogLength shader) (glGetShaderInfoLog (shaderID shader))
-
---------------------------------------------------------------------------------
-
-shaderDeleteStatus :: Shader s => s -> GettableStateVar Bool
-shaderDeleteStatus = shaderVar unmarshalGLboolean ShaderDeleteStatus
-
-compileStatus :: Shader s => s -> GettableStateVar Bool
-compileStatus = shaderVar unmarshalGLboolean CompileStatus
-
-shaderInfoLogLength :: Shader s => s -> GettableStateVar GLsizei
-shaderInfoLogLength = shaderVar fromIntegral ShaderInfoLogLength
-
-shaderSourceLength :: Shader s => s -> GettableStateVar GLsizei
-shaderSourceLength = shaderVar fromIntegral ShaderSourceLength
-
-shaderTypeEnum :: Shader s => s -> GettableStateVar GLenum
-shaderTypeEnum = shaderVar fromIntegral ShaderType
-
---------------------------------------------------------------------------------
-
-data GetShaderPName =
- ShaderDeleteStatus
- | CompileStatus
- | ShaderInfoLogLength
- | ShaderSourceLength
- | ShaderType
-
-marshalGetShaderPName :: GetShaderPName -> GLenum
-marshalGetShaderPName x = case x of
- ShaderDeleteStatus -> gl_DELETE_STATUS
- CompileStatus -> gl_COMPILE_STATUS
- ShaderInfoLogLength -> gl_INFO_LOG_LENGTH
- ShaderSourceLength -> gl_SHADER_SOURCE_LENGTH
- ShaderType -> gl_SHADER_TYPE
-
-shaderVar :: Shader s => (GLint -> a) -> GetShaderPName -> s -> GettableStateVar a
-shaderVar f p shader =
- makeGettableStateVar $
- alloca $ \buf -> do
- glGetShaderiv (shaderID shader) (marshalGetShaderPName p) buf
- peek1 f buf
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs
--- a/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs
@@ -1,201 +1,210 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Shaders.Uniform
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- 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,
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.GLstring
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.Shaders.Program
-import Graphics.Rendering.OpenGL.GL.Shaders.Variables
-
---------------------------------------------------------------------------------
-
-numActiveUniforms :: Program -> GettableStateVar GLuint
-numActiveUniforms = programVar fromIntegral ActiveUniforms
-
-activeUniformMaxLength :: Program -> GettableStateVar GLsizei
-activeUniformMaxLength = programVar 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
-
---------------------------------------------------------------------------------
-
-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 <- getCurrentProgram
- allocaBytes maxUniformBufferSize $ \buf -> do
- getUniform program location buf
- peek buf
-
-instance UniformComponent a => Uniform (Vertex2 a) where
- uniform = makeUniformVar $ \location (Vertex2 x y) -> uniform2 location x y
- uniformv location count = uniform2v location count . (castPtr :: Ptr (Vertex2 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (Vertex3 a) where
- uniform = makeUniformVar $ \location (Vertex3 x y z) -> uniform3 location x y z
- uniformv location count = uniform3v location count . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (Vertex4 a) where
- uniform = makeUniformVar $ \location (Vertex4 x y z w) -> uniform4 location x y z w
- uniformv location count = uniform4v location count . (castPtr :: Ptr (Vertex4 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (TexCoord1 a) where
- uniform = makeUniformVar $ \location (TexCoord1 s) -> uniform1 location s
- uniformv location count = uniform1v location count . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (TexCoord2 a) where
- uniform = makeUniformVar $ \location (TexCoord2 s t) -> uniform2 location s t
- uniformv location count = uniform2v location count . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (TexCoord3 a) where
- uniform = makeUniformVar $ \location (TexCoord3 s t r) -> uniform3 location s t r
- uniformv location count = uniform3v location count . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (TexCoord4 a) where
- uniform = makeUniformVar $ \location (TexCoord4 s t r q) -> uniform4 location s t r q
- uniformv location count = uniform4v location count . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (Normal3 a) where
- uniform = makeUniformVar $ \location (Normal3 x y z) -> uniform3 location x y z
- uniformv location count = uniform3v location count . (castPtr :: Ptr (Normal3 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (FogCoord1 a) where
- uniform = makeUniformVar $ \location (FogCoord1 c) -> uniform1 location c
- uniformv location count = uniform1v location count . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (Color3 a) where
- uniform = makeUniformVar $ \location (Color3 r g b) -> uniform3 location r g b
- uniformv location count = uniform3v location count . (castPtr :: Ptr (Color3 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (Color4 a) where
- uniform = makeUniformVar $ \location (Color4 r g b a) -> uniform4 location r g b a
- uniformv location count = uniform4v location count . (castPtr :: Ptr (Color4 b) -> Ptr b)
-
-instance UniformComponent a => Uniform (Index1 a) where
- uniform = makeUniformVar $ \location (Index1 i) -> uniform1 location i
- uniformv location count = uniform1v location count . (castPtr :: Ptr (Index1 b) -> Ptr b)
-
--- nasty instance declaration as TextureUnit is not of the form Storable (b a) as requiered for
--- getUniform
-instance Uniform TextureUnit where
- uniform loc@(UniformLocation ul) = makeStateVar getter setter
- where setter (TextureUnit tu) = uniform1 loc tu
- getter = do
- program <- getCurrentProgram
- allocaBytes (sizeOf (undefined :: GLuint)) $ \buf -> do
- glGetUniformuiv (programID program) ul buf
- tuID <- peek buf
- return $ TextureUnit tuID
- uniformv location count = uniform1v location count . (castPtr :: Ptr TextureUnit -> Ptr GLuint)
-
---------------------------------------------------------------------------------
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Uniform
+-- Copyright : (c) Sven Panne 2006-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
+
+--------------------------------------------------------------------------------
diff --git a/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs b/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs
--- a/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs
+++ b/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs
@@ -1,160 +1,163 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Shaders.Variables
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- This internal module contains the functions and datatypes used by the
--- Uniform and Attribs modules.
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Shaders.Variables (
- VariableType(..), activeVars,
-) where
-
-import Graphics.Rendering.OpenGL.GL.GLstring
-
-import Control.Monad
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.Raw.Core31
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Shaders.Program
-
--- Table 2.9 of the OpenGL 3.1 spec: OpenGL Shading Language type tokens
-data VariableType =
- Float'
- | FloatVec2
- | FloatVec3
- | FloatVec4
- | Int'
- | IntVec2
- | IntVec3
- | IntVec4
- | UnsignedInt'
- | UnsignedIntVec2
- | UnsignedIntVec3
- | UnsignedIntVec4
- | Bool
- | BoolVec2
- | BoolVec3
- | BoolVec4
- | FloatMat2
- | FloatMat3
- | FloatMat4
- | FloatMat2x3
- | FloatMat2x4
- | FloatMat3x2
- | FloatMat3x4
- | FloatMat4x2
- | FloatMat4x3
- | Sampler1D
- | Sampler2D
- | Sampler3D
- | SamplerCube
- | Sampler1DShadow
- | Sampler2DShadow
- | Sampler1DArray
- | Sampler2DArray
- | Sampler1DArrayShadow
- | Sampler2DArrayShadow
- | SamplerCubeShadow
- | Sampler2DRect
- | Sampler2DRectShadow
- | IntSampler1D
- | IntSampler2D
- | IntSampler3D
- | IntSamplerCube
- | IntSampler1DArray
- | IntSampler2DArray
- | UnsignedIntSampler1D
- | UnsignedIntSampler2D
- | UnsignedIntSampler3D
- | UnsignedIntSamplerCube
- | UnsignedIntSampler1DArray
- | UnsignedIntSampler2DArray
- deriving ( Eq, Ord, Show )
-
-unmarshalVariableType :: GLenum -> VariableType
-unmarshalVariableType x
- | x == gl_FLOAT = Float'
- | x == gl_FLOAT_VEC2 = FloatVec2
- | x == gl_FLOAT_VEC3 = FloatVec3
- | x == gl_FLOAT_VEC4 = FloatVec4
- | x == gl_INT = Int'
- | x == gl_INT_VEC2 = IntVec2
- | x == gl_INT_VEC3 = IntVec3
- | x == gl_INT_VEC4 = IntVec4
- | x == gl_UNSIGNED_INT = UnsignedInt'
- | x == gl_UNSIGNED_INT_VEC2 = UnsignedIntVec2
- | x == gl_UNSIGNED_INT_VEC3 = UnsignedIntVec3
- | x == gl_UNSIGNED_INT_VEC4 = UnsignedIntVec4
- | x == gl_BOOL = Bool
- | x == gl_BOOL_VEC2 = BoolVec2
- | x == gl_BOOL_VEC3 = BoolVec3
- | x == gl_BOOL_VEC4 = BoolVec4
- | x == gl_FLOAT_MAT2 = FloatMat2
- | x == gl_FLOAT_MAT3 = FloatMat3
- | x == gl_FLOAT_MAT4 = FloatMat4
- | x == gl_FLOAT_MAT2x3 = FloatMat2x3
- | x == gl_FLOAT_MAT2x4 = FloatMat2x4
- | x == gl_FLOAT_MAT3x2 = FloatMat3x2
- | x == gl_FLOAT_MAT3x4 = FloatMat3x4
- | x == gl_FLOAT_MAT4x2 = FloatMat4x2
- | x == gl_FLOAT_MAT4x3 = FloatMat4x3
- | x == gl_SAMPLER_1D = Sampler1D
- | x == gl_SAMPLER_2D = Sampler2D
- | x == gl_SAMPLER_3D = Sampler3D
- | x == gl_SAMPLER_CUBE = SamplerCube
- | x == gl_SAMPLER_1D_SHADOW = Sampler1DShadow
- | x == gl_SAMPLER_2D_SHADOW = Sampler2DShadow
- | x == gl_SAMPLER_1D_ARRAY = Sampler1DArray
- | x == gl_SAMPLER_2D_ARRAY = Sampler2DArray
- | x == gl_SAMPLER_1D_ARRAY_SHADOW = Sampler1DArrayShadow
- | x == gl_SAMPLER_2D_ARRAY_SHADOW = Sampler2DArrayShadow
- | x == gl_SAMPLER_CUBE_SHADOW = SamplerCubeShadow
- | x == gl_SAMPLER_2D_RECT = Sampler2DRect
- | x == gl_SAMPLER_2D_RECT_SHADOW = Sampler2DRectShadow
- | x == gl_INT_SAMPLER_1D = IntSampler1D
- | x == gl_INT_SAMPLER_2D = IntSampler2D
- | x == gl_INT_SAMPLER_3D = IntSampler3D
- | x == gl_INT_SAMPLER_CUBE = IntSamplerCube
- | x == gl_INT_SAMPLER_1D_ARRAY = IntSampler1DArray
- | x == gl_INT_SAMPLER_2D_ARRAY = IntSampler2DArray
- | x == gl_UNSIGNED_INT_SAMPLER_1D = UnsignedIntSampler1D
- | x == gl_UNSIGNED_INT_SAMPLER_2D = UnsignedIntSampler2D
- | x == gl_UNSIGNED_INT_SAMPLER_3D = UnsignedIntSampler3D
- | x == gl_UNSIGNED_INT_SAMPLER_CUBE = UnsignedIntSamplerCube
- | x == gl_UNSIGNED_INT_SAMPLER_1D_ARRAY = UnsignedIntSampler1DArray
- | x == gl_UNSIGNED_INT_SAMPLER_2D_ARRAY = UnsignedIntSampler2DArray
- | otherwise = error ("unmarshalVariableType: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-activeVars :: (Program -> GettableStateVar GLuint)
- -> (Program -> GettableStateVar GLsizei)
- -> (GLuint -> GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLint -> Ptr GLenum -> Ptr GLchar -> IO ())
- -> Program -> GettableStateVar [(GLint,VariableType,String)]
-activeVars numVars maxLength getter p@(Program program) =
- makeGettableStateVar $ do
- numActiveVars <- get (numVars p)
- maxLen <- get (maxLength p)
- allocaArray (fromIntegral maxLen) $ \nameBuf ->
- alloca $ \nameLengthBuf ->
- alloca $ \sizeBuf ->
- alloca $ \typeBuf ->
- forM [0 .. numActiveVars - 1] $ \i -> do
- getter program i maxLen nameLengthBuf sizeBuf typeBuf nameBuf
- l <- peek nameLengthBuf
- s <- peek sizeBuf
- t <- peek typeBuf
- n <- peekGLstringLen (nameBuf, l)
- return (s, unmarshalVariableType t, n)
+{-# OPTIONS_HADDOCK hide #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Shaders.Variables
+-- Copyright : (c) Sven Panne 2006-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GL/StateVar.hs b/Graphics/Rendering/OpenGL/GL/StateVar.hs
--- a/Graphics/Rendering/OpenGL/GL/StateVar.hs
+++ b/Graphics/Rendering/OpenGL/GL/StateVar.hs
@@ -1,145 +1,145 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.StateVar
--- Copyright : (c) Sven Panne 2009
--- License : BSD-style (see the file LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/StringQueries.hs b/Graphics/Rendering/OpenGL/GL/StringQueries.hs
--- a/Graphics/Rendering/OpenGL/GL/StringQueries.hs
+++ b/Graphics/Rendering/OpenGL/GL/StringQueries.hs
@@ -1,88 +1,88 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.StringQueries
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to parts of section 6.1.5 (String Queries) of the
--- OpenGL 3.2 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.StringQueries (
- vendor, renderer, glVersion, glExtensions, shadingLanguageVersion,
- majorMinor, contextProfile
-) where
-
-import Data.Bits
-import Data.Char
-import Foreign.C.String
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core32
-
---------------------------------------------------------------------------------
-
-vendor :: GettableStateVar String
-vendor = makeGettableStateVar (getString gl_VENDOR)
-
-renderer :: GettableStateVar String
-renderer = makeGettableStateVar (getString gl_RENDERER)
-
-glVersion :: GettableStateVar String
-glVersion = makeGettableStateVar (getString gl_VERSION)
-
-glExtensions :: GettableStateVar [String]
-glExtensions = makeGettableStateVar (fmap words $ getString gl_EXTENSIONS)
-
-shadingLanguageVersion :: GettableStateVar String
-shadingLanguageVersion = makeGettableStateVar (getString gl_SHADING_LANGUAGE_VERSION)
-
---------------------------------------------------------------------------------
-
-data ContextProfile'
- = CoreProfile'
- | CompatibilityProfile'
- deriving ( Eq, Ord, Show )
-
-marshalContextProfile' :: ContextProfile' -> GLenum
-marshalContextProfile' x = case x of
- CoreProfile' -> gl_CONTEXT_CORE_PROFILE_BIT
- CompatibilityProfile' -> gl_CONTEXT_COMPATIBILITY_PROFILE_BIT
-
-contextProfile :: GettableStateVar [ContextProfile']
-contextProfile = makeGettableStateVar (getEnum1 i2cps GetContextProfileMask)
-
-i2cps :: GLenum -> [ContextProfile']
-i2cps bitfield =
- [ c | c <- [ CoreProfile', CompatibilityProfile' ]
- , (bitfield .&. marshalContextProfile' c) /= 0 ]
-
---------------------------------------------------------------------------------
-
-getString :: GLenum -> IO String
-getString n = glGetString n >>= maybeNullPtr (return "") (peekCString . castPtr)
-
---------------------------------------------------------------------------------
-
--- | A utility function to be used with e.g. 'glVersion' or
--- 'shadingLanguageVersion', transforming a variable containing a string of the
--- form /major.minor[optional rest]/ into a variable containing a numeric
--- major\/minor version. If the string is malformed, which should never happen
--- with a sane OpenGL implementation, it is transformed to @(-1,-1)@.
-
-majorMinor :: GettableStateVar String -> GettableStateVar (Int, Int)
-majorMinor = makeGettableStateVar . fmap parse . get
- where defaultVersion = (-1, -1)
- parse str =
- case span isDigit str of
- (major@(_:_), '.':rest) ->
- case span isDigit rest of
- (minor@(_:_), _) -> (read major, read minor)
- _ -> defaultVersion
- _ -> defaultVersion
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.StringQueries
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/SyncObjects.hs b/Graphics/Rendering/OpenGL/GL/SyncObjects.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/SyncObjects.hs
@@ -0,0 +1,113 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.SyncObjects
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Tensor.hs b/Graphics/Rendering/OpenGL/GL/Tensor.hs
--- a/Graphics/Rendering/OpenGL/GL/Tensor.hs
+++ b/Graphics/Rendering/OpenGL/GL/Tensor.hs
@@ -1,323 +1,299 @@
-{-# LANGUAGE DeriveDataTypeable #-}
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Tensor
--- Copyright : (c) Sven Panne 2009
--- License : BSD-style (see the file LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- 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 Typeable a => Typeable (Vertex1 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vertex1 a) where
- sizeOf ~(Vertex1 s) = sizeOf s
- alignment ~(Vertex1 s) = alignment s
- peek = 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 Typeable a => Typeable (Vertex2 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vertex2 a) where
- sizeOf ~(Vertex2 x _) = 2 * sizeOf x
- alignment ~(Vertex2 x _) = alignment x
- peek = 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 Typeable a => Typeable (Vertex3 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vertex3 a) where
- sizeOf ~(Vertex3 x _ _) = 3 * sizeOf x
- alignment ~(Vertex3 x _ _) = alignment x
- peek = 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 Typeable a => Typeable (Vertex4 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vertex4 a) where
- sizeOf ~(Vertex4 x _ _ _) = 4 * sizeOf x
- alignment ~(Vertex4 x _ _ _) = alignment x
- peek = 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 Typeable a => Typeable (Vector1 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vector1 a) where
- sizeOf ~(Vector1 s) = sizeOf s
- alignment ~(Vector1 s) = alignment s
- peek = 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 Typeable a => Typeable (Vector2 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vector2 a) where
- sizeOf ~(Vector2 x _) = 2 * sizeOf x
- alignment ~(Vector2 x _) = alignment x
- peek = 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 Typeable a => Typeable (Vector3 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vector3 a) where
- sizeOf ~(Vector3 x _ _) = 3 * sizeOf x
- alignment ~(Vector3 x _ _) = alignment x
- peek = 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 Typeable a => Typeable (Vector4 a) where
- typeOf = typeOfDefault
-
-instance Storable a => Storable (Vector4 a) where
- sizeOf ~(Vector4 x _ _ _) = 4 * sizeOf x
- alignment ~(Vector4 x _ _ _) = alignment x
- peek = 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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing.hs b/Graphics/Rendering/OpenGL/GL/Texturing.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing.hs
@@ -1,29 +1,29 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.8 (Texturing) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing (
- module Graphics.Rendering.OpenGL.GL.Texturing.Specification,
- module Graphics.Rendering.OpenGL.GL.Texturing.Parameters,
- module Graphics.Rendering.OpenGL.GL.Texturing.Objects,
- module Graphics.Rendering.OpenGL.GL.Texturing.Environments,
- module Graphics.Rendering.OpenGL.GL.Texturing.Application,
- module Graphics.Rendering.OpenGL.GL.Texturing.Queries
-) where
-
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-import Graphics.Rendering.OpenGL.GL.Texturing.Parameters
-import Graphics.Rendering.OpenGL.GL.Texturing.Objects
-import Graphics.Rendering.OpenGL.GL.Texturing.Environments
-import Graphics.Rendering.OpenGL.GL.Texturing.Application
-import Graphics.Rendering.OpenGL.GL.Texturing.Queries
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Application.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Application.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/Application.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/Application.hs
@@ -1,36 +1,27 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.Application
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.8.15 (Texture Application) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.Application (
- texture
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-
---------------------------------------------------------------------------------
-
--- ToDo: cube maps
-texture :: TextureTarget -> StateVar Capability
-texture = makeCapability . textureTargetToEnableCap
-
-textureTargetToEnableCap :: TextureTarget -> EnableCap
-textureTargetToEnableCap x = case x of
- Texture1D -> CapTexture1D
- Texture2D -> CapTexture2D
- Texture3D -> CapTexture3D
- TextureCubeMap -> CapTextureCubeMap
- TextureRectangle -> CapTextureRectangle
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.Application
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs
@@ -1,366 +1,353 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.Environments
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.8.13 (Texture Environments and Texture
--- Functions) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.Environments (
- TextureFunction(..), textureFunction,
- TextureCombineFunction(..), combineRGB, combineAlpha,
- ArgNum(..), Arg(..), Src(..), argRGB, argAlpha,
- rgbScale, alphaScale,
- constantColor, textureUnitLODBias
-) where
-
-import Control.Monad
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.BlendingFactor
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.Texturing.Parameters
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glGetTexEnvfv, glGetTexEnviv, glTexEnvf, glTexEnvfv, glTexEnvi, gl_ADD,
- gl_ADD_SIGNED, gl_ALPHA_SCALE, gl_COMBINE, gl_COMBINE_ALPHA, gl_COMBINE_RGB,
- gl_CONSTANT, gl_DECAL, gl_DOT3_RGB, gl_DOT3_RGBA, gl_INTERPOLATE,
- gl_MODULATE, gl_OPERAND0_ALPHA, gl_OPERAND0_RGB, gl_OPERAND1_ALPHA,
- gl_OPERAND1_RGB, gl_OPERAND2_ALPHA, gl_OPERAND2_RGB, gl_POINT_SPRITE,
- gl_PREVIOUS, gl_PRIMARY_COLOR, gl_RGB_SCALE, gl_SRC0_ALPHA, gl_SRC0_RGB,
- gl_SRC1_ALPHA, gl_SRC1_RGB, gl_SRC2_ALPHA, gl_SRC2_RGB, gl_SUBTRACT,
- gl_TEXTURE_ENV, gl_TEXTURE_ENV_COLOR, gl_TEXTURE_ENV_MODE,
- gl_TEXTURE_FILTER_CONTROL )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.NV.TextureEnvCombine4 (
- gl_COMBINE4, gl_OPERAND3_ALPHA, gl_OPERAND3_RGB, gl_SOURCE3_ALPHA,
- gl_SOURCE3_RGB )
-
---------------------------------------------------------------------------------
-
-data TextureEnvTarget =
- TextureEnv
- | TextureFilterControl -- GL_TEXTURE_LOD_BIAS_EXT
- | PointSprite -- GL_COORD_REPLACE_NV
-
-marshalTextureEnvTarget :: TextureEnvTarget -> GLenum
-marshalTextureEnvTarget x = case x of
- TextureEnv -> gl_TEXTURE_ENV
- TextureFilterControl -> gl_TEXTURE_FILTER_CONTROL
- PointSprite -> gl_POINT_SPRITE
-
---------------------------------------------------------------------------------
-
-data TextureEnvParameter =
- TexEnvParamTextureEnvMode
- | TexEnvParamTextureEnvColor
- | TexEnvParamCombineRGB
- | TexEnvParamCombineAlpha
- | TexEnvParamSrc0RGB
- | TexEnvParamSrc1RGB
- | TexEnvParamSrc2RGB
- | TexEnvParamSrc3RGB
- | TexEnvParamSrc0Alpha
- | TexEnvParamSrc1Alpha
- | TexEnvParamSrc2Alpha
- | TexEnvParamSrc3Alpha
- | TexEnvParamOperand0RGB
- | TexEnvParamOperand1RGB
- | TexEnvParamOperand2RGB
- | TexEnvParamOperand3RGB
- | TexEnvParamOperand0Alpha
- | TexEnvParamOperand1Alpha
- | TexEnvParamOperand2Alpha
- | TexEnvParamOperand3Alpha
- | TexEnvParamRGBScale
- | TexEnvParamAlphaScale
- | TexEnvParamLODBias
-
-marshalTextureEnvParameter :: TextureEnvParameter -> GLenum
-marshalTextureEnvParameter x = case x of
- TexEnvParamTextureEnvMode -> gl_TEXTURE_ENV_MODE
- TexEnvParamTextureEnvColor -> gl_TEXTURE_ENV_COLOR
- TexEnvParamCombineRGB -> gl_COMBINE_RGB
- TexEnvParamCombineAlpha -> gl_COMBINE_ALPHA
- TexEnvParamSrc0RGB -> gl_SRC0_RGB
- TexEnvParamSrc1RGB -> gl_SRC1_RGB
- TexEnvParamSrc2RGB -> gl_SRC2_RGB
- TexEnvParamSrc3RGB -> gl_SOURCE3_RGB
- TexEnvParamSrc0Alpha -> gl_SRC0_ALPHA
- TexEnvParamSrc1Alpha -> gl_SRC1_ALPHA
- TexEnvParamSrc2Alpha -> gl_SRC2_ALPHA
- TexEnvParamSrc3Alpha -> gl_SOURCE3_ALPHA
- TexEnvParamOperand0RGB -> gl_OPERAND0_RGB
- TexEnvParamOperand1RGB -> gl_OPERAND1_RGB
- TexEnvParamOperand2RGB -> gl_OPERAND2_RGB
- TexEnvParamOperand3RGB -> gl_OPERAND3_RGB
- TexEnvParamOperand0Alpha -> gl_OPERAND0_ALPHA
- TexEnvParamOperand1Alpha -> gl_OPERAND1_ALPHA
- TexEnvParamOperand2Alpha -> gl_OPERAND2_ALPHA
- TexEnvParamOperand3Alpha -> gl_OPERAND3_ALPHA
- TexEnvParamRGBScale -> gl_RGB_SCALE
- TexEnvParamAlphaScale -> gl_ALPHA_SCALE
- TexEnvParamLODBias -> gl_TEXTURE_LOD_BIAS
-
---------------------------------------------------------------------------------
-
-texEnv :: (GLenum -> GLenum -> b -> IO ())
- -> (a -> (b -> IO ()) -> IO ())
- -> TextureEnvTarget -> TextureEnvParameter -> a -> IO ()
-texEnv glTexEnv marshalAct t p x =
- marshalAct x $
- glTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p)
-
-glTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glTexEnvC4f t p ptr = glTexEnvfv t p (castPtr ptr)
-
-
---------------------------------------------------------------------------------
-
-getTexEnv :: Storable b
- => (GLenum -> GLenum -> Ptr b -> IO ())
- -> (b -> a)
- -> TextureEnvTarget -> TextureEnvParameter -> IO a
-getTexEnv glGetTexEnv unmarshal t p =
- alloca $ \buf -> do
- glGetTexEnv (marshalTextureEnvTarget t) (marshalTextureEnvParameter p) buf
- peek1 unmarshal buf
-
-glGetTexEnvC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glGetTexEnvC4f t p ptr = glGetTexEnvfv t p (castPtr ptr)
-
---------------------------------------------------------------------------------
-
-m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()
-m2a marshal x act = act (marshal x)
-
-texEnvi ::
- (GLint -> a) -> (a -> GLint) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a
-texEnvi unmarshal marshal t p =
- makeStateVar
- (getTexEnv glGetTexEnviv unmarshal t p)
- (texEnv glTexEnvi (m2a marshal) t p)
-
-texEnvf ::
- (GLfloat -> a) -> (a -> GLfloat) -> TextureEnvTarget -> TextureEnvParameter -> StateVar a
-texEnvf unmarshal marshal t p =
- makeStateVar
- (getTexEnv glGetTexEnvfv unmarshal t p)
- (texEnv glTexEnvf (m2a marshal) t p)
-
-texEnvC4f :: TextureEnvTarget -> TextureEnvParameter -> StateVar (Color4 GLfloat)
-texEnvC4f t p =
- makeStateVar
- (getTexEnv glGetTexEnvC4f id t p)
- (texEnv glTexEnvC4f with t p)
-
---------------------------------------------------------------------------------
-
-data TextureFunction =
- Modulate
- | Decal
- | Blend
- | Replace
- | AddUnsigned
- | Combine
- | Combine4
- deriving ( Eq, Ord, Show )
-
-marshalTextureFunction :: TextureFunction -> GLint
-marshalTextureFunction x = fromIntegral $ case x of
- Modulate -> gl_MODULATE
- Decal -> gl_DECAL
- Blend -> gl_BLEND
- Replace -> gl_REPLACE
- AddUnsigned -> gl_ADD
- Combine -> gl_COMBINE
- Combine4 -> gl_COMBINE4
-
-unmarshalTextureFunction :: GLint -> TextureFunction
-unmarshalTextureFunction x
- | y == gl_MODULATE = Modulate
- | y == gl_DECAL = Decal
- | y == gl_BLEND = Blend
- | y == gl_REPLACE = Replace
- | y == gl_ADD = AddUnsigned
- | y == gl_COMBINE = Combine
- | y == gl_COMBINE4 = Combine4
- | otherwise = error ("unmarshalTextureFunction: illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-textureFunction :: StateVar TextureFunction
-textureFunction =
- texEnvi unmarshalTextureFunction marshalTextureFunction TextureEnv TexEnvParamTextureEnvMode
-
---------------------------------------------------------------------------------
-
-data TextureCombineFunction =
- Replace'
- | Modulate'
- | AddUnsigned'
- | AddSigned
- | Interpolate
- | Subtract
- | Dot3RGB
- | Dot3RGBA
- deriving ( Eq, Ord, Show )
-
-marshalTextureCombineFunction :: TextureCombineFunction -> GLint
-marshalTextureCombineFunction x = fromIntegral $ case x of
- Replace' -> gl_REPLACE
- Modulate' -> gl_MODULATE
- AddUnsigned' -> gl_ADD
- AddSigned -> gl_ADD_SIGNED
- Interpolate -> gl_INTERPOLATE
- Subtract -> gl_SUBTRACT
- Dot3RGB -> gl_DOT3_RGB
- Dot3RGBA -> gl_DOT3_RGBA
-
-unmarshalTextureCombineFunction :: GLint -> TextureCombineFunction
-unmarshalTextureCombineFunction x
- | y == gl_REPLACE = Replace'
- | y == gl_MODULATE = Modulate'
- | y == gl_ADD = AddUnsigned'
- | y == gl_ADD_SIGNED = AddSigned
- | y == gl_INTERPOLATE = Interpolate
- | y == gl_SUBTRACT = Subtract
- | y == gl_DOT3_RGB = Dot3RGB
- | y == gl_DOT3_RGBA = Dot3RGBA
- | otherwise = error ("unmarshalTextureCombineFunction: illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-combineRGB :: StateVar TextureCombineFunction
-combineRGB = combine TexEnvParamCombineRGB
-
-combineAlpha :: StateVar TextureCombineFunction
-combineAlpha = combine TexEnvParamCombineAlpha
-
-combine :: TextureEnvParameter -> StateVar TextureCombineFunction
-combine =
- texEnvi unmarshalTextureCombineFunction marshalTextureCombineFunction TextureEnv
-
---------------------------------------------------------------------------------
-
-data ArgNum =
- Arg0
- | Arg1
- | Arg2
- | Arg3
- deriving ( Eq, Ord, Show )
-
-argNumToOperandRGB :: ArgNum -> TextureEnvParameter
-argNumToOperandRGB x = case x of
- Arg0 -> TexEnvParamOperand0RGB
- Arg1 -> TexEnvParamOperand1RGB
- Arg2 -> TexEnvParamOperand2RGB
- Arg3 -> TexEnvParamOperand3RGB
-
-argNumToOperandAlpha :: ArgNum -> TextureEnvParameter
-argNumToOperandAlpha x = case x of
- Arg0 -> TexEnvParamOperand0Alpha
- Arg1 -> TexEnvParamOperand1Alpha
- Arg2 -> TexEnvParamOperand2Alpha
- Arg3 -> TexEnvParamOperand3Alpha
-
-argNumToSrcRGB :: ArgNum -> TextureEnvParameter
-argNumToSrcRGB x = case x of
- Arg0 -> TexEnvParamSrc0RGB
- Arg1 -> TexEnvParamSrc1RGB
- Arg2 -> TexEnvParamSrc2RGB
- Arg3 -> TexEnvParamSrc3RGB
-
-argNumToSrcAlpha :: ArgNum -> TextureEnvParameter
-argNumToSrcAlpha x = case x of
- Arg0 -> TexEnvParamSrc0Alpha
- Arg1 -> TexEnvParamSrc1Alpha
- Arg2 -> TexEnvParamSrc2Alpha
- Arg3 -> TexEnvParamSrc3Alpha
-
---------------------------------------------------------------------------------
-
-data Arg = Arg BlendingFactor Src
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-data Src =
- CurrentUnit
- | Previous
- | Crossbar TextureUnit
- | Constant
- | PrimaryColor
- deriving ( Eq, Ord, Show )
-
-marshalSrc :: Src -> GLint
-marshalSrc x = fromIntegral $ case x of
- CurrentUnit -> gl_TEXTURE
- Previous -> gl_PREVIOUS
- Crossbar u -> fromIntegral (marshalTextureUnit u)
- Constant -> gl_CONSTANT
- PrimaryColor -> gl_PRIMARY_COLOR
-
-unmarshalSrc :: GLint -> Src
-unmarshalSrc x
- | y == gl_TEXTURE = CurrentUnit
- | y == gl_PREVIOUS = Previous
- | y == gl_CONSTANT = Constant
- | y == gl_PRIMARY_COLOR = PrimaryColor
- | otherwise = Crossbar (unmarshalTextureUnit (fromIntegral x))
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-argRGB :: ArgNum -> StateVar Arg
-argRGB n = arg (argNumToOperandRGB n) (argNumToSrcRGB n)
-
-argAlpha :: ArgNum -> StateVar Arg
-argAlpha n = arg (argNumToOperandAlpha n) (argNumToSrcAlpha n)
-
-arg :: TextureEnvParameter -> TextureEnvParameter -> StateVar Arg
-arg op src = combineArg (textureEnvOperand op) (textureEnvSrc src)
- where combineArg v w = makeStateVar
- (liftM2 Arg (get v) (get w))
- (\(Arg x y) -> do v $= x; w $= y)
-
-textureEnvOperand :: TextureEnvParameter -> StateVar BlendingFactor
-textureEnvOperand =
- texEnvi (unmarshalBlendingFactor . fromIntegral) (fromIntegral . marshalBlendingFactor) TextureEnv
-
-textureEnvSrc :: TextureEnvParameter -> StateVar Src
-textureEnvSrc = texEnvi unmarshalSrc marshalSrc TextureEnv
-
---------------------------------------------------------------------------------
-
-rgbScale :: StateVar GLfloat
-rgbScale = scale TexEnvParamRGBScale
-
-alphaScale :: StateVar GLfloat
-alphaScale = scale TexEnvParamAlphaScale
-
-scale :: TextureEnvParameter -> StateVar GLfloat
-scale = texEnvf id id TextureEnv
-
---------------------------------------------------------------------------------
-
-constantColor :: StateVar (Color4 GLfloat)
-constantColor = texEnvC4f TextureEnv TexEnvParamTextureEnvColor
-
---------------------------------------------------------------------------------
-
-textureUnitLODBias :: StateVar LOD
-textureUnitLODBias = texEnvf id id TextureFilterControl TexEnvParamLODBias
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.Environments
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Filter.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Filter.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/Filter.hs
@@ -0,0 +1,67 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.Filter
+-- Copyright : (c) Sven Panne 2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs
@@ -1,105 +1,76 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.Objects
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.8.12 (Texture Objects) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.Objects (
- TextureObject(TextureObject), textureBinding,
- textureResident, areTexturesResident,
- TexturePriority, texturePriority, prioritizeTextures
-) where
-
-import Data.List
-import Data.Maybe (fromMaybe)
-import Foreign.Marshal.Array
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glAreTexturesResident, glPrioritizeTextures )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-newtype TextureObject = TextureObject { textureID :: GLuint }
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-instance ObjectName TextureObject where
- genObjectNames n =
- allocaArray n $ \buf -> do
- glGenTextures (fromIntegral n) buf
- fmap (map TextureObject) $ peekArray n buf
-
- deleteObjectNames textureObjects =
- withArrayLen (map textureID textureObjects) $
- glDeleteTextures . fromIntegral
-
- isObjectName = fmap unmarshalGLboolean . glIsTexture . textureID
-
---------------------------------------------------------------------------------
-
-textureBinding :: TextureTarget -> StateVar (Maybe TextureObject)
-textureBinding t =
- makeStateVar
- (do o <- getEnum1 (TextureObject . fromIntegral) (textureTargetToGetPName t)
- return $ if o == defaultTextureObject then Nothing else Just o)
- (glBindTexture (marshalTextureTarget t) . textureID . (fromMaybe defaultTextureObject))
-
-defaultTextureObject :: TextureObject
-defaultTextureObject = TextureObject 0
-
-textureTargetToGetPName :: TextureTarget -> PName1I
-textureTargetToGetPName x = case x of
- Texture1D -> GetTextureBinding1D
- Texture2D -> GetTextureBinding2D
- Texture3D -> GetTextureBinding3D
- TextureCubeMap -> GetTextureBindingCubeMap
- TextureRectangle -> GetTextureBindingRectangle
-
---------------------------------------------------------------------------------
-
-textureResident :: TextureTarget -> GettableStateVar Bool
-textureResident t =
- makeGettableStateVar $
- getTexParameteri unmarshalGLboolean t TextureResident
-
-areTexturesResident :: [TextureObject] -> IO ([TextureObject],[TextureObject])
-areTexturesResident texObjs = do
- withArrayLen (map textureID texObjs) $ \len texObjsBuf ->
- allocaArray len $ \residentBuf -> do
- allResident <-
- glAreTexturesResident (fromIntegral len) texObjsBuf residentBuf
- if unmarshalGLboolean allResident
- then return (texObjs, [])
- else do
- tr <- fmap (zip texObjs) $ peekArray len residentBuf
- let (resident, nonResident) = partition (unmarshalGLboolean . snd) tr
- return (map fst resident, map fst nonResident)
-
---------------------------------------------------------------------------------
-
-type TexturePriority = GLclampf
-
-texturePriority :: TextureTarget -> StateVar TexturePriority
-texturePriority = texParamf realToFrac realToFrac TexturePriority
-
-prioritizeTextures :: [(TextureObject,TexturePriority)] -> IO ()
-prioritizeTextures tps =
- withArrayLen (map (textureID . fst) tps) $ \len texObjsBuf ->
- withArray (map snd tps) $
- glPrioritizeTextures (fromIntegral len) texObjsBuf
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.Objects
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs
@@ -1,254 +1,233 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.Parameters
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.8.4 (Texture Parameters), section 3.8.7
--- (Texture Wrap Mode), section 3.8.8 (Texture Minification), and section 3.8.9
--- (Texture Magnification) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.Parameters (
- TextureFilter(..), MinificationFilter, MagnificationFilter, textureFilter,
- Repetition(..), Clamping(..), textureWrapMode,
- textureBorderColor, LOD, textureObjectLODBias, maxTextureLODBias,
- textureLODRange, textureMaxAnisotropy, maxTextureMaxAnisotropy,
- textureLevelRange, generateMipmap, depthTextureMode, textureCompareMode,
- textureCompareFailValue, TextureCompareOperator(..), textureCompareOperator
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.ComparisonFunction
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-import Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility ( gl_CLAMP )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.TextureMirrorClamp (
- gl_MIRROR_CLAMP, gl_MIRROR_CLAMP_TO_BORDER, gl_MIRROR_CLAMP_TO_EDGE )
-
---------------------------------------------------------------------------------
-
-data TextureFilter =
- Nearest
- | Linear'
- deriving ( Eq, Ord, Show )
-
-type MinificationFilter = (TextureFilter, Maybe TextureFilter)
-
-type MagnificationFilter = TextureFilter
-
--- We treat MagnificationFilter as a degenerated case of MinificationFilter
-magToMin :: MagnificationFilter -> MinificationFilter
-magToMin magFilter = (magFilter, Nothing)
-
-minToMag :: MinificationFilter -> MagnificationFilter
-minToMag (magFilter, Nothing) = magFilter
-minToMag minFilter = error ("minToMag: illegal value " ++ show minFilter)
-
-marshalMinificationFilter :: MinificationFilter -> GLint
-marshalMinificationFilter x = fromIntegral $ case x of
- (Nearest, Nothing ) -> gl_NEAREST
- (Linear', Nothing ) -> gl_LINEAR
- (Nearest, Just Nearest) -> gl_NEAREST_MIPMAP_NEAREST
- (Linear', Just Nearest) -> gl_LINEAR_MIPMAP_NEAREST
- (Nearest, Just Linear') -> gl_NEAREST_MIPMAP_LINEAR
- (Linear', Just Linear') -> gl_LINEAR_MIPMAP_LINEAR
-
-marshalMagnificationFilter :: MagnificationFilter -> GLint
-marshalMagnificationFilter = marshalMinificationFilter . magToMin
-
-unmarshalMinificationFilter :: GLint -> MinificationFilter
-unmarshalMinificationFilter x
- | y == gl_NEAREST = (Nearest, Nothing)
- | y == gl_LINEAR = (Linear', Nothing)
- | y == gl_NEAREST_MIPMAP_NEAREST = (Nearest, Just Nearest)
- | y == gl_LINEAR_MIPMAP_NEAREST = (Linear', Just Nearest)
- | y == gl_NEAREST_MIPMAP_LINEAR = (Nearest, Just Linear')
- | y == gl_LINEAR_MIPMAP_LINEAR = (Linear', Just Linear')
- | otherwise = error ("unmarshalMinificationFilter: illegal value " ++ show x)
- where y = fromIntegral x
-
-unmarshalMagnificationFilter :: GLint -> MagnificationFilter
-unmarshalMagnificationFilter = minToMag . unmarshalMinificationFilter
-
---------------------------------------------------------------------------------
-
-textureFilter :: TextureTarget -> StateVar (MinificationFilter, MagnificationFilter)
-textureFilter =
- combineTexParams
- (texParami unmarshalMinificationFilter marshalMinificationFilter TextureMinFilter)
- (texParami unmarshalMagnificationFilter marshalMagnificationFilter TextureMagFilter)
-
---------------------------------------------------------------------------------
-
-data Repetition =
- Repeated
- | Mirrored
- deriving ( Eq, Ord, Show )
-
-data Clamping =
- Clamp
- | Repeat
- | ClampToEdge
- | ClampToBorder
- deriving ( Eq, Ord, Show )
-
-marshalTextureWrapMode :: (Repetition, Clamping) -> GLint
-marshalTextureWrapMode x = fromIntegral $ case x of
- (Repeated, Clamp) -> gl_CLAMP
- (Repeated, Repeat) -> gl_REPEAT
- (Repeated, ClampToEdge) -> gl_CLAMP_TO_EDGE
- (Repeated, ClampToBorder) -> gl_CLAMP_TO_BORDER
- (Mirrored, Clamp) -> gl_MIRROR_CLAMP
- (Mirrored, Repeat) -> gl_MIRRORED_REPEAT
- (Mirrored, ClampToEdge) -> gl_MIRROR_CLAMP_TO_EDGE
- (Mirrored, ClampToBorder) -> gl_MIRROR_CLAMP_TO_BORDER
-
-unmarshalTextureWrapMode :: GLint -> (Repetition, Clamping)
-unmarshalTextureWrapMode x
- | y == gl_CLAMP = (Repeated, Clamp)
- | y == gl_REPEAT = (Repeated, Repeat)
- | y == gl_CLAMP_TO_EDGE = (Repeated, ClampToEdge)
- | y == gl_CLAMP_TO_BORDER = (Repeated, ClampToBorder)
- | y == gl_MIRROR_CLAMP = (Mirrored, Clamp)
- | y == gl_MIRRORED_REPEAT = (Mirrored, Repeat)
- | y == gl_MIRROR_CLAMP_TO_EDGE = (Mirrored, ClampToEdge)
- | y == gl_MIRROR_CLAMP_TO_BORDER = (Mirrored, ClampToBorder)
- | otherwise = error ("unmarshalTextureWrapMode: illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-textureWrapMode :: TextureTarget -> TextureCoordName -> StateVar (Repetition,Clamping)
-textureWrapMode t coord = case coord of
- S -> wrap TextureWrapS
- T -> wrap TextureWrapT
- R -> wrap TextureWrapR
- Q -> invalidTextureCoord
- where wrap c = texParami unmarshalTextureWrapMode marshalTextureWrapMode c t
-
-invalidTextureCoord :: StateVar (Repetition,Clamping)
-invalidTextureCoord =
- makeStateVar
- (do recordInvalidEnum; return (Repeated, Repeat))
- (const recordInvalidEnum)
-
---------------------------------------------------------------------------------
-
-textureBorderColor :: TextureTarget -> StateVar (Color4 GLfloat)
-textureBorderColor = texParamC4f TextureBorderColor
-
---------------------------------------------------------------------------------
-
-type LOD = GLfloat
-
-textureObjectLODBias :: TextureTarget -> StateVar LOD
-textureObjectLODBias = texParamf id id TextureLODBias
-
-maxTextureLODBias :: GettableStateVar LOD
-maxTextureLODBias =
- makeGettableStateVar (getFloat1 id GetMaxTextureLODBias)
-
-textureLODRange :: TextureTarget -> StateVar (LOD,LOD)
-textureLODRange =
- combineTexParams
- (texParamf id id TextureMinLOD)
- (texParamf id id TextureMaxLOD)
-
---------------------------------------------------------------------------------
-
-textureMaxAnisotropy :: TextureTarget -> StateVar GLfloat
-textureMaxAnisotropy = texParamf id id TextureMaxAnisotropy
-
-maxTextureMaxAnisotropy :: GettableStateVar GLfloat
-maxTextureMaxAnisotropy =
- makeGettableStateVar (getFloat1 id GetMaxTextureMaxAnisotropy)
-
---------------------------------------------------------------------------------
-
-textureLevelRange :: TextureTarget -> StateVar (Level,Level)
-textureLevelRange =
- combineTexParams
- (texParami id id TextureBaseLevel)
- (texParami id id TextureMaxLevel)
-
---------------------------------------------------------------------------------
-
-generateMipmap :: TextureTarget -> StateVar Capability
-generateMipmap = texParami unmarshal marshal GenerateMipmap
- where unmarshal = unmarshalCapability . fromIntegral
- marshal = fromIntegral . marshalCapability
-
---------------------------------------------------------------------------------
-
--- Only Luminance', Intensity, and Alpha' allowed
-depthTextureMode :: TextureTarget -> StateVar PixelInternalFormat
-depthTextureMode =
- texParami unmarshalPixelInternalFormat marshalPixelInternalFormat DepthTextureMode
-
---------------------------------------------------------------------------------
-
-marshalTextureCompareMode :: Capability -> GLint
-marshalTextureCompareMode x = fromIntegral $ case x of
- Disabled -> gl_NONE
- Enabled -> gl_COMPARE_REF_TO_TEXTURE
-
-unmarshalTextureCompareMode :: GLint -> Capability
-unmarshalTextureCompareMode x
- | y == gl_NONE = Disabled
- | y == gl_COMPARE_REF_TO_TEXTURE = Enabled
- | otherwise = error ("unmarshalTextureCompareMode: illegal value " ++ show x)
- where y = fromIntegral x
-
---------------------------------------------------------------------------------
-
-textureCompareMode :: TextureTarget -> StateVar (Maybe ComparisonFunction)
-textureCompareMode =
- combineTexParamsMaybe
- (texParami unmarshalTextureCompareMode marshalTextureCompareMode TextureCompareMode)
- (texParami unmarshal marshal TextureCompareFunc)
- where unmarshal = unmarshalComparisonFunction . fromIntegral
- marshal = fromIntegral . marshalComparisonFunction
-
---------------------------------------------------------------------------------
-
-textureCompareFailValue :: TextureTarget -> StateVar GLclampf
-textureCompareFailValue = texParamf realToFrac realToFrac TextureCompareFailValue
-
---------------------------------------------------------------------------------
-
-data TextureCompareOperator =
- LequalR
- | GequalR
- deriving ( Eq, Ord, Show )
-
-marshalTextureCompareOperator :: TextureCompareOperator -> GLint
-marshalTextureCompareOperator x = case x of
- LequalR -> 0x819c
- GequalR -> 0x819d
-
-unmarshalTextureCompareOperator :: GLint -> TextureCompareOperator
-unmarshalTextureCompareOperator x
- | x == 0x819c = LequalR
- | x == 0x819d = GequalR
- | otherwise = error ("unmarshalTextureCompareOperator: illegal value " ++ show x)
-
---------------------------------------------------------------------------------
-
-textureCompareOperator :: TextureTarget -> StateVar (Maybe TextureCompareOperator)
-textureCompareOperator =
- combineTexParamsMaybe
- (texParami (unmarshalCapability . fromIntegral) (fromIntegral. marshalCapability) TextureCompare)
- (texParami unmarshalTextureCompareOperator marshalTextureCompareOperator TextureCompareOperator)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.Parameters
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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))
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs b/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs
@@ -1,391 +1,380 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling PixelInternalFormat.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (
- PixelInternalFormat(..), marshalPixelInternalFormat,
- marshalPixelInternalFormat', unmarshalPixelInternalFormat,
-) where
-
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_ALPHA12, gl_ALPHA16, gl_ALPHA4, gl_ALPHA8, gl_COMPRESSED_ALPHA,
- gl_COMPRESSED_INTENSITY, gl_COMPRESSED_LUMINANCE,
- gl_COMPRESSED_LUMINANCE_ALPHA, gl_COMPRESSED_SLUMINANCE,
- gl_COMPRESSED_SLUMINANCE_ALPHA, gl_INTENSITY, gl_INTENSITY12, gl_INTENSITY16,
- gl_INTENSITY4, gl_INTENSITY8, gl_LUMINANCE, gl_LUMINANCE12,
- gl_LUMINANCE12_ALPHA12, gl_LUMINANCE12_ALPHA4, gl_LUMINANCE16,
- gl_LUMINANCE16_ALPHA16, gl_LUMINANCE4, gl_LUMINANCE4_ALPHA4,
- gl_LUMINANCE6_ALPHA2, gl_LUMINANCE8, gl_LUMINANCE8_ALPHA8,
- gl_LUMINANCE_ALPHA, gl_SLUMINANCE, gl_SLUMINANCE8, gl_SLUMINANCE8_ALPHA8,
- gl_SLUMINANCE_ALPHA )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data PixelInternalFormat =
- Alpha'
- | DepthComponent'
- | Luminance'
- | LuminanceAlpha'
- | Intensity
- | 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 parameter of TexImage2D, CopyTexImage2D,
--- and CompressedTexImage2DARB and the 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
+-- 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 parameter of TexImage2D, CopyTexImage2D,
+-- and CompressedTexImage2DARB and the 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs
@@ -1,162 +1,162 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.Queries
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module offers various texture queries.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.Queries (
- TextureQuery, textureInternalFormat, textureSize1D, textureSize2D,
- textureSize3D, textureBorder, textureRGBASizes, textureSharedSize,
- textureIntensitySize, textureLuminanceSize, textureIndexSize,
- textureDepthBits, textureCompressedImageSize, textureProxyOK
-) where
-
-import Control.Monad
-import Foreign.Marshal.Alloc
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.PixelRectangles
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.Texturing.Specification
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_TEXTURE_INTENSITY_SIZE, gl_TEXTURE_LUMINANCE_SIZE, gl_DEPTH_BITS )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.PalettedTexture (
- gl_TEXTURE_INDEX_SIZE )
-
---------------------------------------------------------------------------------
-
-data TexLevelParameter =
- TextureInternalFormat
- | TextureWidth
- | TextureHeight
- | TextureDepth
- | TextureBorder
- | TextureRedSize
- | TextureGreenSize
- | TextureBlueSize
- | TextureAlphaSize
- | TextureIntensitySize
- | TextureLuminanceSize
- | TextureIndexSize
- | DepthBits
- | TextureCompressedImageSize
- | TextureCompressed
- | TextureSharedSize
-
-marshalTexLevelParameter :: TexLevelParameter -> GLenum
-marshalTexLevelParameter x = case x of
- TextureInternalFormat -> gl_TEXTURE_INTERNAL_FORMAT
- TextureWidth -> gl_TEXTURE_WIDTH
- TextureHeight -> gl_TEXTURE_HEIGHT
- TextureDepth -> gl_TEXTURE_DEPTH
- TextureBorder -> gl_TEXTURE_BORDER
- TextureRedSize -> gl_TEXTURE_RED_SIZE
- TextureGreenSize -> gl_TEXTURE_GREEN_SIZE
- TextureBlueSize -> gl_TEXTURE_BLUE_SIZE
- TextureAlphaSize -> gl_TEXTURE_ALPHA_SIZE
- TextureIntensitySize -> gl_TEXTURE_INTENSITY_SIZE
- TextureLuminanceSize -> gl_TEXTURE_LUMINANCE_SIZE
- TextureIndexSize -> gl_TEXTURE_INDEX_SIZE
- DepthBits -> gl_DEPTH_BITS
- TextureCompressedImageSize -> gl_TEXTURE_COMPRESSED_IMAGE_SIZE
- TextureCompressed -> gl_TEXTURE_COMPRESSED
- TextureSharedSize -> gl_TEXTURE_SHARED_SIZE
-
---------------------------------------------------------------------------------
-
-type TextureQuery a = Either TextureTarget CubeMapTarget -> Level -> GettableStateVar a
-
-textureInternalFormat :: TextureQuery PixelInternalFormat
-textureInternalFormat t level =
- makeGettableStateVar $
- getTexLevelParameteri unmarshalPixelInternalFormat NoProxy t level TextureInternalFormat
-
-textureSize1D :: TextureQuery TextureSize1D
-textureSize1D t level =
- makeGettableStateVar $
- getTexLevelParameteri (TextureSize1D . fromIntegral) NoProxy t level TextureWidth
-
-textureSize2D :: TextureQuery TextureSize2D
-textureSize2D t level =
- makeGettableStateVar $
- liftM2 TextureSize2D
- (getTexLevelParameteri fromIntegral NoProxy t level TextureWidth )
- (getTexLevelParameteri fromIntegral NoProxy t level TextureHeight)
-
-textureSize3D :: TextureQuery TextureSize3D
-textureSize3D t level =
- makeGettableStateVar $
- liftM3 TextureSize3D
- (getTexLevelParameteri fromIntegral NoProxy t level TextureWidth )
- (getTexLevelParameteri fromIntegral NoProxy t level TextureHeight)
- (getTexLevelParameteri fromIntegral NoProxy t level TextureDepth )
-
-textureBorder :: TextureQuery Border
-textureBorder t level =
- makeGettableStateVar $
- getTexLevelParameteri fromIntegral NoProxy t level TextureBorder
-
-textureRGBASizes :: TextureQuery (Color4 GLsizei)
-textureRGBASizes t level =
- makeGettableStateVar $
- liftM4 Color4
- (getTexLevelParameteri fromIntegral NoProxy t level TextureRedSize )
- (getTexLevelParameteri fromIntegral NoProxy t level TextureGreenSize)
- (getTexLevelParameteri fromIntegral NoProxy t level TextureBlueSize )
- (getTexLevelParameteri fromIntegral NoProxy t level TextureAlphaSize)
-
-textureSharedSize :: TextureQuery GLsizei
-textureSharedSize t level =
- makeGettableStateVar $
- getTexLevelParameteri fromIntegral NoProxy t level TextureSharedSize
-
-textureIntensitySize :: TextureQuery GLsizei
-textureIntensitySize t level =
- makeGettableStateVar $
- getTexLevelParameteri fromIntegral NoProxy t level TextureIntensitySize
-
-textureLuminanceSize :: TextureQuery GLsizei
-textureLuminanceSize t level =
- makeGettableStateVar $
- getTexLevelParameteri fromIntegral NoProxy t level TextureLuminanceSize
-
-textureIndexSize :: TextureQuery GLsizei
-textureIndexSize t level =
- makeGettableStateVar $
- getTexLevelParameteri fromIntegral NoProxy t level TextureIndexSize
-
-textureDepthBits :: TextureQuery GLsizei
-textureDepthBits t level =
- makeGettableStateVar $
- getTexLevelParameteri fromIntegral NoProxy t level DepthBits
-
-textureCompressedImageSize :: TextureQuery (Maybe GLsizei)
-textureCompressedImageSize t level =
- makeGettableStateVar $ do
- isCompressed <- getTexLevelParameteri unmarshalGLboolean NoProxy t level TextureCompressed
- if isCompressed
- then getTexLevelParameteri (Just . fromIntegral) NoProxy t level TextureCompressedImageSize
- else return Nothing
-
-textureProxyOK :: TextureQuery Bool
-textureProxyOK t level =
- makeGettableStateVar $
- getTexLevelParameteri unmarshalGLboolean Proxy t level TextureWidth
-
-getTexLevelParameteri :: (GLint -> a) -> Proxy -> Either TextureTarget CubeMapTarget -> Level -> TexLevelParameter -> IO a
-getTexLevelParameteri f proxy t level p =
- alloca $ \buf -> do
- glGetTexLevelParameteriv (either (marshalProxyTextureTarget proxy) (\c -> if proxy == Proxy then marshalProxyTextureTarget Proxy TextureCubeMap else marshalCubeMapTarget c) t) level (marshalTexLevelParameter p) buf
- peek1 f buf
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.Queries
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs b/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs
@@ -1,258 +1,352 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.Specification
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 3.8.1 (Texture Image Specification),
--- section 3.8.2 (Alternate Texture Image Specification Commands), and section
--- 3.8.3 (Compressed Texture Images) of the OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.Specification (
- -- * Texture-related Data Types
- TextureTarget(..), CubeMapTarget(..), Level, Border,
- TexturePosition1D(..), TexturePosition2D(..), TexturePosition3D(..),
- TextureSize1D(..), TextureSize2D(..), TextureSize3D(..),
-
- -- * Texture Image Specification
- texImage1D, texImage2D, texImage3D,
- copyTexImage1D, copyTexImage2D,
- texSubImage1D, texSubImage2D, texSubImage3D,
- getTexImage,
-
- -- * Alternate Texture Image Specification Commands
- copyTexSubImage1D, copyTexSubImage2D, copyTexSubImage3D,
-
- -- * Compressed Texture Images
- CompressedTextureFormat(..), compressedTextureFormats,
- CompressedPixelData(..),
- compressedTexImage1D, compressedTexImage2D, compressedTexImage3D,
- compressedTexSubImage1D, compressedTexSubImage2D, compressedTexSubImage3D,
- getCompressedTexImage,
-
- -- * Implementation-Dependent Limits
- maxTextureSize
-) where
-
-import Foreign.Ptr
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.PixelData
-import Graphics.Rendering.OpenGL.GL.PixelRectangles
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-type Level = GLint
-
-type Border = GLint
-
-newtype TexturePosition1D = TexturePosition1D GLint
- deriving ( Eq, Ord, Show )
-
-data TexturePosition2D = TexturePosition2D !GLint !GLint
- deriving ( Eq, Ord, Show )
-
-data TexturePosition3D = TexturePosition3D !GLint !GLint !GLint
- deriving ( Eq, Ord, Show )
-
-newtype TextureSize1D = TextureSize1D GLsizei
- deriving ( Eq, Ord, Show )
-
-data TextureSize2D = TextureSize2D !GLsizei !GLsizei
- deriving ( Eq, Ord, Show )
-
-data TextureSize3D = TextureSize3D !GLsizei !GLsizei !GLsizei
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
-texImage1D :: Proxy -> Level -> PixelInternalFormat -> TextureSize1D -> Border -> PixelData a -> IO ()
-texImage1D proxy level int (TextureSize1D w) border pd =
- withPixelData pd $
- glTexImage1D
- (marshalProxyTextureTarget proxy Texture1D)
- level (marshalPixelInternalFormat int) w border
-
---------------------------------------------------------------------------------
-
-texImage2D :: Maybe CubeMapTarget -> Proxy -> Level -> PixelInternalFormat -> TextureSize2D -> Border -> PixelData a -> IO ()
-texImage2D mbCubeMap proxy level int (TextureSize2D w h) border pd =
- withPixelData pd $
- glTexImage2D
- (maybe (marshalProxyTextureTarget proxy Texture2D)
- (\c -> if proxy == Proxy then marshalProxyTextureTarget Proxy TextureCubeMap else marshalCubeMapTarget c)
- mbCubeMap)
- level (marshalPixelInternalFormat int) w h border
-
---------------------------------------------------------------------------------
-
-texImage3D :: Proxy -> Level -> PixelInternalFormat -> TextureSize3D -> Border -> PixelData a -> IO ()
-texImage3D proxy level int (TextureSize3D w h d) border pd =
- withPixelData pd $
- glTexImage3D
- (marshalProxyTextureTarget proxy Texture3D)
- level (marshalPixelInternalFormat int) w h d border
-
---------------------------------------------------------------------------------
-
-getTexImage :: Either TextureTarget CubeMapTarget -> Level -> PixelData a -> IO ()
-getTexImage t level pd =
- withPixelData pd $
- glGetTexImage (either marshalTextureTarget marshalCubeMapTarget t) level
-
---------------------------------------------------------------------------------
-
-copyTexImage1D :: Level -> PixelInternalFormat -> Position -> TextureSize1D -> Border -> IO ()
-copyTexImage1D level int (Position x y) (TextureSize1D w) border =
- glCopyTexImage1D
- (marshalTextureTarget Texture1D) level
- (marshalPixelInternalFormat' int) x y w border
-
---------------------------------------------------------------------------------
-
-copyTexImage2D :: Maybe CubeMapTarget -> Level -> PixelInternalFormat -> Position -> TextureSize2D -> Border -> IO ()
-copyTexImage2D mbCubeMap level int (Position x y) (TextureSize2D w h) border =
- glCopyTexImage2D
- (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level
- (marshalPixelInternalFormat' int) x y w h border
-
---------------------------------------------------------------------------------
-
-texSubImage1D :: Level -> TexturePosition1D -> TextureSize1D -> PixelData a -> IO ()
-texSubImage1D level (TexturePosition1D xOff) (TextureSize1D w) pd =
- withPixelData pd $
- glTexSubImage1D (marshalTextureTarget Texture1D) level xOff w
-
---------------------------------------------------------------------------------
-
-texSubImage2D :: Maybe CubeMapTarget -> Level -> TexturePosition2D -> TextureSize2D -> PixelData a -> IO ()
-texSubImage2D mbCubeMap level (TexturePosition2D xOff yOff) (TextureSize2D w h) pd =
- withPixelData pd $
- glTexSubImage2D (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level xOff yOff w h
-
---------------------------------------------------------------------------------
-
-texSubImage3D :: Level -> TexturePosition3D -> TextureSize3D -> PixelData a -> IO ()
-texSubImage3D level (TexturePosition3D xOff yOff zOff) (TextureSize3D w h d) pd =
- withPixelData pd $
- glTexSubImage3D (marshalTextureTarget Texture3D) level xOff yOff zOff w h d
-
---------------------------------------------------------------------------------
-
-copyTexSubImage1D :: Level -> TexturePosition1D -> Position -> TextureSize1D -> IO ()
-copyTexSubImage1D level (TexturePosition1D xOff) (Position x y) (TextureSize1D w) =
- glCopyTexSubImage1D (marshalTextureTarget Texture1D) level xOff x y w
-
---------------------------------------------------------------------------------
-
-copyTexSubImage2D :: Maybe CubeMapTarget -> Level -> TexturePosition2D -> Position -> TextureSize2D -> IO ()
-copyTexSubImage2D mbCubeMap level (TexturePosition2D xOff yOff) (Position x y) (TextureSize2D w h) =
- glCopyTexSubImage2D (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level xOff yOff x y w h
-
---------------------------------------------------------------------------------
-
-copyTexSubImage3D :: Level -> TexturePosition3D -> Position -> TextureSize2D -> IO ()
-copyTexSubImage3D level (TexturePosition3D xOff yOff zOff) (Position x y) (TextureSize2D w h) =
- glCopyTexSubImage3D (marshalTextureTarget Texture3D) level xOff yOff zOff x y w h
-
---------------------------------------------------------------------------------
-
-newtype CompressedTextureFormat = CompressedTextureFormat GLenum
- deriving ( Eq, Ord, Show )
-
-compressedTextureFormats :: GettableStateVar [CompressedTextureFormat]
-compressedTextureFormats =
- makeGettableStateVar $ do
- n <- getInteger1 fromIntegral GetNumCompressedTextureFormats
--- allocaArray n $ \buf -> do
--- getIntegerv GetCompressedTextureFormats buf
--- fmap (map (CompressedTextureFormat . fromIntegral)) $ peekArray n buf
- getIntegerN (CompressedTextureFormat . fromIntegral) 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 :: Proxy -> Level -> TextureSize1D -> Border -> CompressedPixelData a -> IO ()
-compressedTexImage1D proxy level (TextureSize1D w) border cpd =
- withCompressedPixelData cpd $ \fmt ->
- glCompressedTexImage1D
- (marshalProxyTextureTarget proxy Texture1D) level fmt w border
-
---------------------------------------------------------------------------------
-
-compressedTexImage2D :: Maybe CubeMapTarget -> Proxy -> Level -> TextureSize2D -> Border -> CompressedPixelData a -> IO ()
-compressedTexImage2D mbCubeMap proxy level (TextureSize2D w h) border cpd =
- withCompressedPixelData cpd $ \fmt ->
- glCompressedTexImage2D
- (maybe (marshalProxyTextureTarget proxy Texture2D)
- (\c -> if proxy == Proxy then marshalProxyTextureTarget Proxy TextureCubeMap else marshalCubeMapTarget c)
- mbCubeMap)
- level fmt w h border
-
---------------------------------------------------------------------------------
-
-compressedTexImage3D :: Proxy -> Level -> TextureSize3D -> Border -> CompressedPixelData a -> IO ()
-compressedTexImage3D proxy level (TextureSize3D w h d) border cpd =
- withCompressedPixelData cpd $ \fmt ->
- glCompressedTexImage3D
- (marshalProxyTextureTarget proxy Texture3D) level fmt w h d border
-
---------------------------------------------------------------------------------
-
-getCompressedTexImage :: Either TextureTarget CubeMapTarget -> Level -> Ptr a -> IO ()
-getCompressedTexImage = glGetCompressedTexImage . either marshalTextureTarget marshalCubeMapTarget
-
---------------------------------------------------------------------------------
-
-compressedTexSubImage1D :: Level -> TexturePosition1D -> TextureSize1D -> CompressedPixelData a -> IO ()
-compressedTexSubImage1D level (TexturePosition1D xOff) (TextureSize1D w) cpd =
- withCompressedPixelData cpd $
- glCompressedTexSubImage1D (marshalTextureTarget Texture1D) level xOff w
-
---------------------------------------------------------------------------------
-
-compressedTexSubImage2D :: Maybe CubeMapTarget -> Level -> TexturePosition2D -> TextureSize2D -> CompressedPixelData a -> IO ()
-compressedTexSubImage2D mbCubeMap level (TexturePosition2D xOff yOff) (TextureSize2D w h) cpd =
- withCompressedPixelData cpd $
- glCompressedTexSubImage2D (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level xOff yOff w h
-
---------------------------------------------------------------------------------
-
-compressedTexSubImage3D :: Level -> TexturePosition3D -> TextureSize3D -> CompressedPixelData a -> IO ()
-compressedTexSubImage3D level (TexturePosition3D xOff yOff zOff) (TextureSize3D w h d) cpd =
- withCompressedPixelData cpd $
- glCompressedTexSubImage3D (marshalTextureTarget Texture3D) level xOff yOff zOff w h d
-
---------------------------------------------------------------------------------
-
-maxTextureSize :: TextureTarget -> GettableStateVar GLsizei
-maxTextureSize = makeGettableStateVar . getInteger1 fromIntegral . textureTargetToMaxQuery
-
-textureTargetToMaxQuery :: TextureTarget -> PName1I
-textureTargetToMaxQuery x = case x of
- Texture1D -> GetMaxTextureSize
- Texture2D -> GetMaxTextureSize
- Texture3D -> GetMax3DTextureSize
- TextureCubeMap -> GetMaxCubeMapTextureSize
- TextureRectangle -> GetMaxRectangleTextureSize
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.Specification
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs b/Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs
@@ -1,164 +1,132 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for getting\/setting texture parameters.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.TexParameter (
- TexParameter(..), texParami, texParamf, texParamC4f, getTexParameteri,
- combineTexParams, combineTexParamsMaybe
-) where
-
-import Control.Monad
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Utils
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- gl_DEPTH_TEXTURE_MODE, gl_GENERATE_MIPMAP, gl_TEXTURE_PRIORITY,
- gl_TEXTURE_RESIDENT )
-import Graphics.Rendering.OpenGL.Raw.ARB.ShadowAmbient (
- gl_TEXTURE_COMPARE_FAIL_VALUE )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.TextureFilterAnisotropic (
- gl_TEXTURE_MAX_ANISOTROPY )
-
---------------------------------------------------------------------------------
-
-data TexParameter =
- TextureMinFilter
- | TextureMagFilter
- | TextureWrapS
- | TextureWrapT
- | TextureWrapR
- | TextureBorderColor
- | TextureMinLOD
- | TextureMaxLOD
- | TextureBaseLevel
- | TextureMaxLevel
- | TexturePriority
- | TextureMaxAnisotropy
- | TextureCompare
- | TextureCompareOperator
- | TextureCompareFailValue
- | GenerateMipmap
- | TextureCompareMode
- | TextureCompareFunc
- | DepthTextureMode
- | TextureLODBias
- | TextureResident
-
-marshalTexParameter :: TexParameter -> GLenum
-marshalTexParameter x = case x of
- TextureMinFilter -> gl_TEXTURE_MIN_FILTER
- TextureMagFilter -> gl_TEXTURE_MAG_FILTER
- TextureWrapS -> gl_TEXTURE_WRAP_S
- TextureWrapT -> gl_TEXTURE_WRAP_T
- TextureWrapR -> gl_TEXTURE_WRAP_R
- TextureBorderColor -> gl_TEXTURE_BORDER_COLOR
- TextureMinLOD -> gl_TEXTURE_MIN_LOD
- TextureMaxLOD -> gl_TEXTURE_MAX_LOD
- TextureBaseLevel -> gl_TEXTURE_BASE_LEVEL
- TextureMaxLevel -> gl_TEXTURE_MAX_LEVEL
- TexturePriority -> gl_TEXTURE_PRIORITY
- TextureMaxAnisotropy -> gl_TEXTURE_MAX_ANISOTROPY
- TextureCompare -> 0x819A
- TextureCompareOperator -> 0x819B
- TextureCompareFailValue -> gl_TEXTURE_COMPARE_FAIL_VALUE
- GenerateMipmap -> gl_GENERATE_MIPMAP
- TextureCompareMode -> gl_TEXTURE_COMPARE_MODE
- TextureCompareFunc -> gl_TEXTURE_COMPARE_FUNC
- DepthTextureMode -> gl_DEPTH_TEXTURE_MODE
- TextureLODBias -> gl_TEXTURE_LOD_BIAS
- TextureResident -> gl_TEXTURE_RESIDENT
-
---------------------------------------------------------------------------------
-
-texParameter :: (GLenum -> GLenum -> b -> IO ())
- -> (a -> (b -> IO ()) -> IO ())
- -> TextureTarget -> TexParameter -> a -> IO ()
-texParameter glTexParameter marshalAct t p x =
- marshalAct x $
- glTexParameter (marshalTextureTarget t) (marshalTexParameter p)
-
---------------------------------------------------------------------------------
-
-getTexParameter :: Storable b
- => (GLenum -> GLenum -> Ptr b -> IO ())
- -> (b -> a)
- -> TextureTarget -> TexParameter -> IO a
-getTexParameter glGetTexParameter unmarshal t p =
- alloca $ \buf -> do
- glGetTexParameter (marshalTextureTarget t) (marshalTexParameter p) buf
- peek1 unmarshal buf
-
---------------------------------------------------------------------------------
-
-m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()
-m2a marshal x act = act (marshal x)
-
-texParami ::
- (GLint -> a) -> (a -> GLint) -> TexParameter -> TextureTarget -> StateVar a
-texParami unmarshal marshal p t =
- makeStateVar
- (getTexParameter glGetTexParameteriv unmarshal t p)
- (texParameter glTexParameteri (m2a marshal) t p)
-
-texParamf ::
- (GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> TextureTarget -> StateVar a
-texParamf unmarshal marshal p t =
- makeStateVar
- (getTexParameter glGetTexParameterfv unmarshal t p)
- (texParameter glTexParameterf (m2a marshal) t p)
-
-texParamC4f :: TexParameter -> TextureTarget -> StateVar (Color4 GLfloat)
-texParamC4f p t =
- makeStateVar
- (getTexParameter glGetTexParameterC4f id t p)
- (texParameter glTexParameterC4f with t p)
-
-glTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glTexParameterC4f target pname ptr = glTexParameterfv target pname (castPtr ptr)
-
-glGetTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()
-glGetTexParameterC4f target pname ptr = glGetTexParameterfv target pname (castPtr ptr)
-
-getTexParameteri :: (GLint -> a) -> TextureTarget -> TexParameter -> IO a
-getTexParameteri = getTexParameter glGetTexParameteriv
-
---------------------------------------------------------------------------------
-
-combineTexParams :: (TextureTarget -> StateVar a)
- -> (TextureTarget -> StateVar b)
- -> (TextureTarget -> StateVar (a,b))
-combineTexParams v w t =
- makeStateVar
- (liftM2 (,) (get (v t)) (get (w t)))
- (\(x,y) -> do v t $= x; w t $= y)
-
-combineTexParamsMaybe :: (TextureTarget -> StateVar Capability)
- -> (TextureTarget -> StateVar a)
- -> (TextureTarget -> StateVar (Maybe a))
-combineTexParamsMaybe enab val t =
- makeStateVar
- (do tcm <- get (enab t)
- case tcm of
- Disabled -> return Nothing
- Enabled -> fmap Just $ get (val t))
- (maybe (enab t $= Disabled)
- (\tcf -> do val t $= tcf
- enab t $= Enabled))
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.TexParameter
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/TextureObject.hs b/Graphics/Rendering/OpenGL/GL/Texturing/TextureObject.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/TextureObject.hs
@@ -0,0 +1,43 @@
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.TextureObject
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs b/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs
@@ -1,80 +1,297 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for marshaling texture targets.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (
- TextureTarget(..), marshalTextureTarget, marshalProxyTextureTarget,
- CubeMapTarget(..), marshalCubeMapTarget, unmarshalCubeMapTarget,
-) where
-
-import Graphics.Rendering.OpenGL.GL.PixelRectangles
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-data TextureTarget =
- Texture1D
- | Texture2D
- | Texture3D
- | TextureCubeMap
- | TextureRectangle
- deriving ( Eq, Ord, Show )
-
-marshalTextureTarget :: TextureTarget -> GLenum
-marshalTextureTarget x = case x of
- Texture1D -> gl_TEXTURE_1D
- Texture2D -> gl_TEXTURE_2D
- Texture3D -> gl_TEXTURE_3D
- TextureCubeMap -> gl_TEXTURE_CUBE_MAP
- TextureRectangle -> gl_TEXTURE_RECTANGLE
-
-marshalProxyTextureTarget :: Proxy -> TextureTarget -> GLenum
-marshalProxyTextureTarget NoProxy x = marshalTextureTarget x
-marshalProxyTextureTarget Proxy x = case x of
- Texture1D -> gl_PROXY_TEXTURE_1D
- Texture2D -> gl_PROXY_TEXTURE_2D
- Texture3D -> gl_PROXY_TEXTURE_3D
- TextureCubeMap -> gl_PROXY_TEXTURE_CUBE_MAP
- TextureRectangle -> gl_PROXY_TEXTURE_RECTANGLE
-
---------------------------------------------------------------------------------
-
-data CubeMapTarget =
- TextureCubeMapPositiveX
- | TextureCubeMapNegativeX
- | TextureCubeMapPositiveY
- | TextureCubeMapNegativeY
- | TextureCubeMapPositiveZ
- | TextureCubeMapNegativeZ
- deriving ( Eq, Ord, Show )
-
-marshalCubeMapTarget :: CubeMapTarget -> GLenum
-marshalCubeMapTarget x = case x of
- TextureCubeMapPositiveX -> gl_TEXTURE_CUBE_MAP_POSITIVE_X
- TextureCubeMapNegativeX -> gl_TEXTURE_CUBE_MAP_NEGATIVE_X
- TextureCubeMapPositiveY -> gl_TEXTURE_CUBE_MAP_POSITIVE_Y
- TextureCubeMapNegativeY -> gl_TEXTURE_CUBE_MAP_NEGATIVE_Y
- TextureCubeMapPositiveZ -> gl_TEXTURE_CUBE_MAP_POSITIVE_Z
- TextureCubeMapNegativeZ -> gl_TEXTURE_CUBE_MAP_NEGATIVE_Z
-
-unmarshalCubeMapTarget :: GLenum -> CubeMapTarget
-unmarshalCubeMapTarget 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 $ "unmarshalCubeMapTarget: unknown enum " ++ show x
-
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs b/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs
--- a/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs
+++ b/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs
@@ -1,47 +1,50 @@
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for (un-)marshaling TextureUnit.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit (
- TextureUnit(..), marshalTextureUnit, unmarshalTextureUnit
-) where
-
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | Identifies a texture unit via its number, which must be in the range of
--- (0 .. 'maxTextureUnit').
-
-newtype TextureUnit = TextureUnit GLuint
- deriving ( Eq, Ord, Show )
-
-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
+-- 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))
diff --git a/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs b/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs
--- a/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs
+++ b/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs
@@ -1,140 +1,124 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.TransformFeedback
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.TransformFeedback (
- -- * starting and ending
- beginTransformFeedback, endTransformFeedback,
-
- -- * TransformFeedbackBufferMode
- TransformFeedbackBufferMode(..), marshalTransformFeedbackBufferMode,
- unmarshalTransformFeedbackBufferMode,
-
- -- * Shader related
- transformFeedbackBufferMode, getTransformFeedbackVaryings,
- setTransformFeedbackVaryings, getTransformFeedbackVarying,
- getTransformFeedbackVaryingMaxLength,
-
- -- * limits
- maxTransformFeedbackSeparateAttribs,
- maxTransformFeedbackInterleavedComponents,
- maxTransformFeedbackSeparateComponents
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Storable
-
-import Graphics.Rendering.OpenGL.Raw.Core32
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.DataType
-import Graphics.Rendering.OpenGL.GL.GLstring
-import Graphics.Rendering.OpenGL.GL.PrimitiveMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Shaders.Program
-
-beginTransformFeedback :: PrimitiveMode -> IO ()
-beginTransformFeedback = glBeginTransformFeedback . marshalPrimitiveMode
-
-endTransformFeedback :: IO ()
-endTransformFeedback = glEndTransformFeedback
-
-
---TranformFeedbackBuffer mode
-data TransformFeedbackBufferMode = InterleavedAttribs | SeperateAttribs
-
-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
-
------------------------------------------------------------------------------
-
-type VaryingIndex = GLuint
-type MaxLength = GLsizei
-
---------------------------------------------------------------------------------
-
--- | 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 = programVar
- (unmarshalTransformFeedbackBufferMode . fromIntegral)
- TransformFeedbackBufferMode
-
--- | The number of varyings that are currently recorded when in
--- transform feedback mode
-getTransformFeedbackVaryings :: Program -> GettableStateVar GLuint
-getTransformFeedbackVaryings
- = programVar fromIntegral TransformFeedbackVaryings
-
--- | The maximum length of a varying's name for transform feedback mode
-getTransformFeedbackVaryingMaxLength :: Program -> GettableStateVar GLuint
-getTransformFeedbackVaryingMaxLength
- = programVar fromIntegral TransformFeedbackVaryingMaxLength
-
--- | Get the name, datatype and size of a single transform feedback
--- varying.
-getTransformFeedbackVarying :: Program
- -> VaryingIndex -- ^ the index in a previous array of names of
- -- setTransformFeedbackVaryings
- -> MaxLength -- ^ the maximum length of the returned string
- -> IO (String, DataType, GLsizei) -- ^ The name of the varying, it's type
- -- and size
-getTransformFeedbackVarying (Program program) vi ml = do
- alloca $ \nlength -> do
- alloca $ \size -> do
- alloca $ \dtype -> do
- allocaArray (fromIntegral ml) $ \name -> do
- glGetTransformFeedbackVarying program vi ml nlength size
- dtype name
- l <- peek nlength
- s <- peek size
- d <- peek dtype
- n <- peekGLstringLen (name, l)
- return (n,unmarshalDataType d, s)
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.TransformFeedback
+-- Copyright : (c) Sven Panne, Lars Corbijn 2011-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs b/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs
--- a/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs
+++ b/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs
@@ -1,54 +1,55 @@
------------------------------------------------------------------------------
---
--- Module : Graphics.Rendering.OpenGL.GL.VertexArrayObjects
--- Copyright :
--- License : BSD3
---
--- Maintainer : Sven Panne
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.VertexArrayObjects (
- VertexArrayObject,
- bindVertexArrayObject
-) where
-
-import Foreign.Marshal.Array
-
-import Graphics.Rendering.OpenGL.GL.ObjectName
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core31
-
------------------------------------------------------------------------------
-
-newtype VertexArrayObject = VertexArrayObject { vertexArrayID :: GLuint }
- deriving( Eq, Ord, Show )
-
-instance ObjectName VertexArrayObject where
- genObjectNames n = allocaArray n $ \buf -> do
- glGenVertexArrays (fromIntegral n) buf
- fmap (map VertexArrayObject) $ peekArray n buf
- deleteObjectNames bufferObjects =
- withArrayLen (map vertexArrayID bufferObjects) $
- glDeleteBuffers . fromIntegral
- isObjectName = fmap unmarshalGLboolean . glIsVertexArray . vertexArrayID
-
-bindVertexArrayObject :: StateVar (Maybe VertexArrayObject)
-bindVertexArrayObject = makeStateVar getVAO bindVAO
-
-getVAO :: IO (Maybe VertexArrayObject)
-getVAO = do
- vao <- getInteger1 (VertexArrayObject . fromIntegral) GetVertexArrayBinding
- return $ if vao == noVAO then Nothing else Just vao
-
-bindVAO :: Maybe VertexArrayObject -> IO ()
-bindVAO = glBindVertexArray . vertexArrayID . maybe noVAO id
-
-noVAO :: VertexArrayObject
-noVAO = VertexArrayObject 0
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.VertexArrayObjects
+-- Copyright : (c) Sven Panne, Lars Corbijn 2011-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/VertexArrays.hs b/Graphics/Rendering/OpenGL/GL/VertexArrays.hs
--- a/Graphics/Rendering/OpenGL/GL/VertexArrays.hs
+++ b/Graphics/Rendering/OpenGL/GL/VertexArrays.hs
@@ -1,502 +1,483 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.VertexArrays
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.8 (Vertex Arrays) of the OpenGL 2.1
--- specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.VertexArrays (
- -- * Describing Data for the Arrays
- NumComponents, DataType(..), Stride, VertexArrayDescriptor(..),
-
- -- * Specifying Data for the Arrays
- Capability(..),
- ClientArrayType(..), arrayPointer,
- InterleavedArrays(..), interleavedArrays,
-
- -- * Enabling Arrays
- clientState, clientActiveTexture,
-
- -- * Dereferencing and Rendering
- ArrayIndex, NumArrayIndices, NumIndexBlocks,
- arrayElement, drawArrays, multiDrawArrays, drawElements, multiDrawElements,
- drawRangeElements, maxElementsVertices, maxElementsIndices, lockArrays,
- primitiveRestartIndex, primitiveRestartIndexNV,
-
- -- * Generic Vertex Attribute Arrays
- vertexAttribPointer, vertexAttribArray,
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.Capability
-import Graphics.Rendering.OpenGL.GL.DataType
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PrimitiveMode
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
-import Graphics.Rendering.OpenGL.GL.VertexSpec
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glArrayElement, glClientActiveTexture, glColorPointer, glDisableClientState,
- glEdgeFlagPointer, glEnableClientState, glFogCoordPointer, glIndexPointer,
- glInterleavedArrays, glNormalPointer, glSecondaryColorPointer,
- glTexCoordPointer, glVertexPointer, gl_C3F_V3F, gl_C4F_N3F_V3F, gl_C4UB_V2F,
- gl_C4UB_V3F, gl_COLOR_ARRAY, gl_COLOR_ARRAY_POINTER, gl_EDGE_FLAG_ARRAY,
- gl_EDGE_FLAG_ARRAY_POINTER, gl_FEEDBACK_BUFFER_POINTER, gl_FOG_COORD_ARRAY,
- gl_FOG_COORD_ARRAY_POINTER, gl_INDEX_ARRAY, gl_INDEX_ARRAY_POINTER,
- gl_N3F_V3F, gl_NORMAL_ARRAY, gl_NORMAL_ARRAY_POINTER,
- gl_SECONDARY_COLOR_ARRAY, gl_SECONDARY_COLOR_ARRAY_POINTER,
- gl_SELECTION_BUFFER_POINTER, gl_T2F_C3F_V3F, gl_T2F_C4F_N3F_V3F,
- gl_T2F_C4UB_V3F, gl_T2F_N3F_V3F, gl_T2F_V3F, gl_T4F_C4F_N3F_V4F, gl_T4F_V4F,
- gl_TEXTURE_COORD_ARRAY, gl_TEXTURE_COORD_ARRAY_POINTER, gl_V2F, gl_V3F,
- gl_VERTEX_ARRAY, gl_VERTEX_ARRAY_POINTER )
-import Graphics.Rendering.OpenGL.Raw.ARB.MatrixPalette (
- gl_MATRIX_INDEX_ARRAY, gl_MATRIX_INDEX_ARRAY_POINTER )
-import Graphics.Rendering.OpenGL.Raw.ARB.VertexBlend ( gl_WEIGHT_ARRAY_POINTER )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.Raw.EXT.CompiledVertexArray
-import Graphics.Rendering.OpenGL.Raw.NV.PrimitiveRestart
-
---------------------------------------------------------------------------------
-
-type NumComponents = GLint
-
-type Stride = GLsizei
-
-data VertexArrayDescriptor a =
- VertexArrayDescriptor !NumComponents !DataType !Stride !(Ptr a)
- deriving ( Eq, Ord, Show )
-
-noVertexArrayDescriptor :: VertexArrayDescriptor a
-noVertexArrayDescriptor = VertexArrayDescriptor 0 Byte 0 nullPtr
-
---------------------------------------------------------------------------------
-
-data ClientArrayType =
- VertexArray
- | NormalArray
- | ColorArray
- | IndexArray
- | TextureCoordArray
- | EdgeFlagArray
- | FogCoordArray
- | SecondaryColorArray
- | MatrixIndexArray
- deriving ( Eq, Ord, Show )
-
-marshalClientArrayType :: ClientArrayType -> GLenum
-marshalClientArrayType x = case x of
- VertexArray -> gl_VERTEX_ARRAY
- NormalArray -> gl_NORMAL_ARRAY
- ColorArray -> gl_COLOR_ARRAY
- IndexArray -> gl_INDEX_ARRAY
- TextureCoordArray -> gl_TEXTURE_COORD_ARRAY
- EdgeFlagArray -> gl_EDGE_FLAG_ARRAY
- FogCoordArray -> gl_FOG_COORD_ARRAY
- SecondaryColorArray -> gl_SECONDARY_COLOR_ARRAY
- MatrixIndexArray -> gl_MATRIX_INDEX_ARRAY
-
--- Hmmm...
-clientArrayTypeToEnableCap :: ClientArrayType -> EnableCap
-clientArrayTypeToEnableCap x = case x of
- VertexArray -> CapVertexArray
- NormalArray -> CapNormalArray
- ColorArray -> CapColorArray
- IndexArray -> CapIndexArray
- TextureCoordArray -> CapTextureCoordArray
- EdgeFlagArray -> CapEdgeFlagArray
- FogCoordArray -> CapFogCoordArray
- SecondaryColorArray -> CapSecondaryColorArray
- MatrixIndexArray -> CapMatrixIndexArray
-
---------------------------------------------------------------------------------
-
-arrayPointer :: ClientArrayType -> StateVar (VertexArrayDescriptor a)
-arrayPointer t = case t of
- VertexArray -> vertexPointer
- NormalArray -> normalPointer
- ColorArray -> colorPointer
- IndexArray -> indexPointer
- TextureCoordArray -> texCoordPointer
- EdgeFlagArray -> edgeFlagPointer
- FogCoordArray -> fogCoordPointer
- SecondaryColorArray -> secondaryColorPointer
- MatrixIndexArray ->
- makeStateVar
- (do recordInvalidEnum ; return noVertexArrayDescriptor)
- (const recordInvalidEnum)
-
-check :: Bool -> IO () -> IO ()
-check flag val = if flag then val else recordInvalidValue
-
---------------------------------------------------------------------------------
-
-vertexPointer :: StateVar (VertexArrayDescriptor a)
-vertexPointer = makeStateVar getVertexPointer setVertexPointer
-
-getVertexPointer :: IO (VertexArrayDescriptor a)
-getVertexPointer = do
- n <- getInteger1 id GetVertexArraySize
- d <- getEnum1 unmarshalDataType GetVertexArrayType
- s <- getInteger1 fromIntegral GetVertexArrayStride
- p <- getPointer VertexArrayPointer
- return $ VertexArrayDescriptor n d s p
-
-setVertexPointer :: VertexArrayDescriptor a -> IO ()
-setVertexPointer (VertexArrayDescriptor n d s p) =
- glVertexPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-normalPointer :: StateVar (VertexArrayDescriptor a)
-normalPointer = makeStateVar getNormalPointer setNormalPointer
-
-getNormalPointer :: IO (VertexArrayDescriptor a)
-getNormalPointer = do
- d <- getEnum1 unmarshalDataType GetNormalArrayType
- s <- getInteger1 fromIntegral GetNormalArrayStride
- p <- getPointer NormalArrayPointer
- return $ VertexArrayDescriptor 3 d s p
-
-setNormalPointer :: VertexArrayDescriptor a -> IO ()
-setNormalPointer (VertexArrayDescriptor n d s p) =
- check (n == 3) $ glNormalPointer (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-colorPointer :: StateVar (VertexArrayDescriptor a)
-colorPointer = makeStateVar getColorPointer setColorPointer
-
-getColorPointer :: IO (VertexArrayDescriptor a)
-getColorPointer = do
- n <- getInteger1 id GetColorArraySize
- d <- getEnum1 unmarshalDataType GetColorArrayType
- s <- getInteger1 fromIntegral GetColorArrayStride
- p <- getPointer ColorArrayPointer
- return $ VertexArrayDescriptor n d s p
-
-setColorPointer :: VertexArrayDescriptor a -> IO ()
-setColorPointer (VertexArrayDescriptor n d s p) =
- check (n == 3 || n == 4) $ glColorPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-indexPointer :: StateVar (VertexArrayDescriptor a)
-indexPointer = makeStateVar getIndexPointer setIndexPointer
-
-getIndexPointer :: IO (VertexArrayDescriptor a)
-getIndexPointer = do
- d <- getEnum1 unmarshalDataType GetIndexArrayType
- s <- getInteger1 fromIntegral GetIndexArrayStride
- p <- getPointer IndexArrayPointer
- return $ VertexArrayDescriptor 1 d s p
-
-setIndexPointer :: VertexArrayDescriptor a -> IO ()
-setIndexPointer (VertexArrayDescriptor n d s p) =
- check (n == 1) $ glIndexPointer (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-texCoordPointer :: StateVar (VertexArrayDescriptor a)
-texCoordPointer = makeStateVar getTexCoordPointer setTexCoordPointer
-
-getTexCoordPointer :: IO (VertexArrayDescriptor a)
-getTexCoordPointer = do
- n <- getInteger1 id GetTextureCoordArraySize
- d <- getEnum1 unmarshalDataType GetTextureCoordArrayType
- s <- getInteger1 fromIntegral GetTextureCoordArrayStride
- p <- getPointer TextureCoordArrayPointer
- return $ VertexArrayDescriptor n d s p
-
-setTexCoordPointer :: VertexArrayDescriptor a -> IO ()
-setTexCoordPointer (VertexArrayDescriptor n d s p) =
- glTexCoordPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-edgeFlagPointer :: StateVar (VertexArrayDescriptor a)
-edgeFlagPointer = makeStateVar getEdgeFlagPointer setEdgeFlagPointer
-
-getEdgeFlagPointer :: IO (VertexArrayDescriptor a)
-getEdgeFlagPointer = do
- s <- getInteger1 fromIntegral GetEdgeFlagArrayStride
- p <- getPointer EdgeFlagArrayPointer
- return $ VertexArrayDescriptor 1 UnsignedByte s p
-
-setEdgeFlagPointer :: VertexArrayDescriptor a -> IO ()
-setEdgeFlagPointer (VertexArrayDescriptor n d s p) =
- check (n == 1 && d == UnsignedByte) $ glEdgeFlagPointer s p
-
---------------------------------------------------------------------------------
-
-fogCoordPointer :: StateVar (VertexArrayDescriptor a)
-fogCoordPointer = makeStateVar getFogCoordPointer setFogCoordPointer
-
-getFogCoordPointer :: IO (VertexArrayDescriptor a)
-getFogCoordPointer = do
- d <- getEnum1 unmarshalDataType GetFogCoordArrayType
- s <- getInteger1 fromIntegral GetFogCoordArrayStride
- p <- getPointer FogCoordArrayPointer
- return $ VertexArrayDescriptor 1 d s p
-
-setFogCoordPointer :: VertexArrayDescriptor a -> IO ()
-setFogCoordPointer (VertexArrayDescriptor n d s p) =
- check (n == 1) $ glFogCoordPointer (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-secondaryColorPointer :: StateVar (VertexArrayDescriptor a)
-secondaryColorPointer =
- makeStateVar getSecondaryColorPointer setSecondaryColorPointer
-
-getSecondaryColorPointer :: IO (VertexArrayDescriptor a)
-getSecondaryColorPointer = do
- n <- getInteger1 id GetSecondaryColorArraySize
- d <- getEnum1 unmarshalDataType GetSecondaryColorArrayType
- s <- getInteger1 fromIntegral GetSecondaryColorArrayStride
- p <- getPointer SecondaryColorArrayPointer
- return $ VertexArrayDescriptor n d s p
-
-setSecondaryColorPointer :: (VertexArrayDescriptor a) -> IO ()
-setSecondaryColorPointer (VertexArrayDescriptor n d s p) =
- glSecondaryColorPointer n (marshalDataType d) s p
-
---------------------------------------------------------------------------------
-
-data InterleavedArrays =
- V2f
- | V3f
- | C4ubV2f
- | C4ubV3f
- | C3fV3f
- | N3fV3f
- | C4fN3fV3f
- | T2fV3f
- | T4fV4f
- | T2fC4ubV3f
- | T2fC3fV3f
- | T2fN3fV3f
- | T2fC4fN3fV3f
- | T4fC4fN3fV4f
- deriving ( Eq, Ord, Show )
-
-marshalInterleavedArrays :: InterleavedArrays -> GLenum
-marshalInterleavedArrays x = case x of
- V2f -> gl_V2F
- V3f -> gl_V3F
- C4ubV2f -> gl_C4UB_V2F
- C4ubV3f -> gl_C4UB_V3F
- C3fV3f -> gl_C3F_V3F
- N3fV3f -> gl_N3F_V3F
- C4fN3fV3f -> gl_C4F_N3F_V3F
- T2fV3f -> gl_T2F_V3F
- T4fV4f -> gl_T4F_V4F
- T2fC4ubV3f -> gl_T2F_C4UB_V3F
- T2fC3fV3f -> gl_T2F_C3F_V3F
- T2fN3fV3f -> gl_T2F_N3F_V3F
- T2fC4fN3fV3f -> gl_T2F_C4F_N3F_V3F
- T4fC4fN3fV4f -> gl_T4F_C4F_N3F_V4F
-
---------------------------------------------------------------------------------
-
-interleavedArrays :: InterleavedArrays -> Stride -> Ptr a -> IO ()
-interleavedArrays = glInterleavedArrays . marshalInterleavedArrays
-
---------------------------------------------------------------------------------
-
-clientState :: ClientArrayType -> StateVar Capability
-clientState arrayType =
- makeStateVar (getClientState arrayType) (setClientState arrayType)
-
-getClientState :: ClientArrayType -> IO Capability
-getClientState arrayType = get . makeCapability . clientArrayTypeToEnableCap $ arrayType
-
-setClientState :: ClientArrayType -> Capability -> IO ()
-setClientState arrayType val =
- (if val == Enabled then glEnableClientState else glDisableClientState)
- (marshalClientArrayType arrayType)
-
---------------------------------------------------------------------------------
-
-clientActiveTexture :: StateVar TextureUnit
-clientActiveTexture =
- makeStateVar (getEnum1 unmarshalTextureUnit GetClientActiveTexture)
- (glClientActiveTexture . marshalTextureUnit)
-
---------------------------------------------------------------------------------
-
-type ArrayIndex = GLint
-
-type NumArrayIndices = GLsizei
-
-type NumIndexBlocks = GLsizei
-
---------------------------------------------------------------------------------
-
-arrayElement :: ArrayIndex -> IO ()
-arrayElement = glArrayElement
-
-drawArrays :: PrimitiveMode -> ArrayIndex -> NumArrayIndices -> IO ()
-drawArrays = glDrawArrays . marshalPrimitiveMode
-
-multiDrawArrays ::
- PrimitiveMode -> Ptr ArrayIndex -> Ptr NumArrayIndices -> NumIndexBlocks
- -> IO ()
-multiDrawArrays = glMultiDrawArrays . marshalPrimitiveMode
-
-drawElements :: PrimitiveMode -> NumArrayIndices -> DataType -> Ptr a -> IO ()
-drawElements m c = glDrawElements (marshalPrimitiveMode m) c . marshalDataType
-
-multiDrawElements ::
- PrimitiveMode -> Ptr NumArrayIndices -> DataType -> Ptr (Ptr a)
- -> NumIndexBlocks -> IO ()
-multiDrawElements m c =
- glMultiDrawElements (marshalPrimitiveMode m) c . marshalDataType
-
-drawRangeElements ::
- PrimitiveMode -> (ArrayIndex, ArrayIndex) -> NumArrayIndices -> DataType
- -> Ptr a -> IO ()
-drawRangeElements m (s, e) c =
- glDrawRangeElements (marshalPrimitiveMode m) (fromIntegral s)
- (fromIntegral e) c . marshalDataType
-
-maxElementsVertices :: GettableStateVar NumArrayIndices
-maxElementsVertices = makeGettableStateVar (getSizei1 id GetMaxElementsVertices)
-
-maxElementsIndices :: GettableStateVar NumArrayIndices
-maxElementsIndices = makeGettableStateVar (getSizei1 id GetMaxElementsIndices)
-
---------------------------------------------------------------------------------
-
-lockArrays :: StateVar (Maybe (ArrayIndex, NumArrayIndices))
-lockArrays = makeStateVar getLockArrays setLockArrays
-
-getLockArrays :: IO (Maybe (ArrayIndex, NumArrayIndices))
-getLockArrays = do
- count <- getInteger1 fromIntegral GetArrayElementLockCount
- if count > 0
- then do first <- getInteger1 id GetArrayElementLockFirst
- return $ Just (first, count)
- else return Nothing
-
-setLockArrays :: Maybe (ArrayIndex, NumArrayIndices) -> IO ()
-setLockArrays = maybe glUnlockArrays (uncurry glLockArrays)
-
---------------------------------------------------------------------------------
-
-primitiveRestartIndex :: StateVar (Maybe ArrayIndex)
-primitiveRestartIndex =
- makeStateVarMaybe
- (return CapPrimitiveRestart)
- (getInteger1 id GetPrimitiveRestartIndex)
- (glPrimitiveRestartIndex . fromIntegral)
-
---------------------------------------------------------------------------------
-
--- We almost could use makeStateVarMaybe below, but, alas, this is client state.
-
-primitiveRestartIndexNV :: StateVar (Maybe ArrayIndex)
-primitiveRestartIndexNV =
- makeStateVar getPrimitiveRestartIndexNV setPrimitiveRestartIndexNV
-
-getPrimitiveRestartIndexNV :: IO (Maybe ArrayIndex)
-getPrimitiveRestartIndexNV = do
- on <- getBoolean1 unmarshalGLboolean GetPrimitiveRestartNV
- if on
- then fmap Just $ getInteger1 fromIntegral GetPrimitiveRestartIndexNV
- else return Nothing
-
-setPrimitiveRestartIndexNV :: Maybe ArrayIndex -> IO ()
-setPrimitiveRestartIndexNV maybeIdx = case maybeIdx of
- Nothing -> glDisableClientState gl_PRIMITIVE_RESTART_NV
- Just idx -> do glEnableClientState gl_PRIMITIVE_RESTART_NV
- glPrimitiveRestartIndexNV (fromIntegral idx)
-
---------------------------------------------------------------------------------
-
-data GetPointervPName =
- VertexArrayPointer
- | NormalArrayPointer
- | ColorArrayPointer
- | IndexArrayPointer
- | TextureCoordArrayPointer
- | EdgeFlagArrayPointer
- | FogCoordArrayPointer
- | SecondaryColorArrayPointer
- | FeedbackBufferPointer
- | SelectionBufferPointer
- | WeightArrayPointer
- | MatrixIndexArrayPointer
-
-marshalGetPointervPName :: GetPointervPName -> GLenum
-marshalGetPointervPName x = case x of
- VertexArrayPointer -> gl_VERTEX_ARRAY_POINTER
- NormalArrayPointer -> gl_NORMAL_ARRAY_POINTER
- ColorArrayPointer -> gl_COLOR_ARRAY_POINTER
- IndexArrayPointer -> gl_INDEX_ARRAY_POINTER
- TextureCoordArrayPointer -> gl_TEXTURE_COORD_ARRAY_POINTER
- EdgeFlagArrayPointer -> gl_EDGE_FLAG_ARRAY_POINTER
- FogCoordArrayPointer -> gl_FOG_COORD_ARRAY_POINTER
- SecondaryColorArrayPointer -> gl_SECONDARY_COLOR_ARRAY_POINTER
- FeedbackBufferPointer -> gl_FEEDBACK_BUFFER_POINTER
- SelectionBufferPointer -> gl_SELECTION_BUFFER_POINTER
- WeightArrayPointer -> gl_WEIGHT_ARRAY_POINTER
- MatrixIndexArrayPointer -> gl_MATRIX_INDEX_ARRAY_POINTER
-
---------------------------------------------------------------------------------
-
-getPointer :: GetPointervPName -> IO (Ptr a)
-getPointer n = alloca $ \buf -> do
- glGetPointerv (marshalGetPointervPName n) buf
- peek buf
-
---------------------------------------------------------------------------------
-
-vertexAttribPointer :: AttribLocation -> StateVar (IntegerHandling, VertexArrayDescriptor a)
-vertexAttribPointer location =
- makeStateVar (getVertexAttribPointer_ location) (setVertexAttribPointer location)
-
-getVertexAttribPointer_ :: AttribLocation -> IO (IntegerHandling, VertexArrayDescriptor a)
-getVertexAttribPointer_ location = do
- i <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayInteger
- h <- if i
- then return KeepIntegral
- else do f <- getVertexAttribBoolean1 unmarshalGLboolean location GetVertexAttribArrayNormalized
- return $ if f then ToNormalizedFloat else ToFloat
- n <- getVertexAttribInteger1 id location GetVertexAttribArraySize
- d <- getVertexAttribEnum1 unmarshalDataType location GetVertexAttribArrayType
- s <- getVertexAttribInteger1 fromIntegral location GetVertexAttribArrayStride
- p <- getVertexAttribPointer location VertexAttribArrayPointer
- return (h, VertexArrayDescriptor n d s p)
-
-setVertexAttribPointer :: AttribLocation -> (IntegerHandling, VertexArrayDescriptor a) -> IO ()
-setVertexAttribPointer (AttribLocation location) (h, VertexArrayDescriptor n d s p) = case h of
- ToFloat -> glVertexAttribPointer location n md (marshalGLboolean False) s p
- ToNormalizedFloat -> glVertexAttribPointer location n md (marshalGLboolean True) s p
- KeepIntegral -> glVertexAttribIPointer location n md s p
- where md = marshalDataType d
-
---------------------------------------------------------------------------------
-
-vertexAttribArray :: AttribLocation -> StateVar Capability
-vertexAttribArray location =
- makeStateVar (getVertexAttribArray location) (flip setVertexAttribArray location)
-
-getVertexAttribArray :: AttribLocation -> IO Capability
-getVertexAttribArray location =
- getVertexAttribBoolean1 unmarshalCapability location GetVertexAttribArrayEnabled
-
-setVertexAttribArray :: Capability -> AttribLocation -> IO ()
-setVertexAttribArray Disabled (AttribLocation location) = glDisableVertexAttribArray location
-setVertexAttribArray Enabled (AttribLocation location) = glEnableVertexAttribArray location
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.VertexArrays
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs b/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs
--- a/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs
+++ b/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs
@@ -1,332 +1,332 @@
-{-# LANGUAGE DeriveDataTypeable #-}
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.VertexAttributes
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module for auxiliary vertex attributes.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GL.VertexAttributes (
- TexCoord1(..), TexCoord2(..), TexCoord3(..), TexCoord4(..),
- Normal3(..),
- FogCoord1(..),
- Color3(..), Color4(..),
- Index1(..)
-) where
-
-import Control.Applicative
-import Control.Monad
-import Data.Foldable
-import Data.Ix
-import Data.Traversable
-import Data.Typeable
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-
---------------------------------------------------------------------------------
-
--- | Texture coordinates with /t/=0, /r/=0, and /q/=1.
-newtype TexCoord1 a = TexCoord1 a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord1 where
- fmap f (TexCoord1 x) = TexCoord1 (f x)
-
-instance Applicative TexCoord1 where
- pure a = TexCoord1 a
- TexCoord1 f <*> TexCoord1 x = TexCoord1 (f x)
-
-instance Foldable TexCoord1 where
- foldr f a (TexCoord1 x) = x `f ` a
- foldl f a (TexCoord1 x) = a `f` x
- foldr1 _ (TexCoord1 x) = x
- foldl1 _ (TexCoord1 x) = x
-
-instance Traversable TexCoord1 where
- traverse f (TexCoord1 x) = pure TexCoord1 <*> f x
- sequenceA (TexCoord1 x) = pure TexCoord1 <*> x
- mapM f (TexCoord1 x) = return TexCoord1 `ap` f x
- sequence (TexCoord1 x) = return TexCoord1 `ap` x
-
-instance Storable a => Storable (TexCoord1 a) where
- sizeOf ~(TexCoord1 s) = sizeOf s
- alignment ~(TexCoord1 s) = alignment s
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | Texture coordinates with /r/=0 and /q/=1.
-data TexCoord2 a = TexCoord2 !a !a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord2 where
- fmap f (TexCoord2 x y) = TexCoord2 (f x) (f y)
-
-instance Applicative TexCoord2 where
- pure a = TexCoord2 a a
- TexCoord2 f g <*> TexCoord2 x y = TexCoord2 (f x) (g y)
-
-instance Foldable TexCoord2 where
- foldr f a (TexCoord2 x y) = x `f ` (y `f` a)
- foldl f a (TexCoord2 x y) = (a `f` x) `f` y
- foldr1 f (TexCoord2 x y) = x `f` y
- foldl1 f (TexCoord2 x y) = x `f` y
-
-instance Traversable TexCoord2 where
- traverse f (TexCoord2 x y) = pure TexCoord2 <*> f x <*> f y
- sequenceA (TexCoord2 x y) = pure TexCoord2 <*> x <*> y
- mapM f (TexCoord2 x y) = return TexCoord2 `ap` f x `ap` f y
- sequence (TexCoord2 x y) = return TexCoord2 `ap` x `ap` y
-
-instance Storable a => Storable (TexCoord2 a) where
- sizeOf ~(TexCoord2 x _) = 2 * sizeOf x
- alignment ~(TexCoord2 x _) = alignment x
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | Texture coordinates with /q/=1.
-data TexCoord3 a = TexCoord3 !a !a !a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord3 where
- fmap f (TexCoord3 x y z) = TexCoord3 (f x) (f y) (f z)
-
-instance Applicative TexCoord3 where
- pure a = TexCoord3 a a a
- TexCoord3 f g h <*> TexCoord3 x y z = TexCoord3 (f x) (g y) (h z)
-
-instance Foldable TexCoord3 where
- foldr f a (TexCoord3 x y z) = x `f ` (y `f` (z `f` a))
- foldl f a (TexCoord3 x y z) = ((a `f` x) `f` y) `f` z
- foldr1 f (TexCoord3 x y z) = x `f` (y `f` z)
- foldl1 f (TexCoord3 x y z) = (x `f` y) `f` z
-
-instance Traversable TexCoord3 where
- traverse f (TexCoord3 x y z) = pure TexCoord3 <*> f x <*> f y <*> f z
- sequenceA (TexCoord3 x y z) = pure TexCoord3 <*> x <*> y <*> z
- mapM f (TexCoord3 x y z) = return TexCoord3 `ap` f x `ap` f y `ap` f z
- sequence (TexCoord3 x y z) = return TexCoord3 `ap` x `ap` y `ap` z
-
-instance Storable a => Storable (TexCoord3 a) where
- sizeOf ~(TexCoord3 x _ _) = 3 * sizeOf x
- alignment ~(TexCoord3 x _ _) = alignment x
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | Fully-fledged four-dimensional texture coordinates.
-data TexCoord4 a = TexCoord4 !a !a !a !a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor TexCoord4 where
- fmap f (TexCoord4 x y z w) = TexCoord4 (f x) (f y) (f z) (f w)
-
-instance Applicative TexCoord4 where
- pure a = TexCoord4 a a a a
- TexCoord4 f g h i <*> TexCoord4 x y z w = TexCoord4 (f x) (g y) (h z) (i w)
-
-instance Foldable TexCoord4 where
- foldr f a (TexCoord4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))
- foldl f a (TexCoord4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w
- foldr1 f (TexCoord4 x y z w) = x `f` (y `f` (z `f` w))
- foldl1 f (TexCoord4 x y z w) = ((x `f` y) `f` z) `f` w
-
-instance Traversable TexCoord4 where
- traverse f (TexCoord4 x y z w) = pure TexCoord4 <*> f x <*> f y <*> f z <*> f w
- sequenceA (TexCoord4 x y z w) = pure TexCoord4 <*> x <*> y <*> z <*> w
- mapM f (TexCoord4 x y z w) = return TexCoord4 `ap` f x `ap` f y `ap` f z `ap` f w
- sequence (TexCoord4 x y z w) = return TexCoord4 `ap` x `ap` y `ap` z `ap` w
-
-instance Storable a => Storable (TexCoord4 a) where
- sizeOf ~(TexCoord4 x _ _ _) = 4 * sizeOf x
- alignment ~(TexCoord4 x _ _ _) = alignment x
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- A three-dimensional normal.
-data Normal3 a = Normal3 !a !a !a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-instance Functor Normal3 where
- fmap f (Normal3 x y z) = Normal3 (f x) (f y) (f z)
-
-instance Applicative Normal3 where
- pure a = Normal3 a a a
- Normal3 f g h <*> Normal3 x y z = Normal3 (f x) (g y) (h z)
-
-instance Foldable Normal3 where
- foldr f a (Normal3 x y z) = x `f ` (y `f` (z `f` a))
- foldl f a (Normal3 x y z) = ((a `f` x) `f` y) `f` z
- foldr1 f (Normal3 x y z) = x `f` (y `f` z)
- foldl1 f (Normal3 x y z) = (x `f` y) `f` z
-
-instance Traversable Normal3 where
- traverse f (Normal3 x y z) = pure Normal3 <*> f x <*> f y <*> f z
- sequenceA (Normal3 x y z) = pure Normal3 <*> x <*> y <*> z
- mapM f (Normal3 x y z) = return Normal3 `ap` f x `ap` f y `ap` f z
- sequence (Normal3 x y z) = return Normal3 `ap` x `ap` y `ap` z
-
-instance Storable a => Storable (Normal3 a) where
- sizeOf ~(Normal3 x _ _) = 3 * sizeOf x
- alignment ~(Normal3 x _ _) = alignment x
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | A fog coordinate.
-newtype FogCoord1 a = FogCoord1 a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor FogCoord1 where
- fmap f (FogCoord1 x) = FogCoord1 (f x)
-
-instance Applicative FogCoord1 where
- pure a = FogCoord1 a
- FogCoord1 f <*> FogCoord1 x = FogCoord1 (f x)
-
-instance Foldable FogCoord1 where
- foldr f a (FogCoord1 x) = x `f ` a
- foldl f a (FogCoord1 x) = a `f` x
- foldr1 _ (FogCoord1 x) = x
- foldl1 _ (FogCoord1 x) = x
-
-instance Traversable FogCoord1 where
- traverse f (FogCoord1 x) = pure FogCoord1 <*> f x
- sequenceA (FogCoord1 x) = pure FogCoord1 <*> x
- mapM f (FogCoord1 x) = return FogCoord1 `ap` f x
- sequence (FogCoord1 x) = return FogCoord1 `ap` x
-
-instance Storable a => Storable (FogCoord1 a) where
- sizeOf ~(FogCoord1 s) = sizeOf s
- alignment ~(FogCoord1 s) = alignment s
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- An RGBA color with /A/=1.
-data Color3 a = Color3 !a !a !a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor Color3 where
- fmap f (Color3 x y z) = Color3 (f x) (f y) (f z)
-
-instance Applicative Color3 where
- pure a = Color3 a a a
- Color3 f g h <*> Color3 x y z = Color3 (f x) (g y) (h z)
-
-instance Foldable Color3 where
- foldr f a (Color3 x y z) = x `f ` (y `f` (z `f` a))
- foldl f a (Color3 x y z) = ((a `f` x) `f` y) `f` z
- foldr1 f (Color3 x y z) = x `f` (y `f` z)
- foldl1 f (Color3 x y z) = (x `f` y) `f` z
-
-instance Traversable Color3 where
- traverse f (Color3 x y z) = pure Color3 <*> f x <*> f y <*> f z
- sequenceA (Color3 x y z) = pure Color3 <*> x <*> y <*> z
- mapM f (Color3 x y z) = return Color3 `ap` f x `ap` f y `ap` f z
- sequence (Color3 x y z) = return Color3 `ap` x `ap` y `ap` z
-
-instance Storable a => Storable (Color3 a) where
- sizeOf ~(Color3 x _ _) = 3 * sizeOf x
- alignment ~(Color3 x _ _) = alignment x
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | A fully-fledged RGBA color.
-data Color4 a = Color4 !a !a !a !a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor Color4 where
- fmap f (Color4 x y z w) = Color4 (f x) (f y) (f z) (f w)
-
-instance Applicative Color4 where
- pure a = Color4 a a a a
- Color4 f g h i <*> Color4 x y z w = Color4 (f x) (g y) (h z) (i w)
-
-instance Foldable Color4 where
- foldr f a (Color4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))
- foldl f a (Color4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w
- foldr1 f (Color4 x y z w) = x `f` (y `f` (z `f` w))
- foldl1 f (Color4 x y z w) = ((x `f` y) `f` z) `f` w
-
-instance Traversable Color4 where
- traverse f (Color4 x y z w) = pure Color4 <*> f x <*> f y <*> f z <*> f w
- sequenceA (Color4 x y z w) = pure Color4 <*> x <*> y <*> z <*> w
- mapM f (Color4 x y z w) = return Color4 `ap` f x `ap` f y `ap` f z `ap` f w
- sequence (Color4 x y z w) = return Color4 `ap` x `ap` y `ap` z `ap` w
-
-instance Storable a => Storable (Color4 a) where
- sizeOf ~(Color4 x _ _ _) = 4 * sizeOf x
- alignment ~(Color4 x _ _ _) = alignment x
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
--- | A color index.
-newtype Index1 a = Index1 a
- deriving (Eq, Ord, Ix, Bounded, Show, Read, Typeable)
-
-instance Functor Index1 where
- fmap f (Index1 x) = Index1 (f x)
-
-instance Applicative Index1 where
- pure a = Index1 a
- Index1 f <*> Index1 x = Index1 (f x)
-
-instance Foldable Index1 where
- foldr f a (Index1 x) = x `f ` a
- foldl f a (Index1 x) = a `f` x
- foldr1 _ (Index1 x) = x
- foldl1 _ (Index1 x) = x
-
-instance Traversable Index1 where
- traverse f (Index1 x) = pure Index1 <*> f x
- sequenceA (Index1 x) = pure Index1 <*> x
- mapM f (Index1 x) = return Index1 `ap` f x
- sequence (Index1 x) = return Index1 `ap` x
-
-instance Storable a => Storable (Index1 a) where
- sizeOf ~(Index1 s) = sizeOf s
- alignment ~(Index1 s) = alignment s
- peek = peekApplicativeTraversable
- poke = pokeFoldable
-
---------------------------------------------------------------------------------
-
-peekApplicativeTraversable :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> IO (t a)
-peekApplicativeTraversable = Data.Traversable.mapM peek . addresses
-
-addresses :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> t (Ptr a)
-addresses = snd . mapAccumL nextPtr 0 . pure . castPtr
-
-nextPtr :: Storable a => Int -> Ptr a -> (Int, Ptr a)
-nextPtr offset ptr = (offset + 1, advancePtr ptr offset)
-
---------------------------------------------------------------------------------
-
-pokeFoldable :: (Foldable t, Storable a) => Ptr (t a) -> t a -> IO ()
-pokeFoldable ptr xs = foldlM pokeAndAdvance (castPtr ptr) xs >> return ()
-
-pokeAndAdvance :: Storable a => Ptr a -> a -> IO (Ptr a)
-pokeAndAdvance ptr value = do
- poke ptr value
- return $ ptr `plusPtr` sizeOf value
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GL.VertexAttributes
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GL/VertexSpec.hs b/Graphics/Rendering/OpenGL/GL/VertexSpec.hs
--- a/Graphics/Rendering/OpenGL/GL/VertexSpec.hs
+++ b/Graphics/Rendering/OpenGL/GL/VertexSpec.hs
@@ -1,1027 +1,992 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GL.VertexSpec
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.7 (Vertex Specification) of the
--- OpenGL 2.1 specs.
---
---------------------------------------------------------------------------------
-
-{-# 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.StateVar
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GL.PeekPoke
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit
-import Graphics.Rendering.OpenGL.GL.VertexAttributes
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility (
- glColor3b, glColor3bv, glColor3d, glColor3dv, glColor3f, glColor3fv,
- glColor3i, glColor3iv, glColor3s, glColor3sv, glColor3ub, glColor3ubv,
- glColor3ui, glColor3uiv, glColor3us, glColor3usv, glColor4b, glColor4bv,
- glColor4d, glColor4dv, glColor4f, glColor4fv, glColor4i, glColor4iv,
- glColor4s, glColor4sv, glColor4ub, glColor4ubv, glColor4ui, glColor4uiv,
- glColor4us, glColor4usv, glFogCoordd, glFogCoorddv, glFogCoordf,
- glFogCoordfv, glIndexd, glIndexdv, glIndexf, glIndexfv, glIndexi, glIndexiv,
- glIndexs, glIndexsv, glIndexub, glIndexubv, glMultiTexCoord1d,
- glMultiTexCoord1dv, glMultiTexCoord1f, glMultiTexCoord1fv, glMultiTexCoord1i,
- glMultiTexCoord1iv, glMultiTexCoord1s, glMultiTexCoord1sv, glMultiTexCoord2d,
- glMultiTexCoord2dv, glMultiTexCoord2f, glMultiTexCoord2fv, glMultiTexCoord2i,
- glMultiTexCoord2iv, glMultiTexCoord2s, glMultiTexCoord2sv, glMultiTexCoord3d,
- glMultiTexCoord3dv, glMultiTexCoord3f, glMultiTexCoord3fv, glMultiTexCoord3i,
- glMultiTexCoord3iv, glMultiTexCoord3s, glMultiTexCoord3sv, glMultiTexCoord4d,
- glMultiTexCoord4dv, glMultiTexCoord4f, glMultiTexCoord4fv, glMultiTexCoord4i,
- glMultiTexCoord4iv, glMultiTexCoord4s, glMultiTexCoord4sv, glNormal3b,
- glNormal3bv, glNormal3d, glNormal3dv, glNormal3f, glNormal3fv, glNormal3i,
- glNormal3iv, glNormal3s, glNormal3sv, glSecondaryColor3b,
- glSecondaryColor3bv, glSecondaryColor3d, glSecondaryColor3dv,
- glSecondaryColor3f, glSecondaryColor3fv, glSecondaryColor3i,
- glSecondaryColor3iv, glSecondaryColor3s, glSecondaryColor3sv,
- glSecondaryColor3ub, glSecondaryColor3ubv, glSecondaryColor3ui,
- glSecondaryColor3uiv, glSecondaryColor3us, glSecondaryColor3usv,
- glTexCoord1d, glTexCoord1dv, glTexCoord1f, glTexCoord1fv, glTexCoord1i,
- glTexCoord1iv, glTexCoord1s, glTexCoord1sv, glTexCoord2d, glTexCoord2dv,
- glTexCoord2f, glTexCoord2fv, glTexCoord2i, glTexCoord2iv, glTexCoord2s,
- glTexCoord2sv, glTexCoord3d, glTexCoord3dv, glTexCoord3f, glTexCoord3fv,
- glTexCoord3i, glTexCoord3iv, glTexCoord3s, glTexCoord3sv, glTexCoord4d,
- glTexCoord4dv, glTexCoord4f, glTexCoord4fv, glTexCoord4i, glTexCoord4iv,
- glTexCoord4s, glTexCoord4sv, glVertex2d, glVertex2dv, glVertex2f,
- glVertex2fv, glVertex2i, glVertex2iv, glVertex2s, glVertex2sv, glVertex3d,
- glVertex3dv, glVertex3f, glVertex3fv, glVertex3i, glVertex3iv, glVertex3s,
- glVertex3sv, glVertex4d, glVertex4dv, glVertex4f, glVertex4fv, glVertex4i,
- glVertex4iv, glVertex4s, glVertex4sv )
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | The class of all types which can be used as a vertex coordinate.
-
-class VertexComponent a where
- vertex2 :: a -> a -> IO ()
- vertex3 :: a -> a -> a -> IO ()
- vertex4 :: a -> a -> a -> a -> IO ()
-
- vertex2v :: Ptr a -> IO ()
- vertex3v :: Ptr a -> IO ()
- vertex4v :: Ptr a -> IO ()
-
-instance VertexComponent GLshort where
- vertex2 = glVertex2s
- vertex3 = glVertex3s
- vertex4 = glVertex4s
-
- vertex2v = glVertex2sv
- vertex3v = glVertex3sv
- vertex4v = glVertex4sv
-
-instance VertexComponent GLint where
- vertex2 = glVertex2i
- vertex3 = glVertex3i
- vertex4 = glVertex4i
-
- vertex2v = glVertex2iv
- vertex3v = glVertex3iv
- vertex4v = glVertex4iv
-
-instance VertexComponent GLfloat where
- vertex2 = glVertex2f
- vertex3 = glVertex3f
- vertex4 = glVertex4f
-
- vertex2v = glVertex2fv
- vertex3v = glVertex3fv
- vertex4v = glVertex4fv
-
-instance VertexComponent GLdouble where
- vertex2 = glVertex2d
- vertex3 = glVertex3d
- vertex4 = glVertex4d
-
- vertex2v = glVertex2dv
- vertex3v = glVertex3dv
- vertex4v = glVertex4dv
-
---------------------------------------------------------------------------------
-
--- | Specify the (/x/, /y/, /z/, /w/) coordinates of a four-dimensional vertex.
--- This must only be done during
--- 'Graphics.Rendering.OpenGL.GL.BeginEnd.renderPrimitive', otherwise the
--- behaviour is unspecified. The current values of the auxiliary vertex
--- attributes are associated with the vertex.
---
--- Note that there is no such thing as a \"current vertex\" which could be
--- retrieved.
-
-class Vertex a where
- vertex :: a -> IO ()
- vertexv :: Ptr a -> IO ()
-
-instance VertexComponent a => Vertex (Vertex2 a) where
- vertex (Vertex2 x y) = vertex2 x y
- vertexv = vertex2v . (castPtr :: Ptr (Vertex2 b) -> Ptr b)
-
-instance VertexComponent a => Vertex (Vertex3 a) where
- vertex (Vertex3 x y z) = vertex3 x y z
- vertexv = vertex3v . (castPtr :: Ptr (Vertex3 b) -> Ptr b)
-
-instance VertexComponent a => Vertex (Vertex4 a) where
- vertex (Vertex4 x y z w) = vertex4 x y z w
- vertexv = vertex4v . (castPtr :: Ptr (Vertex4 b) -> Ptr b)
-
---------------------------------------------------------------------------------
--- $AuxiliaryVertexAttributes
--- Apart from its coordinates in four-dimensional space, every vertex has
--- associated /auxiliary attributes/: Its texture coordinates, a normal, a
--- fog coordinate, and a color plus a secondary color. For every attribute, the
--- OpenGL state contains its current value, which can be changed at any time.
---
--- Every attribute has a \"natural\" format via which it can be manipulated
--- directly as part of the OpenGL state, e.g. the current texture coordinates
--- are internally handled as @'TexCoord4' 'GLfloat'@. Different formats are
--- converted to this format, e.g. the /s/, /r/, and /t/ coordinates of a
--- @'TexCoord3' 'GLint'@ are converted to floating point values and a /q/
--- coordinate of 1.0 is implicitly assumed.
---
--- Consequently, the vast majority of classes, functions, and data types in this
--- module are for convenience only and offer no additional functionality.
-
---------------------------------------------------------------------------------
-
--- | The current texture coordinates (/s/, /t/, /r/, /q/) for the current
--- texture unit (see 'Graphics.Rendering.OpenGL.GL.CoordTrans.activeTexture').
--- The initial value is (0,0,0,1) for all texture units.
-
-currentTextureCoords :: StateVar (TexCoord4 GLfloat)
-currentTextureCoords =
- makeStateVar (getFloat4 TexCoord4 GetCurrentTextureCoords) texCoord
-
---------------------------------------------------------------------------------
-
--- | The class of all types which can be used as a texture coordinate.
-
-class TexCoordComponent a where
- texCoord1 :: a -> IO ()
- texCoord2 :: a -> a -> IO ()
- texCoord3 :: a -> a -> a -> IO ()
- texCoord4 :: a -> a -> a -> a -> IO ()
-
- texCoord1v :: Ptr a -> IO ()
- texCoord2v :: Ptr a -> IO ()
- texCoord3v :: Ptr a -> IO ()
- texCoord4v :: Ptr a -> IO ()
-
- multiTexCoord1 :: GLenum -> a -> IO ()
- multiTexCoord2 :: GLenum -> a -> a -> IO ()
- multiTexCoord3 :: GLenum -> a -> a -> a -> IO ()
- multiTexCoord4 :: GLenum -> a -> a -> a -> a -> IO ()
-
- multiTexCoord1v :: GLenum -> Ptr a -> IO ()
- multiTexCoord2v :: GLenum -> Ptr a -> IO ()
- multiTexCoord3v :: GLenum -> Ptr a -> IO ()
- multiTexCoord4v :: GLenum -> Ptr a -> IO ()
-
-instance TexCoordComponent GLshort where
- texCoord1 = glTexCoord1s
- texCoord2 = glTexCoord2s
- texCoord3 = glTexCoord3s
- texCoord4 = glTexCoord4s
-
- texCoord1v = glTexCoord1sv
- texCoord2v = glTexCoord2sv
- texCoord3v = glTexCoord3sv
- texCoord4v = glTexCoord4sv
-
- multiTexCoord1 = glMultiTexCoord1s
- multiTexCoord2 = glMultiTexCoord2s
- multiTexCoord3 = glMultiTexCoord3s
- multiTexCoord4 = glMultiTexCoord4s
-
- multiTexCoord1v = glMultiTexCoord1sv
- multiTexCoord2v = glMultiTexCoord2sv
- multiTexCoord3v = glMultiTexCoord3sv
- multiTexCoord4v = glMultiTexCoord4sv
-
-instance TexCoordComponent GLint where
- texCoord1 = glTexCoord1i
- texCoord2 = glTexCoord2i
- texCoord3 = glTexCoord3i
- texCoord4 = glTexCoord4i
-
- texCoord1v = glTexCoord1iv
- texCoord2v = glTexCoord2iv
- texCoord3v = glTexCoord3iv
- texCoord4v = glTexCoord4iv
-
- multiTexCoord1 = glMultiTexCoord1i
- multiTexCoord2 = glMultiTexCoord2i
- multiTexCoord3 = glMultiTexCoord3i
- multiTexCoord4 = glMultiTexCoord4i
-
- multiTexCoord1v = glMultiTexCoord1iv
- multiTexCoord2v = glMultiTexCoord2iv
- multiTexCoord3v = glMultiTexCoord3iv
- multiTexCoord4v = glMultiTexCoord4iv
-
-instance TexCoordComponent GLfloat where
- texCoord1 = glTexCoord1f
- texCoord2 = glTexCoord2f
- texCoord3 = glTexCoord3f
- texCoord4 = glTexCoord4f
-
- texCoord1v = glTexCoord1fv
- texCoord2v = glTexCoord2fv
- texCoord3v = glTexCoord3fv
- texCoord4v = glTexCoord4fv
-
- multiTexCoord1 = glMultiTexCoord1f
- multiTexCoord2 = glMultiTexCoord2f
- multiTexCoord3 = glMultiTexCoord3f
- multiTexCoord4 = glMultiTexCoord4f
-
- multiTexCoord1v = glMultiTexCoord1fv
- multiTexCoord2v = glMultiTexCoord2fv
- multiTexCoord3v = glMultiTexCoord3fv
- multiTexCoord4v = glMultiTexCoord4fv
-
-instance TexCoordComponent GLdouble where
- texCoord1 = glTexCoord1d
- texCoord2 = glTexCoord2d
- texCoord3 = glTexCoord3d
- texCoord4 = glTexCoord4d
-
- texCoord1v = glTexCoord1dv
- texCoord2v = glTexCoord2dv
- texCoord3v = glTexCoord3dv
- texCoord4v = glTexCoord4dv
-
- multiTexCoord1 = glMultiTexCoord1d
- multiTexCoord2 = glMultiTexCoord2d
- multiTexCoord3 = glMultiTexCoord3d
- multiTexCoord4 = glMultiTexCoord4d
-
- multiTexCoord1v = glMultiTexCoord1dv
- multiTexCoord2v = glMultiTexCoord2dv
- multiTexCoord3v = glMultiTexCoord3dv
- multiTexCoord4v = glMultiTexCoord4dv
-
---------------------------------------------------------------------------------
-
--- | Change the current texture coordinates of the current or given texture
--- unit.
-
-class TexCoord a where
- texCoord :: a -> IO ()
- texCoordv :: Ptr a -> IO ()
- multiTexCoord :: TextureUnit -> a -> IO ()
- multiTexCoordv :: TextureUnit -> Ptr a -> IO ()
-
-instance TexCoordComponent a => TexCoord (TexCoord1 a) where
- texCoord (TexCoord1 s) = texCoord1 s
- texCoordv = texCoord1v . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)
- multiTexCoord u (TexCoord1 s) =
- multiTexCoord1 (marshalTextureUnit u) s
- multiTexCoordv u =
- multiTexCoord1v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord1 b) -> Ptr b)
-
-instance TexCoordComponent a => TexCoord (TexCoord2 a) where
- texCoord (TexCoord2 s t) = texCoord2 s t
- texCoordv = texCoord2v . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)
- multiTexCoord u (TexCoord2 s t) =
- multiTexCoord2 (marshalTextureUnit u) s t
- multiTexCoordv u =
- multiTexCoord2v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord2 b) -> Ptr b)
-
-instance TexCoordComponent a => TexCoord (TexCoord3 a) where
- texCoord (TexCoord3 s t r) = texCoord3 s t r
- texCoordv = texCoord3v . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)
- multiTexCoord u (TexCoord3 s t r) =
- multiTexCoord3 (marshalTextureUnit u) s t r
- multiTexCoordv u =
- multiTexCoord3v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord3 b) -> Ptr b)
-
-instance TexCoordComponent a => TexCoord (TexCoord4 a) where
- texCoord (TexCoord4 s t r q) = texCoord4 s t r q
- texCoordv = texCoord4v . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)
- multiTexCoord u (TexCoord4 s t r q) =
- multiTexCoord4 (marshalTextureUnit u) s t r q
- multiTexCoordv u =
- multiTexCoord4v (marshalTextureUnit u) . (castPtr :: Ptr (TexCoord4 b) -> Ptr b)
-
---------------------------------------------------------------------------------
-
--- | The current normal (/x/, /y/, /z/). The initial value is the unit vector
--- (0, 0, 1).
-
-currentNormal :: StateVar (Normal3 GLfloat)
-currentNormal = makeStateVar (getFloat3 Normal3 GetCurrentNormal) normal
-
---------------------------------------------------------------------------------
-
--- | The class of all types which can be used as a component of a normal.
-
-class NormalComponent a where
- normal3 :: a -> a -> a -> IO ()
- normal3v :: Ptr a -> IO ()
-
-instance NormalComponent GLbyte where
- normal3 = glNormal3b
- normal3v = glNormal3bv
-
-instance NormalComponent GLshort where
- normal3 = glNormal3s
- normal3v = glNormal3sv
-
-instance NormalComponent GLint where
- normal3 = glNormal3i
- normal3v = glNormal3iv
-
-instance NormalComponent GLfloat where
- normal3 = glNormal3f
- normal3v = glNormal3fv
-
-instance NormalComponent GLdouble where
- normal3 = glNormal3d
- normal3v = glNormal3dv
-
---------------------------------------------------------------------------------
-
--- | Change the current normal. Integral arguments are converted to
--- floating-point with a linear mapping that maps the most positive
--- representable integer value to 1.0, and the most negative representable
--- integer value to -1.0.
---
--- Normals specified with 'normal' or 'normalv' need not have unit length.
--- If 'Graphics.Rendering.OpenGL.GL.CoordTrans.normalize' is enabled, then
--- normals of any length specified with 'normal' or 'normalv' are normalized
--- after transformation. If
--- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' is enabled, normals
--- are scaled by a scaling factor derived from the modelview matrix.
--- 'Graphics.Rendering.OpenGL.GL.CoordTrans.rescaleNormal' requires that the
--- originally specified normals were of unit length, and that the modelview
--- matrix contains only uniform scales for proper results. Normalization is
--- initially disabled.
-
-class Normal a where
- normal :: a -> IO ()
- normalv :: Ptr a -> IO ()
-
-instance NormalComponent a => Normal (Normal3 a) where
- normal (Normal3 x y z) = normal3 x y z
- normalv = normal3v . (castPtr :: Ptr (Normal3 b) -> Ptr b)
-
---------------------------------------------------------------------------------
-
--- | The current fog coordinate. The initial value is 0.
-
-currentFogCoord :: StateVar (FogCoord1 GLfloat)
-currentFogCoord =
- makeStateVar (getFloat1 FogCoord1 GetCurrentFogCoord) fogCoord
-
---------------------------------------------------------------------------------
-
--- | The class of all types which can be used as the fog coordinate.
-
-class FogCoordComponent a where
- fogCoord1 :: a -> IO ()
- fogCoord1v :: Ptr a -> IO ()
-
-instance FogCoordComponent GLfloat where
- fogCoord1 = glFogCoordf
- fogCoord1v = glFogCoordfv
-
-instance FogCoordComponent GLdouble where
- fogCoord1 = glFogCoordd
- fogCoord1v = glFogCoorddv
-
---------------------------------------------------------------------------------
-
--- | Change the current fog coordinate.
-
-class FogCoord a where
- fogCoord :: a -> IO ()
- fogCoordv :: Ptr a -> IO ()
-
-instance FogCoordComponent a => FogCoord (FogCoord1 a) where
- fogCoord (FogCoord1 c) = fogCoord1 c
- fogCoordv = fogCoord1v . (castPtr :: Ptr (FogCoord1 b) -> Ptr b)
-
---------------------------------------------------------------------------------
-
--- | If 'rgbaMode' contains 'True', the color buffers store RGBA value. If
--- color indexes are stored, it contains 'False'.
-
-rgbaMode :: GettableStateVar Bool
-rgbaMode = makeGettableStateVar (getBoolean1 unmarshalGLboolean GetRGBAMode)
-
---------------------------------------------------------------------------------
-
--- The current color (/R/, /G/, /B/, /A/). The initial value is (1, 1, 1, 1).
--- Note that this state variable is significant only when the GL is in RGBA
--- mode.
-
-currentColor :: StateVar (Color4 GLfloat)
-currentColor =
- makeStateVar (getFloat4 Color4 GetCurrentColor) color
-
--- The current secondary color (/R/, /G/, /B/). The initial value is (0, 0, 0).
--- Note that this state variable is significant only when the GL is in RGBA
--- mode.
-
-currentSecondaryColor :: StateVar (Color3 GLfloat)
-currentSecondaryColor =
- makeStateVar
- (do Color4 r g b _ <- getFloat4 Color4 GetCurrentSecondaryColor
- return $ Color3 r g b)
- secondaryColor
-
---------------------------------------------------------------------------------
-
--- | The class of all types which can be used as a color component.
-
-class ColorComponent a where
- color3 :: a -> a -> a -> IO ()
- color4 :: a -> a -> a -> a -> IO ()
-
- color3v :: Ptr a -> IO ()
- color4v :: Ptr a -> IO ()
-
- secondaryColor3 :: a -> a -> a -> IO ()
- secondaryColor3v :: Ptr a -> IO ()
-
-instance ColorComponent GLbyte where
- color3 = glColor3b
- color4 = glColor4b
-
- color3v = glColor3bv
- color4v = glColor4bv
-
- secondaryColor3 = glSecondaryColor3b
- secondaryColor3v = glSecondaryColor3bv
-
-instance ColorComponent GLshort where
- color3 = glColor3s
- color4 = glColor4s
-
- color3v = glColor3sv
- color4v = glColor4sv
-
- secondaryColor3 = glSecondaryColor3s
- secondaryColor3v = glSecondaryColor3sv
-
-instance ColorComponent GLint where
- color3 = glColor3i
- color4 = glColor4i
-
- color3v = glColor3iv
- color4v = glColor4iv
-
- secondaryColor3 = glSecondaryColor3i
- secondaryColor3v = glSecondaryColor3iv
-
-instance ColorComponent GLfloat where
- color3 = glColor3f
- color4 = glColor4f
-
- color3v = glColor3fv
- color4v = glColor4fv
-
- secondaryColor3 = glSecondaryColor3f
- secondaryColor3v = glSecondaryColor3fv
-
-instance ColorComponent 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
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GLU.hs b/Graphics/Rendering/OpenGL/GLU.hs
--- a/Graphics/Rendering/OpenGL/GLU.hs
+++ b/Graphics/Rendering/OpenGL/GLU.hs
@@ -1,31 +1,31 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- A Haskell binding for GLU, OpenGL\'s accompanying utility library.
---
------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU (
- module Graphics.Rendering.OpenGL.GLU.Initialization,
- module Graphics.Rendering.OpenGL.GLU.Mipmapping,
- module Graphics.Rendering.OpenGL.GLU.Matrix,
- module Graphics.Rendering.OpenGL.GLU.Tessellation,
- module Graphics.Rendering.OpenGL.GLU.Quadrics,
- module Graphics.Rendering.OpenGL.GLU.NURBS,
- module Graphics.Rendering.OpenGL.GLU.Errors
-) where
-
-import Graphics.Rendering.OpenGL.GLU.Initialization
-import Graphics.Rendering.OpenGL.GLU.Mipmapping
-import Graphics.Rendering.OpenGL.GLU.Matrix
-import Graphics.Rendering.OpenGL.GLU.Tessellation
-import Graphics.Rendering.OpenGL.GLU.Quadrics
-import Graphics.Rendering.OpenGL.GLU.NURBS
-import Graphics.Rendering.OpenGL.GLU.Errors
+-----------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GLU
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GLU/Errors.hs b/Graphics/Rendering/OpenGL/GLU/Errors.hs
--- a/Graphics/Rendering/OpenGL/GLU/Errors.hs
+++ b/Graphics/Rendering/OpenGL/GLU/Errors.hs
@@ -1,34 +1,34 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.Errors
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to section 2.5 (GL Errors) of the OpenGL 2.1 specs
--- and chapter 8 (Errors) of the GLU specs, offering a generalized view of
--- errors in GL and GLU.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.Errors (
- Error(..), ErrorCategory(..), errors
-) where
-
-import Graphics.Rendering.OpenGL.GL.StateVar
-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
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs b/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs
--- a/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs
+++ b/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs
@@ -1,171 +1,170 @@
-{-# OPTIONS_GHC -fno-cse #-}
-
--- #hide
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.ErrorsInternal
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This is a purely internal module corresponding to some parts of section 2.5
--- (GL Errors) of the OpenGL 2.1 specs and chapter 8 (Errors) of the GLU specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.ErrorsInternal (
- Error(..), ErrorCategory(..), getErrors,
- recordErrorCode, recordInvalidEnum, recordInvalidValue, recordOutOfMemory
-) where
-
-import Foreign.Ptr ( castPtr )
-import Foreign.C.String ( peekCString )
-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
-import System.IO.Unsafe ( unsafePerformIO )
-import Graphics.Rendering.GLU.Raw
-import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
--- | GL\/GLU errors consist of a general error category and a description of
--- what went wrong.
-
-data Error = Error ErrorCategory String
- deriving ( Eq, Ord, Show )
-
---------------------------------------------------------------------------------
-
--- | General GL\/GLU error categories
-
-data ErrorCategory
- = InvalidEnum
- | InvalidValue
- | InvalidOperation
- | InvalidFramebufferOperation
- | OutOfMemory
- | StackOverflow
- | StackUnderflow
- | TableTooLarge
- | TesselatorError
- | NURBSError
- deriving ( Eq, Ord, Show )
-
-unmarshalErrorCategory :: GLenum -> ErrorCategory
-unmarshalErrorCategory c
- | isInvalidEnum c = InvalidEnum
- | isInvalidValue c = InvalidValue
- | isInvalidOperation c = InvalidOperation
- | isInvalidFramebufferOperation c = InvalidFramebufferOperation
- | isOutOfMemory c = OutOfMemory
- | isStackOverflow c = StackOverflow
- | isStackUnderflow c = StackUnderflow
- | isTableTooLarge c = TableTooLarge
- | isTesselatorError c = TesselatorError
- | isNURBSError c = NURBSError
- | otherwise = error "unmarshalErrorCategory"
-
-isInvalidEnum :: GLenum -> Bool
-isInvalidEnum c = c == gl_INVALID_ENUM || c == glu_INVALID_ENUM
-
-isInvalidValue :: GLenum -> Bool
-isInvalidValue c = c == gl_INVALID_VALUE || c == glu_INVALID_VALUE
-
-isInvalidOperation :: GLenum -> Bool
-isInvalidOperation c = c == gl_INVALID_OPERATION || c == glu_INVALID_OPERATION
-
-isInvalidFramebufferOperation :: GLenum -> Bool
-isInvalidFramebufferOperation c = c == gl_INVALID_FRAMEBUFFER_OPERATION
-
-isOutOfMemory :: GLenum -> Bool
-isOutOfMemory c = c == gl_OUT_OF_MEMORY || c == glu_OUT_OF_MEMORY
-
-isStackOverflow :: GLenum -> Bool
-isStackOverflow c = c == gl_STACK_OVERFLOW
-
-isStackUnderflow :: GLenum -> Bool
-isStackUnderflow c = c == gl_STACK_UNDERFLOW
-
-isTableTooLarge :: GLenum -> Bool
-isTableTooLarge c = c == gl_TABLE_TOO_LARGE
-
-isTesselatorError :: GLenum -> Bool
-isTesselatorError c = glu_TESS_ERROR1 <= c && c <= glu_TESS_ERROR8
-
-isNURBSError :: GLenum -> Bool
-isNURBSError c = glu_NURBS_ERROR1 <= c && c <= glu_NURBS_ERROR37
-
---------------------------------------------------------------------------------
-
--- The returned error string is statically allocated, so peekCString
--- does the right thing here. No malloc/free necessary here.
-
-makeError :: GLenum -> IO Error
-makeError e = do
- let category = unmarshalErrorCategory e
- ptr <- gluErrorString e
- description <- peekCString (castPtr ptr)
- return $ Error category description
-
---------------------------------------------------------------------------------
-
--- This seems to be a common Haskell hack nowadays: A plain old global variable
--- with an associated getter and mutator. Perhaps some language/library support
--- is needed?
-
-{-# NOINLINE theRecordedErrors #-}
-theRecordedErrors :: IORef ([GLenum],Bool)
-theRecordedErrors = unsafePerformIO (newIORef ([], True))
-
-getRecordedErrors :: IO ([GLenum],Bool)
-getRecordedErrors = readIORef theRecordedErrors
-
-setRecordedErrors :: ([GLenum],Bool) -> IO ()
-setRecordedErrors = writeIORef theRecordedErrors
-
---------------------------------------------------------------------------------
-
-getGLErrors :: IO [GLenum]
-getGLErrors = getGLErrorsAux []
- where getGLErrorsAux acc = do
- errorCode <- glGetError
- if isError errorCode
- then getGLErrorsAux (errorCode : acc)
- else return $ reverse acc
-
-isError :: GLenum -> Bool
-isError = (/= gl_NO_ERROR)
-
---------------------------------------------------------------------------------
-
-getErrors :: IO [Error]
-getErrors = do
- es <- getErrorCodesAux (const ([], True))
- mapM makeError es
-
-recordErrorCode :: GLenum -> IO ()
-recordErrorCode e = do
- -- We don't need the return value because this calls setRecordedErrors
- _ <- getErrorCodesAux (\es -> (if null es then [e] else [], False))
- return ()
-
-recordInvalidEnum :: IO ()
-recordInvalidEnum = recordErrorCode gl_INVALID_ENUM
-
-recordInvalidValue :: IO ()
-recordInvalidValue = recordErrorCode gl_INVALID_VALUE
-
-recordOutOfMemory :: IO ()
-recordOutOfMemory = recordErrorCode gl_OUT_OF_MEMORY
-
--- ToDo: Make this thread-safe
-getErrorCodesAux :: ([GLenum] -> ([GLenum],Bool)) -> IO [GLenum]
-getErrorCodesAux f = do
- (recordedErrors, useGLErrors) <- getRecordedErrors
- glErrors <- getGLErrors
- let es = if useGLErrors then recordedErrors ++ glErrors else recordedErrors
- setRecordedErrors (f es)
- return es
+{-# OPTIONS_GHC -fno-cse #-}
+
+{-# OPTIONS_HADDOCK hide #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GLU.ErrorsInternal
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GLU/Initialization.hs b/Graphics/Rendering/OpenGL/GLU/Initialization.hs
--- a/Graphics/Rendering/OpenGL/GLU/Initialization.hs
+++ b/Graphics/Rendering/OpenGL/GLU/Initialization.hs
@@ -1,36 +1,36 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.Initialization
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to chapter 2 (Initialization) of the GLU specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.Initialization (
- gluVersion, gluExtensions
-) where
-
-import Foreign.C.String
-import Foreign.Ptr
-import Graphics.Rendering.GLU.Raw
-import Graphics.Rendering.OpenGL.GL.StateVar
-import Graphics.Rendering.OpenGL.GL.QueryUtils
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
-
-gluVersion :: GettableStateVar String
-gluVersion = makeGettableStateVar (getString glu_VERSION)
-
-gluExtensions :: GettableStateVar [String]
-gluExtensions = makeGettableStateVar (fmap words $ getString glu_EXTENSIONS)
-
-getString :: GLenum -> IO String
-getString n = gluGetString n >>=
- maybeNullPtr (return "") (peekCString . castPtr)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GLU.Initialization
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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)
diff --git a/Graphics/Rendering/OpenGL/GLU/Matrix.hs b/Graphics/Rendering/OpenGL/GLU/Matrix.hs
--- a/Graphics/Rendering/OpenGL/GLU/Matrix.hs
+++ b/Graphics/Rendering/OpenGL/GLU/Matrix.hs
@@ -1,135 +1,135 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.Matrix
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to chapter 4 (Matrix Manipulation) of the GLU specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.Matrix (
- ortho2D, perspective, lookAt, pickMatrix,
- project, unProject, unProject4
-) where
-
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.GLU.Raw
-import Graphics.Rendering.OpenGL.GL.Tensor
-import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Graphics.Rendering.OpenGL.GL.GLboolean
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal
-import Graphics.Rendering.OpenGL.Raw.Core31
-
---------------------------------------------------------------------------------
--- matrix setup
-
-ortho2D :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
-ortho2D = gluOrtho2D
-
-
-perspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> IO ()
-perspective = gluPerspective
-
-lookAt :: Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble -> IO ()
-lookAt (Vertex3 eyeX eyeY eyeZ)
- (Vertex3 centerX centerY centerZ)
- (Vector3 upX upY upZ) =
- gluLookAt eyeX eyeY eyeZ centerX centerY centerZ upX upY upZ
-
-pickMatrix ::
- (GLdouble, GLdouble) -> (GLdouble, GLdouble) -> (Position, Size) -> IO ()
-pickMatrix (x, y) (w, h) viewPort =
- withViewport viewPort $ gluPickMatrix x y w h
-
---------------------------------------------------------------------------------
--- coordinate projection
-
-project ::
- Matrix m
- => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
- -> IO (Vertex3 GLdouble)
-project (Vertex3 objX objY objZ) model proj viewPort =
- withColumnMajor model $ \modelBuf ->
- withColumnMajor proj $ \projBuf ->
- withViewport viewPort $ \viewBuf ->
- getVertex3 $ gluProject objX objY objZ modelBuf projBuf viewBuf
-
-unProject ::
- Matrix m
- => Vertex3 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
- -> IO (Vertex3 GLdouble)
-unProject (Vertex3 objX objY objZ) model proj viewPort =
- withColumnMajor model $ \modelBuf ->
- withColumnMajor proj $ \projBuf ->
- withViewport viewPort $ \viewBuf ->
- getVertex3 $ gluUnProject objX objY objZ modelBuf projBuf viewBuf
-
-unProject4 ::
- Matrix m
- => Vertex4 GLdouble -> m GLdouble -> m GLdouble -> (Position, Size)
- -> GLclampd -> GLclampd
- -> IO (Vertex4 GLdouble)
-unProject4 (Vertex4 objX objY objZ clipW) model proj viewPort near far =
- withColumnMajor model $ \modelBuf ->
- withColumnMajor proj $ \projBuf ->
- withViewport viewPort $ \viewBuf ->
- getVertex4 $
- gluUnProject4 objX objY objZ clipW modelBuf projBuf viewBuf near far
-
---------------------------------------------------------------------------------
-
-withViewport :: (Position, Size) -> (Ptr GLint -> IO a ) -> IO a
-withViewport (Position x y, Size w h) =
- withArray [ x, y, fromIntegral w, fromIntegral h ]
-
-withColumnMajor :: (Matrix m, MatrixComponent c) => m c -> (Ptr c -> IO b) -> IO b
-withColumnMajor mat act = withMatrix mat juggle
- where juggle ColumnMajor p = act p
- juggle RowMajor p = do
- transposedElems <- mapM (peekElemOff p) [ 0, 4, 8, 12,
- 1, 5, 9, 13,
- 2, 6, 10, 14,
- 3, 7, 11, 15 ]
- withArray transposedElems act
-
-getVertex3 ::
- (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
- -> IO (Vertex3 GLdouble)
-getVertex3 act =
- alloca $ \xBuf ->
- alloca $ \yBuf ->
- alloca $ \zBuf -> do
- ok <- act xBuf yBuf zBuf
- if unmarshalGLboolean ok
- then do x <- peek xBuf
- y <- peek yBuf
- z <- peek zBuf
- return $ Vertex3 x y z
- else do recordInvalidValue
- return $ Vertex3 0 0 0
-
-getVertex4 ::
- (Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> Ptr GLdouble -> IO GLint)
- -> IO (Vertex4 GLdouble)
-getVertex4 act =
- alloca $ \xBuf ->
- alloca $ \yBuf ->
- alloca $ \zBuf ->
- alloca $ \wBuf -> do
- ok <- act xBuf yBuf zBuf wBuf
- if unmarshalGLboolean ok
- then do x <- peek xBuf
- y <- peek yBuf
- z <- peek zBuf
- w <- peek wBuf
- return $ Vertex4 x y z w
- else do recordInvalidValue
- return $ Vertex4 0 0 0 0
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GLU.Matrix
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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
diff --git a/Graphics/Rendering/OpenGL/GLU/Mipmapping.hs b/Graphics/Rendering/OpenGL/GLU/Mipmapping.hs
--- a/Graphics/Rendering/OpenGL/GLU/Mipmapping.hs
+++ b/Graphics/Rendering/OpenGL/GLU/Mipmapping.hs
@@ -1,66 +1,64 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.Mipmapping
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to chapter 3 (Mipmapping) of the GLU specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.Mipmapping (
- scaleImage, build1DMipmaps, build2DMipmaps
-) where
-
-import Graphics.Rendering.GLU.Raw
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )
-import Graphics.Rendering.OpenGL.GL.PixelData ( PixelData, withPixelData )
-import Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat (
- PixelInternalFormat, marshalPixelInternalFormat )
-import Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget (
- TextureTarget, marshalTextureTarget )
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( recordInvalidValue )
-
---------------------------------------------------------------------------------
--- Section 3.1 (Image Scaling)
-
-scaleImage :: Size -> PixelData a -> Size -> PixelData b -> IO ()
-scaleImage (Size widthIn heightIn) pdIn (Size widthOut heightOut) pdOut =
- withPixelData pdIn $ \fIn dIn pIn ->
- withPixelData pdOut $ \fOut dOut pOut ->
- if fIn == fOut
- then do _ <- gluScaleImage
- fIn widthIn heightIn dIn pIn widthOut heightOut dOut pOut
- return () -- TODO: Should we use the return value?
- else recordInvalidValue
-
---------------------------------------------------------------------------------
--- Section 3.2 (Automatic Mipmapping)
--- Missing for GLU 1.3: gluBuild3DMipmaps, gluBuild{1,2,3}DMipmapLevels
-
-build1DMipmaps ::
- TextureTarget -> PixelInternalFormat -> GLsizei -> PixelData a -> IO ()
-build1DMipmaps target internalFormat height pd = do
- _ <- withPixelData pd $
- gluBuild1DMipmaps
- (marshalTextureTarget target)
- (marshalPixelInternalFormat internalFormat)
- height
- return () -- TODO: Should we use the return value?
-
---------------------------------------------------------------------------------
-
-build2DMipmaps :: TextureTarget -> PixelInternalFormat -> GLsizei -> GLsizei
- -> PixelData a -> IO ()
-build2DMipmaps target internalFormat width height pd = do
- _ <- withPixelData pd $
- gluBuild2DMipmaps
- (marshalTextureTarget target)
- (marshalPixelInternalFormat internalFormat)
- width height
- return () -- TODO: Should we use the return value?
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GLU.Mipmapping
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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?
diff --git a/Graphics/Rendering/OpenGL/GLU/NURBS.hs b/Graphics/Rendering/OpenGL/GLU/NURBS.hs
--- a/Graphics/Rendering/OpenGL/GLU/NURBS.hs
+++ b/Graphics/Rendering/OpenGL/GLU/NURBS.hs
@@ -1,310 +1,310 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.NURBS
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to chapter 7 (NURBS) of the GLU specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.NURBS (
- NURBSObj, withNURBSObj,
- NURBSBeginCallback, withNURBSBeginCallback,
- NURBSVertexCallback, withNURBSVertexCallback,
- NURBSNormalCallback, withNURBSNormalCallback,
- NURBSColorCallback, withNURBSColorCallback,
- NURBSEndCallback, withNURBSEndCallback,
- checkForNURBSError,
- nurbsBeginEndCurve, nurbsCurve,
- nurbsBeginEndSurface, nurbsSurface,
- TrimmingPoint, nurbsBeginEndTrim, pwlCurve, trimmingCurve,
- NURBSMode(..), setNURBSMode,
- setNURBSCulling,
- SamplingMethod(..), setSamplingMethod,
- loadSamplingMatrices,
- DisplayMode'(..), setDisplayMode'
-) where
-
-import Control.Monad
-import Foreign.Marshal.Array
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Rendering.GLU.Raw hiding (
- NURBSBeginCallback, NURBSVertexCallback, NURBSNormalCallback,
- NURBSColorCallback, NURBSEndCallback )
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.GL.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
-
---------------------------------------------------------------------------------
--- 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
+-- 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'
diff --git a/Graphics/Rendering/OpenGL/GLU/Quadrics.hs b/Graphics/Rendering/OpenGL/GLU/Quadrics.hs
--- a/Graphics/Rendering/OpenGL/GLU/Quadrics.hs
+++ b/Graphics/Rendering/OpenGL/GLU/Quadrics.hs
@@ -1,155 +1,155 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.Quadrics
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to chapter 6 (Quadrics) of the GLU specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.Quadrics (
- QuadricNormal, QuadricTexture(..), QuadricOrientation(..),
- QuadricDrawStyle(..), QuadricStyle(..),
- Radius, Height, Angle, Slices, Stacks, Loops, QuadricPrimitive(..),
- renderQuadric
-) where
-
-import Control.Monad ( unless )
-import Foreign.Ptr ( Ptr, nullPtr, freeHaskellFunPtr )
-import Graphics.Rendering.GLU.Raw
-import Graphics.Rendering.OpenGL.Raw.Core31
-import Graphics.Rendering.OpenGL.GL.Colors ( ShadingModel(Smooth,Flat) )
-import Graphics.Rendering.OpenGL.GL.Exception ( bracket )
-import Graphics.Rendering.OpenGL.GL.GLboolean ( marshalGLboolean )
-import Graphics.Rendering.OpenGL.GLU.ErrorsInternal (
- recordErrorCode, recordOutOfMemory )
-
---------------------------------------------------------------------------------
-
-data QuadricDrawStyle =
- PointStyle
- | LineStyle
- | FillStyle
- | SilhouetteStyle
- deriving ( Eq, Ord, Show )
-
-marshalQuadricDrawStyle :: QuadricDrawStyle -> GLenum
-marshalQuadricDrawStyle x = case x of
- PointStyle -> glu_POINT
- LineStyle -> glu_LINE
- FillStyle -> glu_FILL
- SilhouetteStyle -> glu_SILHOUETTE
-
---------------------------------------------------------------------------------
-
-type QuadricNormal = Maybe ShadingModel
-
-marshalQuadricNormal :: QuadricNormal -> GLenum
-marshalQuadricNormal (Just Smooth) = glu_SMOOTH
-marshalQuadricNormal (Just Flat ) = glu_FLAT
-marshalQuadricNormal Nothing = glu_NONE
-
---------------------------------------------------------------------------------
-
-data QuadricOrientation =
- Outside
- | Inside
- deriving ( Eq, Ord, Show )
-
-marshalQuadricOrientation :: QuadricOrientation -> GLenum
-marshalQuadricOrientation x = case x of
- Outside -> glu_OUTSIDE
- Inside -> glu_INSIDE
-
---------------------------------------------------------------------------------
-
-data QuadricTexture
- = NoTextureCoordinates
- | GenerateTextureCoordinates
- deriving ( Eq,Ord )
-
-marshalQuadricTexture :: QuadricTexture -> GLboolean
-marshalQuadricTexture NoTextureCoordinates = marshalGLboolean False
-marshalQuadricTexture GenerateTextureCoordinates = marshalGLboolean True
-
---------------------------------------------------------------------------------
-
-data QuadricStyle
- = QuadricStyle QuadricNormal
- QuadricTexture
- QuadricOrientation
- QuadricDrawStyle
- deriving ( Eq,Ord )
-
---------------------------------------------------------------------------------
-
-type Radius = GLdouble
-type Height = GLdouble
-type Angle = GLdouble
-type Slices = GLint
-type Stacks = GLint
-type Loops = GLint
-
---------------------------------------------------------------------------------
-
-data QuadricPrimitive
- = Sphere Radius Slices Stacks
- | Cylinder Radius Radius Height Slices Stacks
- | Disk Radius Radius Slices Loops
- | PartialDisk Radius Radius Slices Loops Angle Angle
- deriving ( Eq, Ord )
-
---------------------------------------------------------------------------------
-
-renderQuadric :: QuadricStyle -> QuadricPrimitive -> IO ()
-renderQuadric style prim = do
- withQuadricObj recordOutOfMemory $ \quadricObj ->
- withErrorCallback quadricObj recordErrorCode $ do
- setStyle quadricObj style
- renderPrimitive quadricObj prim
-
-withQuadricObj :: IO a -> (QuadricObj -> IO a) -> IO a
-withQuadricObj failure success =
- bracket gluNewQuadric safeDeleteQuadric
- (\quadricObj -> if isNullQuadricObj quadricObj
- then failure
- else success quadricObj)
-
-safeDeleteQuadric :: QuadricObj -> IO ()
-safeDeleteQuadric quadricObj =
- unless (isNullQuadricObj quadricObj) $ gluDeleteQuadric quadricObj
-
-withErrorCallback :: QuadricObj -> QuadricCallback -> IO a -> IO a
-withErrorCallback quadricObj callback action =
- bracket (makeQuadricCallback callback) freeHaskellFunPtr $ \callbackPtr -> do
- gluQuadricCallback quadricObj glu_ERROR callbackPtr
- action
-
-setStyle :: QuadricObj -> QuadricStyle -> IO ()
-setStyle quadricObj (QuadricStyle n t o d) = do
- gluQuadricNormals quadricObj (marshalQuadricNormal n)
- gluQuadricTexture quadricObj (marshalQuadricTexture t)
- gluQuadricOrientation quadricObj (marshalQuadricOrientation o)
- gluQuadricDrawStyle quadricObj (marshalQuadricDrawStyle d)
-
-renderPrimitive :: QuadricObj -> QuadricPrimitive -> IO ()
-renderPrimitive quadricObj (Sphere r s n) =
- gluSphere quadricObj r s n
-renderPrimitive quadricObj (Cylinder b t h s n) =
- gluCylinder quadricObj b t h s n
-renderPrimitive quadricObj (Disk i o s l) =
- gluDisk quadricObj i o s l
-renderPrimitive quadricObj (PartialDisk i o s l a w) =
- gluPartialDisk quadricObj i o s l a w
-
---------------------------------------------------------------------------------
-
-type QuadricObj = Ptr GLUquadric
-
-isNullQuadricObj :: QuadricObj -> Bool
-isNullQuadricObj = (nullPtr ==)
+--------------------------------------------------------------------------------
+-- |
+-- Module : Graphics.Rendering.OpenGL.GLU.Quadrics
+-- Copyright : (c) Sven Panne 2002-2013
+-- License : BSD3
+--
+-- Maintainer : Sven Panne
+-- 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 ==)
diff --git a/Graphics/Rendering/OpenGL/GLU/Tessellation.hs b/Graphics/Rendering/OpenGL/GLU/Tessellation.hs
--- a/Graphics/Rendering/OpenGL/GLU/Tessellation.hs
+++ b/Graphics/Rendering/OpenGL/GLU/Tessellation.hs
@@ -1,521 +1,521 @@
---------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.OpenGL.GLU.Tessellation
--- Copyright : (c) Sven Panne 2002-2009
--- License : BSD-style (see the file libraries/OpenGL/LICENSE)
---
--- Maintainer : sven.panne@aedion.de
--- Stability : stable
--- Portability : portable
---
--- This module corresponds to chapter 5 (Polygon Tessellation) of the GLU specs.
---
---------------------------------------------------------------------------------
-
-module Graphics.Rendering.OpenGL.GLU.Tessellation (
- -- * Polygon description
- AnnotatedVertex(..), ComplexContour(..), ComplexPolygon(..),
-
- -- * Combining vertices
- WeightedProperties(..), Combiner,
-
- -- * Tessellation parameters
- TessWinding(..), Tolerance,
-
- -- * Tessellator type
- Tessellator,
-
- -- * Contour extraction
- SimpleContour(..), PolygonContours(..), extractContours,
-
- -- * Triangulation
- TriangleVertex, Triangle(..), Triangulation(..), triangulate,
-
- -- * Tessellation into primitives
- Primitive(..), SimplePolygon(..), tessellate
-) where
-
-import Control.Monad ( foldM_, unless )
-import Data.IORef ( newIORef, readIORef, writeIORef, modifyIORef )
-import Data.Maybe ( fromJust, 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.Raw.Core31
-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
-
---------------------------------------------------------------------------------
-
-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
+-- 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
diff --git a/OpenGL.cabal b/OpenGL.cabal
--- a/OpenGL.cabal
+++ b/OpenGL.cabal
@@ -1,133 +1,150 @@
-name: OpenGL
-version: 2.8.0.0
-license: BSD3
-license-file: LICENSE
-maintainer: Jason Dagit
-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 3.2) and its
- accompanying utility library (GLU, version 1.3).
- .
- OpenGL is the industry's most widely used and supported 2D and 3D graphics
- application programming interface (API), incorporating a broad set of
- rendering, texture mapping, special effects, and other powerful visualization
- functions. For more information about OpenGL and its various extensions,
- please see
- and .
-build-type: Simple
-cabal-version: >= 1.6
-library
- exposed-modules:
- Graphics.Rendering.OpenGL.GL.Antialiasing,
- Graphics.Rendering.OpenGL.GL.BeginEnd,
- Graphics.Rendering.OpenGL.GL.Bitmaps,
- Graphics.Rendering.OpenGL.GL.BufferObjects,
- Graphics.Rendering.OpenGL.GL.Clipping,
- Graphics.Rendering.OpenGL.GL.Colors,
- Graphics.Rendering.OpenGL.GL.ColorSum,
- Graphics.Rendering.OpenGL.GL.CoordTrans,
- Graphics.Rendering.OpenGL.GL.DisplayLists,
- Graphics.Rendering.OpenGL.GL.Evaluators,
- Graphics.Rendering.OpenGL.GL.Feedback,
- Graphics.Rendering.OpenGL.GL.FlushFinish,
- Graphics.Rendering.OpenGL.GL.Fog,
- Graphics.Rendering.OpenGL.GL.Framebuffer,
- Graphics.Rendering.OpenGL.GL.FramebufferObjects
- Graphics.Rendering.OpenGL.GL.Hints,
- Graphics.Rendering.OpenGL.GL,
- Graphics.Rendering.OpenGL.GL.LineSegments,
- Graphics.Rendering.OpenGL.GL.ObjectName,
- Graphics.Rendering.OpenGL.GL.PerFragment,
- Graphics.Rendering.OpenGL.GL.PixellikeObject,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.ColorTable,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.Convolution,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.Histogram,
- Graphics.Rendering.OpenGL.GL.PixelRectangles,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.Minmax,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelMap,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelStorage,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.PixelTransfer,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.Rasterization,
- Graphics.Rendering.OpenGL.GL.Points,
- Graphics.Rendering.OpenGL.GL.Polygons,
- Graphics.Rendering.OpenGL.GL.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.StateVar,
- Graphics.Rendering.OpenGL.GL.StringQueries,
- Graphics.Rendering.OpenGL.GL.Tensor,
- Graphics.Rendering.OpenGL.GL.Texturing.Application,
- Graphics.Rendering.OpenGL.GL.Texturing.Environments,
- Graphics.Rendering.OpenGL.GL.Texturing,
- Graphics.Rendering.OpenGL.GL.Texturing.Objects,
- Graphics.Rendering.OpenGL.GL.Texturing.Parameters,
- Graphics.Rendering.OpenGL.GL.Texturing.Queries,
- Graphics.Rendering.OpenGL.GL.Texturing.Specification,
- Graphics.Rendering.OpenGL.GL.TransformFeedback
- Graphics.Rendering.OpenGL.GLU.Errors,
- Graphics.Rendering.OpenGL.GLU,
- Graphics.Rendering.OpenGL.GLU.Initialization,
- Graphics.Rendering.OpenGL.GLU.Matrix,
- Graphics.Rendering.OpenGL.GLU.Mipmapping,
- Graphics.Rendering.OpenGL.GLU.NURBS,
- Graphics.Rendering.OpenGL.GLU.Quadrics,
- Graphics.Rendering.OpenGL.GLU.Tessellation,
- Graphics.Rendering.OpenGL.GL.VertexArrays,
- Graphics.Rendering.OpenGL.GL.VertexArrayObjects,
- Graphics.Rendering.OpenGL.GL.VertexSpec,
- Graphics.Rendering.OpenGL,
- 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.Attachments,
- Graphics.Rendering.OpenGL.GL.FramebufferObjects.FramebufferObjects,
- Graphics.Rendering.OpenGL.GL.FramebufferObjects.Queries,
- Graphics.Rendering.OpenGL.GL.FramebufferObjects.RenderbufferObjects,
- Graphics.Rendering.OpenGL.GL.GLboolean,
- Graphics.Rendering.OpenGL.GL.GLstring,
- Graphics.Rendering.OpenGL.GL.IOState,
- Graphics.Rendering.OpenGL.GL.PeekPoke,
- Graphics.Rendering.OpenGL.GL.PixelData,
- Graphics.Rendering.OpenGL.GL.PixelFormat,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.Reset,
- Graphics.Rendering.OpenGL.GL.PixelRectangles.Sink,
- Graphics.Rendering.OpenGL.GL.PointParameter,
- Graphics.Rendering.OpenGL.GL.PolygonMode,
- Graphics.Rendering.OpenGL.GL.PrimitiveMode,
- Graphics.Rendering.OpenGL.GL.QueryUtils,
- Graphics.Rendering.OpenGL.GL.QueryUtils.PName,
- Graphics.Rendering.OpenGL.GL.QueryUtils.VertexAttrib,
- Graphics.Rendering.OpenGL.GL.RenderMode,
- Graphics.Rendering.OpenGL.GL.Shaders.Attribs,
- Graphics.Rendering.OpenGL.GL.Shaders.Limits,
- Graphics.Rendering.OpenGL.GL.Shaders.Program,
- Graphics.Rendering.OpenGL.GL.Shaders.Shaders,
- Graphics.Rendering.OpenGL.GL.Shaders.Uniform,
- Graphics.Rendering.OpenGL.GL.Shaders.Variables,
- Graphics.Rendering.OpenGL.GL.Texturing.PixelInternalFormat,
- Graphics.Rendering.OpenGL.GL.Texturing.TexParameter,
- Graphics.Rendering.OpenGL.GL.Texturing.TextureTarget,
- Graphics.Rendering.OpenGL.GL.Texturing.TextureUnit,
- Graphics.Rendering.OpenGL.GL.VertexAttributes,
- Graphics.Rendering.OpenGL.GLU.ErrorsInternal
- ghc-options: -Wall -O2
- build-depends:
- base >= 3 && < 5, OpenGLRaw >= 1.3.0.0, GLURaw >= 1.1.0.0
-
-source-repository head
- type: git
- location: https://github.com/haskell-opengl/OpenGL
+name: OpenGL
+version: 2.9.0.0
+license: BSD3
+license-file: LICENSE
+maintainer: Sven Panne , Jason Dagit
+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
+ and .
+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
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+[](https://travis-ci.org/haskell-opengl/OpenGL)