OpenGL-2.8.0.0/0000755000000000000000000000000012121453161011165 5ustar0000000000000000OpenGL-2.8.0.0/Setup.hs0000644000000000000000000000005612121453161012622 0ustar0000000000000000import Distribution.Simple main = defaultMain OpenGL-2.8.0.0/OpenGL.cabal0000644000000000000000000001357612121453161013311 0ustar0000000000000000name: 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 OpenGL-2.8.0.0/LICENSE0000644000000000000000000000272212121453161012175 0ustar0000000000000000Copyright (c) 2002-2005, Sven Panne All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. OpenGL-2.8.0.0/Graphics/0000755000000000000000000000000012121453161012725 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/0000755000000000000000000000000012121453161014642 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL.hs0000644000000000000000000001254012121453161016324 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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. OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/0000755000000000000000000000000012121453161015766 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU.hs0000644000000000000000000000232312121453161016751 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL.hs0000644000000000000000000001132612121453161016627 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/0000755000000000000000000000000012121453161016415 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/Tessellation.hs0000644000000000000000000004562512121453161021433 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/Quadrics.hs0000644000000000000000000001243512121453161020531 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 ==) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/NURBS.hs0000644000000000000000000002757112121453161017656 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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' OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/Mipmapping.hs0000644000000000000000000000530012121453161021050 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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? OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/Matrix.hs0000644000000000000000000001120012121453161020207 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/Initialization.hs0000644000000000000000000000234512121453161021744 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/ErrorsInternal.hs0000644000000000000000000001303112121453161021720 0ustar0000000000000000{-# 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GLU/Errors.hs0000644000000000000000000000262112121453161020226 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/0000755000000000000000000000000012121453161016270 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/VertexSpec.hs0000644000000000000000000012304712121453161020723 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/VertexAttributes.hs0000644000000000000000000002724712121453161022164 0ustar0000000000000000{-# 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/VertexArrays.hs0000644000000000000000000004575512121453161021303 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/VertexArrayObjects.hs0000644000000000000000000000336712121453161022423 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/TransformFeedback.hs0000644000000000000000000001262412121453161022211 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing.hs0000644000000000000000000000240012121453161020611 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Tensor.hs0000644000000000000000000002574612121453161020114 0ustar0000000000000000{-# 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/StringQueries.hs0000644000000000000000000000633012121453161021432 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/StateVar.hs0000644000000000000000000001075512121453161020365 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders.hs0000644000000000000000000000333212121453161020216 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Selection.hs0000644000000000000000000000574112121453161020560 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/SavingState.hs0000644000000000000000000001020412121453161021051 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/RenderMode.hs0000644000000000000000000000376012121453161020656 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Rectangles.hs0000644000000000000000000000506712121453161020723 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/ReadCopyPixels.hs0000644000000000000000000000632212121453161021522 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/RasterPos.hs0000644000000000000000000001521012121453161020545 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/QueryUtils.hs0000644000000000000000000002770512121453161020765 0ustar0000000000000000-- #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 -------------------------------------------------------------------------------- OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/QueryObjects.hs0000644000000000000000000001237112121453161021247 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PrimitiveMode.hs0000644000000000000000000001017512121453161021405 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Polygons.hs0000644000000000000000000001212312121453161020435 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PolygonMode.hs0000644000000000000000000000226212121453161021062 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Points.hs0000644000000000000000000002213412121453161020102 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PointParameter.hs0000644000000000000000000000313112121453161021554 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles.hs0000644000000000000000000000314612121453161021721 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixellikeObject.hs0000644000000000000000000000623712121453161021711 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelFormat.hs0000644000000000000000000000763712121453161021073 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelData.hs0000644000000000000000000000211512121453161020476 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PerFragment.hs0000644000000000000000000002764312121453161021052 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PeekPoke.hs0000644000000000000000000000563212121453161020335 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/ObjectName.hs0000644000000000000000000000234612121453161020640 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/LineSegments.hs0000644000000000000000000001511412121453161021223 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/IOState.hs0000644000000000000000000000354212121453161020140 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Hints.hs0000644000000000000000000000561312121453161017716 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/GLstring.hs0000644000000000000000000000304612121453161020360 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/GLboolean.hs0000644000000000000000000000170012121453161020464 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/FramebufferObjects.hs0000644000000000000000000000276212121453161022371 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Framebuffer.hs0000644000000000000000000004517512121453161021064 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Fog.hs0000644000000000000000000001433112121453161017341 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/FlushFinish.hs0000644000000000000000000000367012121453161021054 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Feedback.hs0000644000000000000000000001570012121453161020313 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Face.hs0000644000000000000000000000217412121453161017466 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Exception.hs0000644000000000000000000000300212121453161020555 0ustar0000000000000000{-# 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Evaluators.hs0000644000000000000000000003326312121453161020760 0ustar0000000000000000{-# 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/EdgeFlag.hs0000644000000000000000000000231712121453161020265 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Domain.hs0000644000000000000000000000477712121453161020052 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/DisplayLists.hs0000644000000000000000000001263512121453161021257 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/DataType.hs0000644000000000000000000001337612121453161020351 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/CoordTrans.hs0000644000000000000000000004703612121453161020714 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/ControlPoint.hs0000644000000000000000000001367612121453161021273 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/ComparisonFunction.hs0000644000000000000000000000315312121453161022446 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/ColorSum.hs0000644000000000000000000000147412121453161020375 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Colors.hs0000644000000000000000000004425612121453161020100 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Clipping.hs0000644000000000000000000000373212121453161020376 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Capability.hs0000644000000000000000000002721112121453161020710 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/BufferObjects.hs0000644000000000000000000003545612121453161021364 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/BufferMode.hs0000644000000000000000000001212212121453161020640 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/BlendingFactor.hs0000644000000000000000000000501612121453161021507 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Bitmaps.hs0000644000000000000000000000203212121453161020220 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/BeginEnd.hs0000644000000000000000000001313612121453161020303 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Antialiasing.hs0000644000000000000000000000252212121453161021230 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/0000755000000000000000000000000012121453161020261 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/TextureUnit.hs0000644000000000000000000000323212121453161023115 0ustar0000000000000000-- #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)) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/TextureTarget.hs0000644000000000000000000000567212121453161023436 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/TexParameter.hs0000644000000000000000000001362212121453161023222 0ustar0000000000000000-- #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)) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/Specification.hs0000644000000000000000000002702112121453161023377 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/Queries.hs0000644000000000000000000001452512121453161022241 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/PixelInternalFormat.hs0000644000000000000000000002706512121453161024556 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/Parameters.hs0000644000000000000000000002366412121453161022733 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/Objects.hs0000644000000000000000000001001212121453161022200 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/Environments.hs0000644000000000000000000003023712121453161023311 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Texturing/Application.hs0000644000000000000000000000233712121453161023065 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders/0000755000000000000000000000000012121453161017661 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders/Variables.hs0000644000000000000000000001234612121453161022133 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders/Uniform.hs0000644000000000000000000002124612121453161021641 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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) -------------------------------------------------------------------------------- OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders/Shaders.hs0000644000000000000000000001227212121453161021612 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders/Program.hs0000644000000000000000000001662112121453161021632 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders/Limits.hs0000644000000000000000000000606512121453161021465 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/Shaders/Attribs.hs0000644000000000000000000000421012121453161021622 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/QueryUtils/0000755000000000000000000000000012121453161020416 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/QueryUtils/VertexAttrib.hs0000644000000000000000000001006712121453161023401 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/QueryUtils/PName.hs0000644000000000000000000013755512121453161021772 0ustar0000000000000000-- #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 ----------------------------------------------------------------------------- OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/0000755000000000000000000000000012121453161021361 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/Sink.hs0000644000000000000000000000203112121453161022615 0ustar0000000000000000-- #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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/Reset.hs0000644000000000000000000000165412121453161023005 0ustar0000000000000000-- #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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/Rasterization.hs0000644000000000000000000000277312121453161024564 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelTransfer.hs0000644000000000000000000002210712121453161024505 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelStorage.hs0000644000000000000000000001021712121453161024324 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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)) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/PixelMap.hs0000644000000000000000000001647112121453161023445 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/Minmax.hs0000644000000000000000000000611712121453161023153 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/Histogram.hs0000644000000000000000000001213212121453161023651 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/Convolution.hs0000644000000000000000000002630412121453161024241 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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) OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/PixelRectangles/ColorTable.hs0000644000000000000000000002422312121453161023746 0ustar0000000000000000-------------------------------------------------------------------------------- -- | -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/FramebufferObjects/0000755000000000000000000000000012121453161022026 5ustar0000000000000000OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/FramebufferObjects/RenderbufferObjects.hs0000644000000000000000000000735012121453161026312 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Queries.hs0000644000000000000000000002373312121453161024007 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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 OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/FramebufferObjects/FramebufferObjects.hs0000644000000000000000000000761512121453161026131 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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 ----------------------------------------------------------------------------- OpenGL-2.8.0.0/Graphics/Rendering/OpenGL/GL/FramebufferObjects/Attachments.hs0000644000000000000000000001474712121453161024652 0ustar0000000000000000----------------------------------------------------------------------------- -- -- 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)