packages feed

lowgl 0.3.1.2 → 0.4.0.0

raw patch · 21 files changed

+489/−673 lines, 21 files

Files

Graphics/GL/Low.hs view
@@ -2,25 +2,16 @@ module Graphics.GL.Low (    -- * Overview-  -- | OpenGL is a graphics rendering interface. This library exposes a vastly-  -- simplified subset of OpenGL that is hopefully still complete enough for-  -- many purposes, such as following tutorials, making simple games, and-  -- demos. In particular the intention is to concentrate on a subset of-  -- OpenGL 3.2 (Core Profile) roughly corresponding to ES 2.0.+  -- | This library exposes a simplified subset of OpenGL that I hope is+  -- complete enough for following tutorials and making simple games or demos.   ---  -- A second primary purpose is to document the complex model behind the-  -- interface in a way that is more elaborate than tutorials and more concise-  -- than the spec. As such, this is an experimental project to aid my own-  -- process of understanding OpenGL. It seems that understanding the entire-  -- picture up-front is the only way to get started, so this should also serve-  -- as a quick reference guide to the core commands and concepts.+  -- For a whirlwind tour of the machinery behind GL see the module:   -- "Graphics.GL.Low.EntirePictureUpFront"   --   -- This library uses the `gl' package for raw bindings to OpenGL and the   -- `linear' package for matrices.   ---  ---  -- See specific modules for topic-specific docs and example code:+  -- See submodules for specialized documentation of each subsystem.   --   -- @"Graphics.GL.Low.VAO"@   --@@ -34,10 +25,6 @@   --   -- @"Graphics.GL.Low.Render"@   ---  -- @"Graphics.GL.Low.Color"@-  ---  -- @"Graphics.GL.Low.Depth"@-  --    -- @"Graphics.GL.Low.Stencil"@   --   -- @"Graphics.GL.Low.Blending"@@@ -53,15 +40,13 @@    -- * Buffer Objects   -- | See also "Graphics.GL.Low.BufferObject".-  newVBO,-  newElementArray,+  newBufferObject,   bindVBO,   bindElementArray,   updateVBO,   updateElementArray,   deleteBufferObject,-  VBO,-  ElementArray,+  BufferObject,   UsageHint(..),    -- * Shader Program@@ -87,12 +72,13 @@   -- ** Vertex Attributes   -- | See also "Graphics.GL.Low.VertexAttrib".   setVertexLayout,-  VertexLayout(..),+  LayoutElement(..),   DataType(..),     -- * Textures   -- | See also "Graphics.GL.Low.Texture".+  Texture,   newTexture2D,   newCubeMap,   newEmptyTexture2D,@@ -105,11 +91,7 @@   setCubeMapFiltering,   setTex2DWrapping,   setCubeMapWrapping,-  Tex2D,-  CubeMap,-  Dimensions(..),   Cube(..),-  Side,   Filtering(..),   Wrapping(..), @@ -141,13 +123,11 @@   IndexFormat(..),    -- ** Color Buffer-  -- | See also "Graphics.GL.Low.Color".   enableColorWriting,   disableColorWriting,   clearColorBuffer,    -- ** Depth Test-  -- | See also "Graphics.GL.Low.Depth".   enableDepthTest,   disableDepthTest,   clearDepthBuffer,@@ -174,14 +154,14 @@    -- * Framebuffers   -- | See also "Graphics.GL.Low.Framebuffer".-  DefaultFramebuffer(..),   FBO,-  bindFramebuffer,   newFBO,+  bindFBO,+  bindDefaultFramebuffer,+  deleteFBO,   attachTex2D,   attachCubeMap,   attachRBO,-  deleteFBO,    -- * Renderbuffers   RBO,@@ -194,19 +174,7 @@   assertNoGLError,    -- * Image Formats-  Alpha,-  Luminance,-  LuminanceAlpha,-  RGB,-  RGBA,-  Depth24,-  Depth24Stencil8,--  -- * Classes-  InternalFormat(..),-  Framebuffer(..),-  Texture(..),-  Attachable(..)+  ImageFormat(..),  ) where @@ -218,10 +186,7 @@ import Graphics.GL.Low.Texture import Graphics.GL.Low.Framebuffer import Graphics.GL.Low.Blending-import Graphics.GL.Low.Color-import Graphics.GL.Low.Depth import Graphics.GL.Low.Stencil import Graphics.GL.Low.Render-import Graphics.GL.Low.ImageFormat import Graphics.GL.Low.Cube import Graphics.GL.Low.Error
Graphics/GL/Low/Blending.hs view
@@ -24,40 +24,10 @@   -- $example ) where -import Control.Monad.IO.Class-import Data.Default import Graphics.GL  import Graphics.GL.Low.Classes --- | Enable blending with the specified blending parameters.-enableBlending :: (MonadIO m) => Blending -> m ()-enableBlending (Blending s d f (r,g,b,a)) = do-  glBlendFunc (toGL s) (toGL d)-  glBlendEquation (toGL f)-  let c = realToFrac-  glBlendColor (c r) (c g) (c b) (c a)-  glEnable GL_BLEND---- | Disable alpha blending.-disableBlending :: (MonadIO m) => m ()-disableBlending = glDisable GL_BLEND---- | This blending configuration is suitable for ordinary alpha blending--- transparency effects.------ @--- Blending---   { sFactor   = BlendSourceAlpha---   , dFactor   = BlendOneMinusSourceAlpha---   , blendFunc = FuncAdd }--- @-basicBlending :: Blending-basicBlending = def-  { sFactor = BlendSourceAlpha-  , dFactor = BlendOneMinusSourceAlpha }-- -- | Blending parameters. data Blending = Blending   { sFactor :: BlendFactor@@ -65,15 +35,6 @@   , blendFunc :: BlendEquation   , blendColor :: (Float,Float,Float,Float) } --- | The default blending parameters have no effect if enabled. The result--- will be no blending effect.-instance Default Blending where-  def = Blending-    { sFactor = BlendOne-    , dFactor = BlendZero-    , blendFunc = FuncAdd-    , blendColor = (0,0,0,0) }- -- | Blending functions. data BlendEquation =   FuncAdd | -- ^ the default@@ -81,15 +42,11 @@   FuncReverseSubtract     deriving (Eq, Ord, Show, Read) -instance Default BlendEquation where-  def = FuncAdd- instance ToGL BlendEquation where   toGL FuncAdd = GL_FUNC_ADD   toGL FuncSubtract = GL_FUNC_SUBTRACT   toGL FuncReverseSubtract = GL_FUNC_REVERSE_SUBTRACT - -- | Blending factors. data BlendFactor =   BlendOne |@@ -106,7 +63,7 @@   BlendOneMinusConstantColor |   BlendConstantAlpha |   BlendOneMinusConstantAlpha-    deriving Show+    deriving (Show, Read, Eq, Ord)  instance ToGL BlendFactor where   toGL BlendOne = GL_ONE@@ -125,6 +82,36 @@   toGL BlendOneMinusConstantAlpha = GL_ONE_MINUS_CONSTANT_ALPHA  +-- | Enable blending with the specified blending parameters.+enableBlending :: Blending -> IO ()+enableBlending (Blending s d f (r,g,b,a)) = do+  glBlendFunc (toGL s) (toGL d)+  glBlendEquation (toGL f)+  let c = realToFrac+  glBlendColor (c r) (c g) (c b) (c a)+  glEnable GL_BLEND++-- | Disable alpha blending.+disableBlending :: IO ()+disableBlending = glDisable GL_BLEND++-- | This blending configuration is suitable for ordinary alpha blending+-- transparency effects.+--+-- @+-- Blending+--   { sFactor   = BlendSourceAlpha+--   , dFactor   = BlendOneMinusSourceAlpha+--   , blendFunc = FuncAdd }+-- @+basicBlending :: Blending+basicBlending = Blending+  { sFactor = BlendSourceAlpha+  , dFactor = BlendOneMinusSourceAlpha+  , blendFunc = FuncAdd+  , blendColor = (0,0,0,0) }++ -- $example -- -- <<blending1.png Blending Before>> <<blending2.png Blending After>>@@ -143,7 +130,6 @@ -- module Main where --  -- import Control.Monad.Loops (whileM_)--- import Data.Functor ((\<$\>)) -- import qualified Data.Vector.Storable as V -- import Control.Concurrent.STM -- @@ -183,7 +169,7 @@ --         [ -0.5,  0.5 --         ,  0.5,    0 --         , -0.5, -0.5 ] :: V.Vector Float---   vbo <- newVBO blob StaticDraw+--   vbo <- newBufferObject blob StaticDraw --   bindVBO vbo --   setVertexLayout [Attrib "position" 2 GLFloat] --   enableBlending basicBlending
Graphics/GL/Low/BufferObject.hs view
@@ -11,14 +11,14 @@ -- vertex shader interprets the data for each vertex by mapping the attributes -- of the vertex (position, normal vector, etc) to input variables using the -- VAO. VBOs have the data which is used as input to the vertex shader--- according to the configuration of the VAO/.+-- according to the configuration of the VAO. -- -- Example VBO contents: -- -- <<vbo.png VBO diagram>> -- -- The shader will interpret those parts of the VBO as illustrated only after--- appropiately configuring a VAO. See "Graphics.GL.Low.VAO".+-- appropriately configuring a VAO. See "Graphics.GL.Low.VAO".  -- * ElementArray @@ -29,7 +29,7 @@ -- accepts element array objects whose indices are encoded as unsigned bytes, -- unsigned 16-bit ints, and unsigned 32-bit ints. ----- Example ElementArray contents appropriate for render triangles and lines+-- Example ElementArray contents appropriate for rendering triangles and lines -- respectively: -- -- <<element_array.png Element array diagram>>@@ -42,15 +42,13 @@  -- * Documentation -  newVBO,-  updateVBO,+  newBufferObject,+  deleteBufferObject,   bindVBO,-  newElementArray,-  updateElementArray,+  updateVBO,   bindElementArray,-  deleteBufferObject,-  VBO,-  ElementArray,+  updateElementArray,+  BufferObject,   UsageHint(..) ) where @@ -61,11 +59,10 @@ import qualified Data.Vector.Storable as V import Data.Vector.Storable (Vector) import Data.Word-import Control.Monad.IO.Class  import Graphics.GL -import Graphics.GL.Low.Internal.Types+import Graphics.GL.Low.Types import Graphics.GL.Low.Classes  @@ -80,66 +77,62 @@   toGL DynamicDraw = GL_DYNAMIC_DRAW   toGL StreamDraw  = GL_STREAM_DRAW -+-- | Use this to create VBOs or element arrays from raw data. Choose the+-- usage hint based on how often you expect to modify the VBO's contents.+newBufferObject :: Storable a => Vector a -> UsageHint -> IO BufferObject+newBufferObject = newBufferObjectNonClobbering GL_ARRAY_BUFFER --- | Create a buffer object from a blob of bytes. The usage argument hints--- at how often you will modify the data.-newVBO :: (MonadIO m, Storable a) => Vector a -> UsageHint -> m VBO-newVBO = newBufferObject VBO GL_ARRAY_BUFFER+newBufferObjectNonClobbering :: forall a . Storable a => GLenum -> Vector a -> UsageHint -> IO BufferObject+newBufferObjectNonClobbering target src usage = do+  orig <- getArrayBufferBinding+  n <- alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr)+  glBindBuffer target n+  let (fptr, off, len) = V.unsafeToForeignPtr src+  let size = sizeOf (undefined :: a)+  withForeignPtr fptr $ \ptr -> glBufferData+    target+    (fromIntegral (len * size))+    (castPtr (ptr `plusPtr` off))+    (toGL usage)+  glBindBuffer target (fromIntegral orig)+  return (BufferObject n) --- | Delete a VBO or ElementArray.-deleteBufferObject :: (MonadIO m, BufferObject a) => a -> m ()-deleteBufferObject bo = liftIO $ withArray [glObjectName bo] (\ptr -> glDeleteBuffers 1 ptr)+getArrayBufferBinding :: IO GLint+getArrayBufferBinding = alloca $ \ptr -> do+  glGetIntegerv GL_ARRAY_BUFFER_BINDING ptr+  peek ptr  -- | Modify the data in the currently bound VBO starting from the specified -- index in bytes.-updateVBO :: (MonadIO m, Storable a) => Vector a -> Int -> m ()+updateVBO :: Storable a => Vector a -> Int -> IO () updateVBO = updateBufferObject GL_ARRAY_BUFFER --- | Bind a VBO to the array buffer binding target. The buffer object bound--- there will be replaced, if any.-bindVBO :: (MonadIO m) => VBO -> m ()-bindVBO (VBO n) = glBindBuffer GL_ARRAY_BUFFER n----- | Create a new ElementArray buffer object from the blob of packed indices.--- The usage argument hints at how often you plan to modify the data.-newElementArray :: (MonadIO m, Storable a) => Vector a -> UsageHint -> m ElementArray-newElementArray = newBufferObject ElementArray GL_ELEMENT_ARRAY_BUFFER---- | Modify contents in the currently bound ElementArray starting at the+-- | Modify contents in the currently bound element array starting at the -- specified index in bytes.-updateElementArray :: (MonadIO m, Storable a) => Vector a -> Int -> m ()+updateElementArray :: Storable a => Vector a -> Int -> IO () updateElementArray = updateBufferObject GL_ELEMENT_ARRAY_BUFFER --- | Assign an ElementArray to the element array binding target. It will--- replace the ElementArray already bound there, if any. Note that the state--- of the element array binding target is a function of the current VAO.-bindElementArray :: (MonadIO m) => ElementArray -> m ()-bindElementArray (ElementArray n) = glBindBuffer GL_ELEMENT_ARRAY_BUFFER n---newBufferObject :: forall m a b. (MonadIO m, Storable a) => (GLuint -> b) -> GLenum -> Vector a -> UsageHint -> m b-newBufferObject ctor target src usage = do-  n <- liftIO $ alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr)-  glBindBuffer target n+updateBufferObject :: forall a . Storable a => GLenum -> Vector a -> Int -> IO ()+updateBufferObject target src offset = do   let (fptr, off, len) = V.unsafeToForeignPtr src   let size = sizeOf (undefined :: a)-  liftIO . withForeignPtr fptr $ \ptr -> glBufferData-    target-    (fromIntegral (len * size))-    (castPtr (ptr `plusPtr` off))-    (toGL usage)-  return (ctor n)--updateBufferObject :: forall m a. (MonadIO m, Storable a) => GLenum -> Vector a -> Int -> m ()-updateBufferObject target bytes offset = do-  let (fptr, off, len) = V.unsafeToForeignPtr bytes-  let size = sizeOf (undefined :: a)-  liftIO . withForeignPtr fptr $ \ptr -> glBufferSubData+  withForeignPtr fptr $ \ptr -> glBufferSubData     target     (fromIntegral offset)     (fromIntegral (len * size))     (castPtr (ptr `plusPtr` off)) +-- | Delete a buffer object.+deleteBufferObject :: BufferObject -> IO ()+deleteBufferObject bo = withArray [fromBufferObject bo] (\ptr -> glDeleteBuffers 1 ptr) +-- | Bind a VBO to the array buffer binding target. The buffer object bound+-- there will be replaced, if any.+bindVBO :: BufferObject -> IO ()+bindVBO = glBindBuffer GL_ARRAY_BUFFER . fromBufferObject++-- | Assign an element array to the element array binding target. It will+-- replace the buffer object already bound there, if any. The binding will+-- be remembered in the currently bound VAO.+bindElementArray :: BufferObject -> IO ()+bindElementArray = glBindBuffer GL_ELEMENT_ARRAY_BUFFER . fromBufferObject
Graphics/GL/Low/Classes.hs view
@@ -2,36 +2,10 @@  import Graphics.GL --- | OpenGL internal image formats.-class InternalFormat a where-  internalFormat :: (Eq b, Num b) => proxy a -> b---- | The allowed attachment point for images with an internal format.-class InternalFormat a => Attachable a where-  attachPoint :: (Eq b, Num b) => proxy a -> b---- | Textures are GL objects.-class GLObject a => Texture a where---- | Framebuffers can be bound to the framebuffer binding target. There is--- a default framebuffer and the client may create an arbitrary number of--- new framebuffer objects.-class Framebuffer a where-  framebufferName :: Num b => a -> b--class GLObject a => BufferObject a where- -- | Mappable to GL enums. class ToGL a where   toGL :: (Num b, Eq b) => a -> b  instance ToGL Bool where-  toGL True = GL_TRUE+  toGL True  = GL_TRUE   toGL False = GL_FALSE------ | All GL objects have some numeric name.-class GLObject a where-  glObjectName :: Num b => a -> b-
− Graphics/GL/Low/Color.hs 
@@ -1,20 +0,0 @@-module Graphics.GL.Low.Color where--import Control.Monad.IO.Class-import Graphics.GL---- | Allow rendering commands to modify the color buffer of the current--- framebuffer.-enableColorWriting :: (MonadIO m) => m ()-enableColorWriting = glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE---- | Disable rendering to color buffer.-disableColorWriting :: (MonadIO m) => m ()-disableColorWriting = glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE---- | Clear the color buffer of the current framebuffer with the specified--- color. Has no effect if writing to the color buffer is disabled.-clearColorBuffer :: (MonadIO m) => (Float, Float, Float) -> m ()-clearColorBuffer (r, g, b) = do-  glClearColor (realToFrac r) (realToFrac g) (realToFrac b) 1.0-  glClear GL_COLOR_BUFFER_BIT
Graphics/GL/Low/Common.hs view
@@ -2,8 +2,19 @@  import Graphics.GL +import Graphics.GL.Low.Types import Graphics.GL.Low.Cube +attachmentPointForImageFormat :: ImageFormat -> GLenum+attachmentPointForImageFormat format = case format of+  RGB             -> GL_COLOR_ATTACHMENT0+  RGBA            -> GL_COLOR_ATTACHMENT0+  Alpha           -> GL_COLOR_ATTACHMENT0+  Luminance       -> GL_COLOR_ATTACHMENT0+  LuminanceAlpha  -> GL_COLOR_ATTACHMENT0+  Depth24         -> GL_DEPTH_ATTACHMENT+  Depth24Stencil8 -> GL_DEPTH_STENCIL_ATTACHMENT+ cubeSideCodes :: Cube GLenum cubeSideCodes = Cube   { cubeLeft   = GL_TEXTURE_CUBE_MAP_NEGATIVE_X@@ -12,4 +23,3 @@   , cubeBottom = GL_TEXTURE_CUBE_MAP_NEGATIVE_Y   , cubeFront  = GL_TEXTURE_CUBE_MAP_POSITIVE_Z   , cubeBack   = GL_TEXTURE_CUBE_MAP_NEGATIVE_Z }-
Graphics/GL/Low/Cube.hs view
@@ -20,10 +20,6 @@   , cubeBack   :: a }     deriving (Show, Functor, Foldable, Traversable) --- | A type to pick one of the sides of a cube. See the accessors of the--- type 'Cube'.-type Side = forall a . Cube a -> a- instance Applicative Cube where   pure x = Cube x x x x x x   (Cube f1 f2 f3 f4 f5 f6) <*> (Cube x1 x2 x3 x4 x5 x6) =
− Graphics/GL/Low/Depth.hs 
@@ -1,18 +0,0 @@-module Graphics.GL.Low.Depth where--import Control.Monad.IO.Class-import Graphics.GL---- | Enable the depth test. Attempting to render pixels with a depth value--- greater than the depth buffer at those pixels will have no effect. Otherwise--- the depth in the buffer will get updated to the new pixel's depth.-enableDepthTest :: (MonadIO m) => m ()-enableDepthTest = glEnable GL_DEPTH_TEST---- | Disable the depth test and depth buffer updates.-disableDepthTest :: (MonadIO m) => m ()-disableDepthTest = glDisable GL_DEPTH_TEST---- | Clear the depth buffer with the maximum depth value.-clearDepthBuffer :: (MonadIO m) => m ()-clearDepthBuffer = glClear GL_DEPTH_BUFFER_BIT
Graphics/GL/Low/EntirePictureUpFront.hs view
@@ -11,9 +11,9 @@   -- | Objects may be created and destroyed by client code. They include:   --   -- - Vertex Array Object ('Graphics.GL.Low.VAO.VAO')-  -- - Buffer Objects ('Graphics.GL.Low.BufferObject.VBO', 'Graphics.GL.Low.BufferObject.ElementArray')-  -- - Textures ('Graphics.GL.Low.Texture.Tex2D', 'Graphics.GL.Low.Texture.CubeMap')-  -- - Shader 'Graphics.GL.Low.Shader.Program's+  -- - 'Graphics.GL.Low.BufferObject's+  -- - 'Graphics.GL.Low.Texture's (either Tex2D or cubemaps)+  -- - 'Graphics.GL.Low.Shader's   -- - Framebuffer Objects ('Graphics.GL.Low.Framebuffer.FBO')   -- - Renderbuffer Objects ('Graphics.GL.Low.Framebuffer.RBO') @@ -189,7 +189,6 @@   -- module Main where   --   -- import Control.Monad.Loops (whileM_)-  -- import Data.Functor ((\<$\>))   -- import qualified Data.Vector.Storable as V   --    -- import qualified Graphics.UI.GLFW as GLFW@@ -228,7 +227,7 @@   --         [ -0.5, -0.5   --         ,    0,  0.5   --         ,  0.5, -0.5 ] :: V.Vector Float-  --   vbo <- newVBO blob StaticDraw+  --   vbo <- newBufferObject blob StaticDraw   --   bindVBO vbo   --   -- connect program to vertex data via the VAO   --   setVertexLayout [Attrib "position" 2 GLFloat]
Graphics/GL/Low/Error.hs view
@@ -16,7 +16,6 @@  import Control.Exception import Data.Typeable-import Control.Monad.IO.Class  import Graphics.GL @@ -48,7 +47,7 @@ -- adversely affect performance (not to mention be very tedious). Since there -- is no reasonable way to recover from a GL error, a good idea might be to -- check this once per frame or even less often, and respond with a core dump.-getGLError :: (MonadIO m) => m (Maybe GLError)+getGLError :: IO (Maybe GLError) getGLError = do   n <- glGetError   return $ case n of@@ -61,9 +60,9 @@     _ -> error ("unknown GL error " ++ show n)  -- | Throws an exception if 'getGLError' returns non-Nothing.-assertNoGLError :: (MonadIO m) => m ()+assertNoGLError :: IO () assertNoGLError = do   me <- getGLError   case me of     Nothing -> return ()-    Just e  -> liftIO $ throwIO e+    Just e  -> throwIO e
Graphics/GL/Low/Framebuffer.hs view
@@ -7,16 +7,16 @@ -- techniques. Rendering to a texture (either color, depth, or depth/stencil) -- is accomplished by using a framebuffer object (FBO). ----- The following ritual sets up an FBO with a blank 256x256 color texture for+-- The following code sets up an FBO with a blank 256x256 color texture for -- off-screen rendering: -- -- @ -- do --   fbo <- newFBO---   tex <- newEmptyTexture2D 256 256 :: IO (Tex2D RGB)+--   tex <- newEmptyTexture2D 256 256 RGB --   bindFramebuffer fbo --   attachTex2D tex---   bindFramebuffer DefaultFramebuffer+--   bindDefaultFramebuffer --   return (fbo, tex) -- @ --@@ -27,7 +27,8 @@ -- a texture to the color attachment point.    newFBO,-  bindFramebuffer,+  bindFBO,+  bindDefaultFramebuffer,   deleteFBO,   attachTex2D,   attachCubeMap,@@ -35,7 +36,6 @@   newRBO,   deleteRBO,   FBO,-  DefaultFramebuffer(..),   RBO    -- * Example@@ -46,86 +46,91 @@ import Foreign.Ptr import Foreign.Marshal import Foreign.Storable-import Control.Monad.IO.Class -import Data.Default import Graphics.GL -import Graphics.GL.Low.Internal.Types+import Graphics.GL.Low.Types import Graphics.GL.Low.Classes-import Graphics.GL.Low.Common import Graphics.GL.Low.Cube import Graphics.GL.Low.Texture----- | The default framebuffer.-data DefaultFramebuffer = DefaultFramebuffer deriving Show--instance Default DefaultFramebuffer where-  def = DefaultFramebuffer--instance Framebuffer DefaultFramebuffer where-  framebufferName _ = 0+import Graphics.GL.Low.Common  --- | Binds an FBO or the default framebuffer to the framebuffer binding target.+-- | Binds an FBO to the framebuffer binding target. -- Replaces the framebuffer already bound there.-bindFramebuffer :: (MonadIO m, Framebuffer a) => a -> m ()-bindFramebuffer x = glBindFramebuffer GL_FRAMEBUFFER (framebufferName x)+bindFBO :: FBO -> IO ()+bindFBO = glBindFramebuffer GL_FRAMEBUFFER . fromFBO +-- | Binds the default framebuffer to the framebuffer binding target.+bindDefaultFramebuffer :: IO ()+bindDefaultFramebuffer = glBindFramebuffer GL_FRAMEBUFFER 0+ -- | Create a new framebuffer object. Before the framebuffer can be used for -- rendering it must have a color image attachment.-newFBO :: (MonadIO m) => m FBO-newFBO = liftIO . fmap FBO $ alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)+newFBO :: IO FBO+newFBO = fmap FBO $ alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)  -- | Delete an FBO.-deleteFBO :: (MonadIO m) => FBO -> m ()-deleteFBO (FBO n) = liftIO $ withArray [n] (\ptr -> glDeleteFramebuffers 1 ptr)+deleteFBO :: FBO -> IO ()+deleteFBO fbo = withArray [fromFBO fbo] (\ptr -> glDeleteFramebuffers 1 ptr)  -- | Attach a 2D texture to the FBO currently bound to the -- framebuffer binding target.-attachTex2D :: (MonadIO m, Attachable a) => Tex2D a -> m ()+attachTex2D :: Texture -> IO () attachTex2D tex =   glFramebufferTexture2D     GL_FRAMEBUFFER-    (attachPoint tex)+    (attachmentPointForImageFormat (texFormat tex))     GL_TEXTURE_2D-    (glObjectName tex)+    (texObjectName tex)     0 --- | Attach one of the sides of a cubemap texture to the FBO currently bound+-- | Attach one of the sides of a cube map texture to the FBO currently bound -- to the framebuffer binding target.-attachCubeMap :: (MonadIO m, Attachable a) => CubeMap a -> Side -> m ()-attachCubeMap cm side =+attachCubeMap :: Texture -> (forall a . Cube a -> a) -> IO ()+attachCubeMap tex side =   glFramebufferTexture2D     GL_FRAMEBUFFER-    (attachPoint cm)+    (attachmentPointForImageFormat (texFormat tex))     (side cubeSideCodes)-    (glObjectName cm)+    (texObjectName tex)     0  -- | Attach an RBO to the FBO currently bound to the framebuffer binding -- target.-attachRBO :: (MonadIO m, Attachable a) => RBO a -> m ()-attachRBO rbo = glFramebufferRenderbuffer-  GL_FRAMEBUFFER (attachPoint rbo) GL_RENDERBUFFER (unRBO rbo)+attachRBO :: RBO -> IO ()+attachRBO rbo =+  glFramebufferRenderbuffer+    GL_FRAMEBUFFER+    (attachmentPointForImageFormat (rboFormat rbo))+    GL_RENDERBUFFER+    (rboObjectName rbo) --- | Create a new renderbuffer with the specified dimensions.-newRBO :: (MonadIO m, InternalFormat a) => Int -> Int -> m (RBO a)-newRBO w h = do-  n <- liftIO $ alloca (\ptr -> glGenRenderbuffers 1 ptr >> peek ptr)-  rbo <- return (RBO n)+-- | Create a new renderbuffer object with the specified dimensions and format.+newRBO :: Int -> Int -> ImageFormat -> IO RBO+newRBO w h format = do+  orig <- getRenderbufferBinding+  n <- alloca (\ptr -> glGenRenderbuffers 1 ptr >> peek ptr)   glBindRenderbuffer GL_RENDERBUFFER n   glRenderbufferStorage     GL_RENDERBUFFER-    (internalFormat rbo)+    (toGL format)     (fromIntegral w)     (fromIntegral h)-  return rbo+  glBindRenderbuffer GL_RENDERBUFFER (fromIntegral orig)+  return (RBO n format) +getRenderbufferBinding :: IO GLint+getRenderbufferBinding = alloca $ \ptr -> do+  glGetIntegerv GL_RENDERBUFFER_BINDING ptr+  peek ptr+ -- | Delete an RBO.-deleteRBO :: (MonadIO m) => RBO a -> m ()-deleteRBO (RBO n) = liftIO $ withArray [n] (\ptr -> glDeleteRenderbuffers 1 ptr)+deleteRBO :: RBO -> IO ()+deleteRBO rbo =+  withArray+    [rboObjectName rbo]+    (\ptr -> glDeleteRenderbuffers 1 ptr)   -- $example@@ -135,15 +140,13 @@ -- This example program renders an animating object to an off-screen -- framebuffer. The resulting texture is then shown on a full-screen quad -- with an effect.---+--  -- @ -- module Main where--- +-- -- import Control.Monad.Loops (whileM_)--- import Data.Functor ((\<$\>)) -- import qualified Data.Vector.Storable as V -- import Data.Maybe (fromJust)--- import Data.Default -- import Data.Word --  -- import qualified Graphics.UI.GLFW as GLFW@@ -163,9 +166,9 @@ --       GLFW.makeContextCurrent (Just win) --       GLFW.swapInterval 1 --       (vao1, vao2, prog1, prog2, fbo, texture) <- setup---       whileM_ (not <$> GLFW.windowShouldClose win) $ do+--       whileM_ (not \<$\> GLFW.windowShouldClose win) $ do --         GLFW.pollEvents---         t <- (realToFrac . fromJust) \<$\> GLFW.getTime+--         t \<- (realToFrac . fromJust) \<$\> GLFW.getTime --         draw vao1 vao2 prog1 prog2 fbo texture t --         GLFW.swapBuffers win -- @@ -177,8 +180,8 @@ --         [ -0.5, -0.5, 0, 0 --         ,  0,    0.5, 0, 1 --         ,  0.5, -0.5, 1, 1] :: V.Vector Float---   vbo <- newVBO blob StaticDraw---   bindVBO vbo+--   vbo1 <- newBufferObject blob StaticDraw+--   bindVBO vbo1 --   vsource  <- readFile "framebuffer.vert" --   fsource1 <- readFile "framebuffer1.frag" --   prog1 <- newProgram vsource fsource1@@ -195,42 +198,39 @@ --         , -1,  1, 0, 1 --         ,  1, -1, 1, 0 --         ,  1,  1, 1, 1] :: V.Vector Float---   vbo <- newVBO blob StaticDraw---   bindVBO vbo---   indices <- newElementArray (V.fromList [0,1,2,3,2,1] :: V.Vector Word8) StaticDraw+--   vbo2 <- newBufferObject blob StaticDraw+--   bindVBO vbo2+--   setVertexLayout+--     [ Attrib "position" 2 GLFloat+--     , Attrib "texcoord" 2 GLFloat ]+--   indices <- newBufferObject (V.fromList [0,1,2,3,2,1] :: V.Vector Word8) StaticDraw --   bindElementArray indices --   fsource2 <- readFile "framebuffer2.frag" --   prog2 <- newProgram vsource fsource2 --   useProgram prog2---   setVertexLayout---     [ Attrib "position" 2 GLFloat---     , Attrib "texcoord" 2 GLFloat ] --  --   -- create an FBO to render the primary scene on --   fbo <- newFBO---   bindFramebuffer fbo---   texture <- newEmptyTexture2D 640 480 :: IO (Tex2D RGB)+--   bindFBO fbo+--   texture <- newEmptyTexture2D 640 480 RGB --   bindTexture2D texture --   setTex2DFiltering Linear --   attachTex2D texture --   return (vao1, vao2, prog1, prog2, fbo, texture) -- --- draw :: VAO -> VAO -> Program -> Program -> FBO -> Tex2D RGB -> Float -> IO ()+-- draw :: VAO -> VAO -> Program -> Program -> FBO -> Texture -> Float -> IO () -- draw vao1 vao2 prog1 prog2 fbo texture t = do---   -- render primary scene to fbo --   bindVAO vao1---   bindFramebuffer fbo+--   bindFBO fbo --   useProgram prog1 --   clearColorBuffer (0,0,0) --   setUniform1f "time" [t] --   drawTriangles 3 -- ---   -- render results to quad on main screen --   bindVAO vao2---   bindFramebuffer DefaultFramebuffer+--   bindDefaultFramebuffer --   useProgram prog2 --   bindTexture2D texture---   clearColorBuffer (0,0,0) --   setUniform1f "time" [t] --   drawIndexedTriangles 6 UByteIndices -- @
− Graphics/GL/Low/ImageFormat.hs 
@@ -1,56 +0,0 @@-module Graphics.GL.Low.ImageFormat where--import Graphics.GL--import Graphics.GL.Low.Classes---- | 1-byte alpha channel only.-data Alpha = Alpha deriving Show---- | 1-byte grayscale pixel format.-data Luminance = Luminance deriving Show---- | 2-byte luminance and alpha channel format.-data LuminanceAlpha = Luminancealpha deriving Show---- | 3-byte true color pixel format.-data RGB = RGB deriving Show---- | 4-byte true color plus alpha channel format.-data RGBA = RGBA deriving Show---- | 24-bit depth format.-data Depth24 = Depth24 deriving Show---- | Combination depth and stencil format.-data Depth24Stencil8 = Depth24Stencil8 deriving Show--instance InternalFormat RGB where-  internalFormat _ = GL_RGB-instance InternalFormat RGBA where-  internalFormat _ = GL_RGBA-instance InternalFormat Alpha where-  internalFormat _ = GL_ALPHA-instance InternalFormat Luminance where-  internalFormat _ = GL_LUMINANCE-instance InternalFormat LuminanceAlpha where-  internalFormat _ = GL_LUMINANCE_ALPHA-instance InternalFormat Depth24 where-  internalFormat _ = GL_DEPTH_COMPONENT24-instance InternalFormat Depth24Stencil8 where-  internalFormat _ = GL_DEPTH24_STENCIL8--instance Attachable RGB where-  attachPoint _ = GL_COLOR_ATTACHMENT0-instance Attachable RGBA where-  attachPoint _ = GL_COLOR_ATTACHMENT0-instance Attachable Luminance where-  attachPoint _ = GL_COLOR_ATTACHMENT0-instance Attachable LuminanceAlpha where-  attachPoint _ = GL_COLOR_ATTACHMENT0-instance Attachable Alpha where-  attachPoint _ = GL_COLOR_ATTACHMENT0-instance Attachable Depth24 where-  attachPoint _ = GL_DEPTH_ATTACHMENT-instance Attachable Depth24Stencil8 where-  attachPoint _ = GL_DEPTH_STENCIL_ATTACHMENT
− Graphics/GL/Low/Internal/Types.hs 
@@ -1,105 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Graphics.GL.Low.Internal.Types where--import Data.Data (Data, Typeable)-import Foreign.Storable (Storable)--import Graphics.GL (GLuint)--import Graphics.GL.Low.Classes---newtype TextureUnit = TextureUnit { fromTextureUnit :: GLuint } -    deriving (Eq, Ord, Read, Show, Num, Integral, Real, Enum, Storable)--newtype AttribLocation = AttribLocation { fromAttribLocation :: GLuint } -    deriving (Eq, Ord, Read, Show, Num, Integral, Real, Enum, Storable)--newtype UniformLocation = UniformLocation { fromUniformLocation :: GLuint } -    deriving (Eq, Ord, Read, Show, Num, Integral, Real, Enum, Storable)----- | Handle to a shader program.-newtype Program = Program { fromProgram :: GLuint } -    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)---- | Handle to a shader object.-newtype Shader = Shader { fromShader :: GLuint } -    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)----- | Handle to a VBO.-newtype VBO = VBO { fromVBO :: GLuint } -    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)--instance GLObject VBO where-  glObjectName (VBO n) = fromIntegral n--instance BufferObject VBO----- | Handle to an element array buffer object.-newtype ElementArray = ElementArray { fromElementArray :: GLuint }-    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)--instance GLObject ElementArray where-  glObjectName (ElementArray n) = fromIntegral n--instance BufferObject ElementArray------ | A framebuffer object is an alternative rendering destination. Once an FBO--- is bound to framebuffer binding target, it is possible to attach images--- (textures or RBOs) for color, depth, or stencil rendering.-newtype FBO = FBO { fromFBO :: GLuint }-    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)--instance Framebuffer FBO where-  framebufferName = glObjectName--instance GLObject FBO where-  glObjectName (FBO n) = fromIntegral n----- | An RBO is a kind of image object used for rendering. The only thing--- you can do with an RBO is attach it to an FBO.-newtype RBO a = RBO { unRBO :: GLuint } -    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)--instance GLObject (RBO a) where-  glObjectName (RBO n) = fromIntegral n----- | A 2D texture. A program can sample a texture if it has been bound to--- the appropriate texture unit.-newtype Tex2D a = Tex2D { fromTex2D :: GLuint }-    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)--instance Texture (Tex2D a) where--instance GLObject (Tex2D a) where-  glObjectName (Tex2D n) = fromIntegral n----- | A cubemap texture is just six 2D textures. A program can sample a cubemap--- texture if it has been bound to the appropriate texture unit.-newtype CubeMap a = CubeMap { fromCubeMap :: GLuint }-    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)--instance Texture (CubeMap a) where--instance GLObject (CubeMap a) where-  glObjectName (CubeMap n) = fromIntegral n------ | Handle to a VAO.-newtype VAO = VAO { fromVAO :: GLuint }-    deriving (Eq, Ord, Read, Show, Storable, Data, Typeable)--instance GLObject VAO where-  glObjectName (VAO n) = fromIntegral n--
Graphics/GL/Low/Render.hs view
@@ -6,6 +6,9 @@   -- the current shader program. The integer argument is the number of   -- vertices to read from the VBOs via the current VAO.   --+  -- So VAO, Program, and FBO (or default framebuffer) must already be+  -- setup to render these primitives.+  --   drawPoints,   drawLines,   drawLineStrip,@@ -17,9 +20,12 @@   -- * Primitives (by index)   --   -- | Render various kinds of primitives by traversing the vertices in the-  -- order specified in the current ElementArray. The format argument indicates-  -- the size of each index in the ElementArray.+  -- order specified in the current element array. The format argument indicates+  -- the size of each index in the element array.   --+  -- So to render primitives this way, you need the VAO, Program, FBO,+  -- and the element array already setup.+  --   drawIndexedPoints,   drawIndexedLines,   drawIndexedLineStrip,@@ -32,7 +38,7 @@   enableScissorTest,   disableScissorTest, -  -- * Facet Culling+  -- * Face Culling   enableCulling,   disableCulling, @@ -41,19 +47,28 @@    Culling(..),   Viewport(..),-  IndexFormat(..)+  IndexFormat(..),++  -- * Color Buffer+  enableColorWriting,+  disableColorWriting,+  clearColorBuffer,++  -- * Depth Buffer+  enableDepthTest,+  disableDepthTest,+  clearDepthBuffer ) where  import Foreign.Ptr import Foreign.Marshal import Foreign.Storable-import Control.Monad.IO.Class  import Graphics.GL  import Graphics.GL.Low.Classes --- | Facet culling modes.+-- | Face culling modes. data Culling =   CullFront |   CullBack |@@ -86,71 +101,70 @@   toGL UIntIndices   = GL_UNSIGNED_INT  --drawPoints :: (MonadIO m) => Int -> m ()+drawPoints :: Int -> IO () drawPoints = drawArrays GL_POINTS -drawLines :: (MonadIO m) => Int -> m ()+drawLines :: Int -> IO () drawLines = drawArrays GL_LINES -drawLineStrip :: (MonadIO m) => Int -> m ()+drawLineStrip :: Int -> IO () drawLineStrip = drawArrays GL_LINE_STRIP -drawLineLoop :: (MonadIO m) => Int -> m ()+drawLineLoop :: Int -> IO () drawLineLoop = drawArrays GL_LINE_LOOP -drawTriangles :: (MonadIO m) => Int -> m ()+drawTriangles :: Int -> IO () drawTriangles = drawArrays GL_TRIANGLES -drawTriangleStrip :: (MonadIO m) => Int -> m ()+drawTriangleStrip :: Int -> IO () drawTriangleStrip = drawArrays GL_TRIANGLE_STRIP -drawTriangleFan :: (MonadIO m) => Int -> m ()+drawTriangleFan :: Int -> IO () drawTriangleFan = drawArrays GL_TRIANGLE_FAN -drawArrays :: (MonadIO m) => GLenum -> Int -> m ()+drawArrays :: GLenum -> Int -> IO () drawArrays mode n = glDrawArrays mode 0 (fromIntegral n) -drawIndexedPoints :: (MonadIO m) => Int -> IndexFormat -> m ()+drawIndexedPoints :: Int -> IndexFormat -> IO () drawIndexedPoints = drawIndexed GL_POINTS -drawIndexedLines :: (MonadIO m) => Int -> IndexFormat -> m ()+drawIndexedLines :: Int -> IndexFormat -> IO () drawIndexedLines = drawIndexed GL_LINES -drawIndexedLineStrip :: (MonadIO m) => Int -> IndexFormat -> m ()+drawIndexedLineStrip :: Int -> IndexFormat -> IO () drawIndexedLineStrip = drawIndexed GL_LINE_STRIP -drawIndexedLineLoop :: (MonadIO m) => Int -> IndexFormat -> m ()+drawIndexedLineLoop :: Int -> IndexFormat -> IO () drawIndexedLineLoop = drawIndexed GL_LINE_LOOP -drawIndexedTriangles :: (MonadIO m) => Int -> IndexFormat -> m ()+drawIndexedTriangles :: Int -> IndexFormat -> IO () drawIndexedTriangles = drawIndexed GL_TRIANGLES -drawIndexedTriangleStrip :: (MonadIO m) => Int -> IndexFormat -> m ()+drawIndexedTriangleStrip :: Int -> IndexFormat -> IO () drawIndexedTriangleStrip = drawIndexed GL_TRIANGLE_STRIP -drawIndexedTriangleFan :: (MonadIO m) => Int -> IndexFormat -> m ()+drawIndexedTriangleFan :: Int -> IndexFormat -> IO () drawIndexedTriangleFan = drawIndexed GL_TRIANGLE_FAN -drawIndexed :: (MonadIO m) => GLenum -> Int -> IndexFormat -> m ()+drawIndexed :: GLenum -> Int -> IndexFormat -> IO () drawIndexed mode n fmt = glDrawElements mode (fromIntegral n) (toGL fmt) nullPtr  -- | Enable the scissor test. Graphics outside the scissor box will not be -- rendered.-enableScissorTest :: (MonadIO m) => Viewport -> m ()+enableScissorTest :: Viewport -> IO () enableScissorTest (Viewport x y w h) = do   glScissor (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)   glEnable GL_SCISSOR_TEST  -- | Disable the scissor test.-disableScissorTest :: (MonadIO m) => m ()+disableScissorTest :: IO () disableScissorTest = glDisable GL_SCISSOR_TEST  --- | Enable facet culling. The argument specifies whether front faces, back+-- | Enable face culling. The argument specifies whether front faces, back -- faces, or both will be omitted from rendering. If both front and back -- faces are culled you can still render points and lines.-enableCulling :: (MonadIO m) => Culling -> m ()+enableCulling :: Culling -> IO () enableCulling c = do   case c of     CullFront -> glCullFace GL_FRONT@@ -158,11 +172,41 @@     CullFrontAndBack -> glCullFace GL_FRONT_AND_BACK   glEnable GL_CULL_FACE --- | Disable facet culling. Front and back faces will now be rendered.-disableCulling :: (MonadIO m) => m ()+-- | Disable face culling. Front and back faces will now be rendered.+disableCulling :: IO () disableCulling = glDisable GL_CULL_FACE  -- | Set the viewport. The default viewport simply covers the entire window.-setViewport :: (MonadIO m) => Viewport -> m ()+setViewport :: Viewport -> IO () setViewport (Viewport x y w h) =   glViewport (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)++-- | Allow rendering commands to modify the color buffer of the current+-- framebuffer.+enableColorWriting :: IO ()+enableColorWriting = glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE++-- | Disable rendering to color buffer.+disableColorWriting :: IO ()+disableColorWriting = glColorMask GL_FALSE GL_FALSE GL_FALSE GL_FALSE++-- | Clear the color buffer of the current framebuffer with the specified+-- color. Has no effect if writing to the color buffer is disabled.+clearColorBuffer :: Real a => (a,a,a) -> IO ()+clearColorBuffer (r, g, b) = do+  glClearColor (realToFrac r) (realToFrac g) (realToFrac b) 1.0+  glClear GL_COLOR_BUFFER_BIT++-- | Enable the depth test. Attempting to render pixels with a depth value+-- greater than the depth buffer at those pixels will have no effect. Otherwise+-- the depth in the buffer will get updated to the new pixel's depth.+enableDepthTest :: IO ()+enableDepthTest = glEnable GL_DEPTH_TEST++-- | Disable the depth test and depth buffer updates.+disableDepthTest :: IO ()+disableDepthTest = glDisable GL_DEPTH_TEST++-- | Clear the depth buffer with the maximum depth value.+clearDepthBuffer :: IO ()+clearDepthBuffer = glClear GL_DEPTH_BUFFER_BIT
Graphics/GL/Low/Shader.hs view
@@ -3,8 +3,8 @@ module Graphics.GL.Low.Shader ( -- | A shader program is composed of two cooperating parts: the vertex program -- and the fragment program. The vertex program is executed once for each--- vertex. The fragment program is executed once for each pixel covered by--- a rasterized primitive (actually this is more complicated but close enough).+-- vertex. The fragment program is executed once for each pixel covered by a+-- rasterized primitive. -- -- The inputs to the vertex program are: --@@ -15,11 +15,11 @@ -- -- - clip space position of the vertex, gl_Position -- - any number of variables matching inputs to the fragment program--- - (if rendering a point, then you can set gl_PointSize)+-- - (if rendering a point, you can also set gl_PointSize) -- -- The inputs to the fragment program are: ----- - the previously mentioned outputs of the vertex program (interpolated)+-- - interpolated outputs of the vertex program -- - the window position of the pixel, gl_FragCoord -- - samplers (see "Graphics.GL.Low.Texture") -- - uniforms@@ -28,8 +28,8 @@ -- -- The outputs of the fragment program are: ----- - a color (this is more complicated in reality but close enough) -- - the depth of the pixel, gl_FragDepth, which will default to the pixel's Z.+-- - color of the pixel. --   newProgram,   newProgramSafe,@@ -60,12 +60,11 @@ import Control.Exception import Control.Monad (when, forM_) import Data.Typeable-import Control.Monad.IO.Class  import Graphics.GL import Linear -import Graphics.GL.Low.Internal.Types+import Graphics.GL.Low.Types import Graphics.GL.Low.Classes import Graphics.GL.Low.VertexAttrib @@ -89,21 +88,20 @@ instance Exception ProgramError  -- | Same as 'newProgram' but does not throw exceptions.-newProgramSafe :: (MonadIO m) => String -> String -> m (Either ProgramError Program)-newProgramSafe vcode fcode = liftIO . try $ newProgram vcode fcode+newProgramSafe :: String -> String -> IO (Either ProgramError Program)+newProgramSafe vcode fcode = try $ newProgram vcode fcode  -- | Delete a program.-deleteProgram :: (MonadIO m) => Program -> m ()+deleteProgram :: Program -> IO () deleteProgram (Program n) = glDeleteProgram n  -- | Compile the code for a vertex shader and a fragment shader, then link -- them into a new program. If the compiler or linker fails it will throw -- a ProgramError.-newProgram :: (MonadIO m) -           => String -- ^ vertex shader source code+newProgram :: String -- ^ vertex shader source code            -> String -- ^ fragment shader source code-           -> m Program-newProgram vcode fcode = liftIO $ do+           -> IO Program+newProgram vcode fcode = do   vertexShaderId <- compileShader vcode VertexShader   fragmentShaderId <- compileShader fcode FragmentShader   programId <- glCreateProgram@@ -125,11 +123,11 @@  -- | Install a program into the rendering pipeline. Replaces the program -- already in use, if any.-useProgram :: (MonadIO m) => Program -> m ()-useProgram (Program n) = glUseProgram n+useProgram :: Program -> IO ()+useProgram = glUseProgram . fromProgram -compileShader :: (MonadIO m) => String -> ShaderType -> m GLuint-compileShader code vertOrFrag = liftIO $ do+compileShader :: String -> ShaderType -> IO GLuint+compileShader code vertOrFrag = do   shaderId <- glCreateShader (toGL vertOrFrag)   withCString code $ \ptr -> with ptr $ \pptr -> do     glShaderSource shaderId 1 pptr nullPtr@@ -147,55 +145,55 @@       FragmentShader -> throwIO (FragmentShaderError errors)   return shaderId -setUniform1f :: (MonadIO m) => String -> [Float] -> m ()+setUniform1f :: String -> [Float] -> IO () setUniform1f = setUniform glUniform1fv -setUniform2f :: (MonadIO m) => String -> [V2 Float] -> m ()+setUniform2f :: String -> [V2 Float] -> IO () setUniform2f = setUniform   (\loc cnt val -> glUniform2fv loc cnt (castPtr val)) -setUniform3f :: (MonadIO m) => String -> [V3 Float] -> m ()+setUniform3f :: String -> [V3 Float] -> IO () setUniform3f = setUniform   (\loc cnt val -> glUniform3fv loc cnt (castPtr val)) -setUniform4f :: (MonadIO m) => String -> [V4 Float] -> m ()+setUniform4f :: String -> [V4 Float] -> IO () setUniform4f = setUniform   (\loc cnt val -> glUniform4fv loc cnt (castPtr val)) -setUniform1i :: (MonadIO m) => String -> [Int] -> m ()+setUniform1i :: String -> [Int] -> IO () setUniform1i = setUniform   (\loc cnt val -> glUniform1iv loc cnt (castPtr val)) -setUniform2i :: (MonadIO m) => String -> [V2 Int] -> m ()+setUniform2i :: String -> [V2 Int] -> IO () setUniform2i = setUniform    (\loc cnt val -> glUniform2iv loc cnt (castPtr val)) -setUniform3i :: (MonadIO m) => String -> [V3 Int] -> m ()+setUniform3i :: String -> [V3 Int] -> IO () setUniform3i = setUniform   (\loc cnt val -> glUniform3iv loc cnt (castPtr val)) -setUniform4i :: (MonadIO m) => String -> [V4 Int] -> m ()+setUniform4i :: String -> [V4 Int] -> IO () setUniform4i = setUniform   (\loc cnt val -> glUniform4iv loc cnt (castPtr val)) -setUniform44 :: (MonadIO m) => String -> [M44 Float] -> m ()+setUniform44 :: String -> [M44 Float] -> IO () setUniform44 = setUniform   (\loc cnt val -> glUniformMatrix4fv loc cnt GL_FALSE (castPtr val)) -setUniform33 :: (MonadIO m) => String -> [M33 Float] -> m ()+setUniform33 :: String -> [M33 Float] -> IO () setUniform33 = setUniform   (\loc cnt val -> glUniformMatrix3fv loc cnt GL_FALSE (castPtr val)) -setUniform22 :: (MonadIO m) => String -> [M22 Float] -> m ()+setUniform22 :: String -> [M22 Float] -> IO () setUniform22 = setUniform   (\loc cnt val -> glUniformMatrix2fv loc cnt GL_FALSE (castPtr val)) -setUniform :: (MonadIO m, Storable a)+setUniform :: Storable a            => (GLint -> GLsizei -> Ptr a -> IO ())            -> String            -> [a]-           -> m ()-setUniform glAction name xs = liftIO . withArrayLen xs $ \n bytes -> do+           -> IO ()+setUniform glAction name xs = withArrayLen xs $ \n bytes -> do   p <- alloca (\ptr -> glGetIntegerv GL_CURRENT_PROGRAM ptr >> peek ptr)   if p == 0     then return ()@@ -218,7 +216,6 @@ -- module Main where --  -- import Control.Monad.Loops (whileM_)--- import Data.Functor ((\<$\>)) -- import qualified Data.Vector.Storable as V -- import Data.Maybe (fromJust) -- @@ -260,7 +257,7 @@ --         [ -0.4, -0.4, 0, 0 --         ,  0,    0.4, 0, 1 --         ,  0.4, -0.4, 1, 1] :: V.Vector Float---   vbo <- newVBO blob StaticDraw+--   vbo <- newBufferObject blob StaticDraw --   bindVBO vbo --   setVertexLayout --     [ Attrib "position" 2 GLFloat
Graphics/GL/Low/Stencil.hs view
@@ -28,27 +28,25 @@   StencilOp(..) ) where -import Data.Default import Data.Bits import Data.Word-import Control.Monad.IO.Class  import Graphics.GL import Graphics.GL.Low.Classes  -- | Enable the stencil test with a set of operating parameters.-enableStencil :: (MonadIO m) => Stencil -> m ()+enableStencil :: Stencil -> IO () enableStencil (Stencil f r m op1 op2 op3) = do   glStencilFunc (toGL f) (fromIntegral r) (fromIntegral m)   glStencilOp (toGL op1) (toGL op2) (toGL op3)   glEnable GL_STENCIL_TEST  -- | Disable the stencil test and updates to the stencil buffer, if one exists.-disableStencil :: (MonadIO m) => m ()+disableStencil :: IO () disableStencil = glDisable GL_STENCIL_TEST  -- | Clear the stencil buffer with all zeros.-clearStencilBuffer :: (MonadIO m) => m ()+clearStencilBuffer :: IO () clearStencilBuffer = glClear GL_STENCIL_BUFFER_BIT  -- | In this basic configuration of the stencil, anything rendered will@@ -62,7 +60,7 @@ --     , onBothPass = Replace } -- @ basicStencil :: Stencil-basicStencil = def+basicStencil = defaultStencil   { func = Greater   , ref = 1   , onBothPass = Replace }@@ -79,21 +77,19 @@ -- | The default state of the stencil, if it were simply enabled, would be -- to always pass and update nothing in the buffer. It would have no effect -- on rendering.-instance Default Stencil where-  def = Stencil-    { func = Always-    , ref  = 0-    , mask = complement 0-    , onStencilFail = Keep-    , onDepthFail   = Keep-    , onBothPass    = Keep }+defaultStencil :: Stencil+defaultStencil = Stencil+  { func = Always+  , ref  = 0+  , mask = complement 0+  , onStencilFail = Keep+  , onDepthFail   = Keep+  , onBothPass    = Keep }  -- the proper implementation of toList f is the one that for any -- g :: t a -> [a] you can make a unique k such that g = k . f -- jle`-   - -- | The stencil test passes under what condition. data StencilFunc =   Never |@@ -116,7 +112,6 @@     Equal -> GL_EQUAL     NotEqual -> GL_NOTEQUAL     Always -> GL_ALWAYS-  -- | Modification action for the stencil buffer.  data StencilOp =
Graphics/GL/Low/Texture.hs view
@@ -1,9 +1,9 @@ module Graphics.GL.Low.Texture (  -- | Textures are objects that contain image data that can be sampled by--- a shader. While an obvious application of this is texture mapping, there--- are many other uses for textures (the image data doesn't have to be an--- image at all, it can represent anything).+-- a shader. An obvious application of this is texture mapping, but there+-- are many other uses for textures. The image data doesn't have to be an+-- image at all, it can represent anything. -- -- Each sampler uniform in your shader points to a texture unit (zero by -- default). This texture unit is where it will read texture data from. To@@ -11,7 +11,9 @@ -- a texture. This will not only bind it to the relevant texture binding target -- but also to the active texture unit. You can change which unit a sampler -- points to by setting it using the 'Graphics.GL.Low.Shader.setUniform1i'--- command. You can avoid dealing with active texture units if theres only one+-- command.+--+-- You can avoid dealing with active texture units if theres only one -- sampler because the default unit is zero.    newTexture2D,@@ -26,11 +28,10 @@   setCubeMapFiltering,   setTex2DWrapping,   setCubeMapWrapping,-  Tex2D,-  CubeMap,+  Texture,+  ImageFormat(..),   Filtering(..),-  Wrapping(..),-  Dimensions(..)+  Wrapping(..)    -- * Example   -- $example@@ -45,91 +46,100 @@ import Data.Word import Control.Applicative import Data.Traversable (sequence)-import Control.Monad.IO.Class  import Graphics.GL -import Graphics.GL.Low.Internal.Types+import Graphics.GL.Low.Types import Graphics.GL.Low.Classes-import Graphics.GL.Low.Common import Graphics.GL.Low.Cube+import Graphics.GL.Low.Common  --- | Create a new 2D texture from a blob and its dimensions. Dimensions should--- be powers of two. The internal format type determines how the data is--- interpreted.-newTexture2D :: (MonadIO m, Storable a, InternalFormat b)+getTex2DBinding :: IO GLint+getTex2DBinding = alloca $ \ptr -> do+  glGetIntegerv GL_TEXTURE_BINDING_2D ptr+  peek ptr++getCubemapBinding :: IO GLint+getCubemapBinding = alloca $ \ptr -> do+  glGetIntegerv GL_TEXTURE_BINDING_CUBE_MAP ptr+  peek ptr++-- | Create a new 2D texture from raw image data, its dimensions, and the+-- assumed image format. The dimensions should be powers of 2.+newTexture2D :: Storable a              => Vector a-             -> Dimensions-             -> m (Tex2D b)-newTexture2D bytes (Dimensions w h)  = do-  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)+             -> (Int,Int)+             -> ImageFormat+             -> IO Texture+newTexture2D src (w,h) format = do+  orig <- getTex2DBinding+  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)   glBindTexture GL_TEXTURE_2D n-  tex <- return (Tex2D n)-  liftIO . unsafeWith bytes $ \ptr -> glTexImage2D+  unsafeWith src $ \ptr -> glTexImage2D     GL_TEXTURE_2D     0-    (internalFormat tex)+    (toGL format)     (fromIntegral w)     (fromIntegral h)     0-    (internalFormat tex)+    (toGL format)     GL_UNSIGNED_BYTE     (castPtr ptr)   glGenerateMipmap GL_TEXTURE_2D-  return tex+  glBindTexture GL_TEXTURE_2D (fromIntegral orig)+  return (Texture n format) --- | Create a new cube map texture from six blobs and their respective dimensions.--- Dimensions should be powers of two.-newCubeMap :: (MonadIO m, Storable a, InternalFormat b)-           => Cube (Vector a, Dimensions)-           -> m (CubeMap b)-newCubeMap images = do-  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)+-- | Create a new cubemap texture from six raw data sources. Each side will have+-- the same format.+newCubeMap :: Storable a+           => Cube (Vector a, (Int,Int))+           -> ImageFormat+           -> IO Texture+newCubeMap images format = do+  orig <- getCubemapBinding+  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)   glBindTexture GL_TEXTURE_CUBE_MAP n-  cm <- return (CubeMap n)-  let fmt = internalFormat cm-  sequence (loadCubeMapSide fmt <$> images <*> cubeSideCodes)+  sequence_ (liftA2 (loadCubeMapSide format) images cubeSideCodes)   glGenerateMipmap GL_TEXTURE_CUBE_MAP-  return cm-+  glBindTexture GL_TEXTURE_CUBE_MAP (fromIntegral orig)+  return (Texture n format)   -loadCubeMapSide :: (MonadIO m, Storable a) => GLenum -> (Vector a, Dimensions) -> GLenum -> m ()-loadCubeMapSide fmt (bytes, (Dimensions w h)) side = liftIO $ do-  unsafeWith bytes $ \ptr -> glTexImage2D+loadCubeMapSide :: Storable a => ImageFormat -> (Vector a, (Int,Int)) -> GLenum -> IO ()+loadCubeMapSide format (src, (w,h)) side =+  unsafeWith src $ \ptr -> glTexImage2D     side     0-    (fromIntegral fmt)+    (toGL format)     (fromIntegral w)     (fromIntegral h)     0-    fmt+    (toGL format)     GL_UNSIGNED_BYTE     (castPtr ptr)  -- | Create an empty texture with the specified dimensions and format.-newEmptyTexture2D :: (MonadIO m, InternalFormat a) => Int -> Int -> m (Tex2D a)-newEmptyTexture2D w h = do+newEmptyTexture2D :: Int -> Int -> ImageFormat -> IO Texture+newEmptyTexture2D w h format = do+  orig <- getTex2DBinding   let w' = fromIntegral w   let h' = fromIntegral h-  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)-  tex <- return (Tex2D n)-  let fmt = internalFormat tex-  let fmt' = internalFormat tex+  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)   glBindTexture GL_TEXTURE_2D n-  glTexImage2D GL_TEXTURE_2D 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr-  return tex+  glTexImage2D GL_TEXTURE_2D 0 (toGL format) w' h' 0 (toGL format) GL_UNSIGNED_BYTE nullPtr+  glBindTexture GL_TEXTURE_2D (fromIntegral orig)+  return (Texture n format)  -- | Create a cubemap texture where each of the six sides has the specified--- dimensions and format.-newEmptyCubeMap :: (MonadIO m, InternalFormat a) => Int -> Int -> m (CubeMap a)-newEmptyCubeMap w h = do+-- dimensions and format. +newEmptyCubeMap :: Int -> Int -> ImageFormat -> IO Texture+newEmptyCubeMap w h format = do+  orig <- getCubemapBinding   let w' = fromIntegral w   let h' = fromIntegral h-  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)-  tex <- return (CubeMap n)-  let fmt = internalFormat tex-  let fmt' = internalFormat tex+  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)+  let fmt  = toGL format+  let fmt' = toGL format   glBindTexture GL_TEXTURE_CUBE_MAP n   glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_X 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr   glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_X 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr@@ -137,52 +147,52 @@   glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Y 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr   glTexImage2D GL_TEXTURE_CUBE_MAP_POSITIVE_Z 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr   glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Z 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr-  return tex+  glBindTexture GL_TEXTURE_CUBE_MAP (fromIntegral orig)+  return (Texture n format)    -- | Delete a texture.-deleteTexture :: (MonadIO m, Texture a) => a -> m ()-deleteTexture x = liftIO $ withArray [glObjectName x] (\ptr -> glDeleteTextures 1 ptr)+deleteTexture :: Texture -> IO ()+deleteTexture tex = withArray [texObjectName tex] (\ptr -> glDeleteTextures 1 ptr)  -- | Bind a 2D texture to the 2D texture binding target and the currently -- active texture unit.-bindTexture2D :: (MonadIO m) => Tex2D a -> m ()-bindTexture2D (Tex2D n) = glBindTexture GL_TEXTURE_2D n+bindTexture2D :: Texture -> IO ()+bindTexture2D = glBindTexture GL_TEXTURE_2D . texObjectName  -- | Bind a cubemap texture to the cubemap texture binding target and -- the currently active texture unit.-bindTextureCubeMap :: (MonadIO m) => CubeMap a -> m ()-bindTextureCubeMap (CubeMap n) = glBindTexture GL_TEXTURE_CUBE_MAP n+bindTextureCubeMap :: Texture -> IO ()+bindTextureCubeMap = glBindTexture GL_TEXTURE_CUBE_MAP . texObjectName  -- | Set the active texture unit. The default is zero.-setActiveTextureUnit :: (MonadIO m, Enum a) => a -> m ()-setActiveTextureUnit n =-  (glActiveTexture . fromIntegral) (GL_TEXTURE0 + fromEnum n)+setActiveTextureUnit :: Int -> IO ()+setActiveTextureUnit n = glActiveTexture (GL_TEXTURE0 + fromIntegral n)  -- | Set the filtering for the 2D texture currently bound to the 2D texture -- binding target.-setTex2DFiltering :: (MonadIO m) => Filtering -> m ()+setTex2DFiltering :: Filtering -> IO () setTex2DFiltering filt = do   glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER (toGL filt)   glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER (toGL filt)  -- | Set the filtering for the cubemap texture currently bound to the cubemap -- texture binding target.-setCubeMapFiltering :: (MonadIO m) => Filtering -> m ()+setCubeMapFiltering :: Filtering -> IO () setCubeMapFiltering filt = do   glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MIN_FILTER (toGL filt)   glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_MAG_FILTER (toGL filt)  -- | Set the wrapping mode for the 2D texture currently bound to the 2D -- texture binding target.-setTex2DWrapping :: (MonadIO m) => Wrapping -> m ()+setTex2DWrapping :: Wrapping -> IO () setTex2DWrapping wrap = do   glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S (toGL wrap)   glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T (toGL wrap)  -- | Set the wrapping mode for the cubemap texture currently bound to the--- cubemap texture binding target. Because no blending occurs between cube+-- cubemap texture binding target. Because no filtering occurs between cube -- faces you probably want ClampToEdge.-setCubeMapWrapping :: (MonadIO m) => Wrapping -> m ()+setCubeMapWrapping :: Wrapping -> IO () setCubeMapWrapping wrap = do   glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_S (toGL wrap)   glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_T (toGL wrap)@@ -196,7 +206,7 @@  instance ToGL Filtering where   toGL Nearest = GL_NEAREST-  toGL Linear = GL_LINEAR+  toGL Linear  = GL_LINEAR  -- | Texture wrapping modes. data Wrapping =@@ -206,29 +216,22 @@     deriving Show  instance ToGL Wrapping where-  toGL Repeat = GL_REPEAT+  toGL Repeat         = GL_REPEAT   toGL MirroredRepeat = GL_MIRRORED_REPEAT-  toGL ClampToEdge = GL_CLAMP_TO_EDGE---- | The size of an image in pixels.-data Dimensions = Dimensions-  { imageWidth  :: Int-  , imageHeight :: Int }-    deriving (Show)+  toGL ClampToEdge    = GL_CLAMP_TO_EDGE  -- $example -- -- <<texture.png Screenshot of Texture Example>> ----- This example loads a 256x256 PNG file with JuicyPixels and displays the--- image on a square. Of course without a correction for aspect ratio the--- square will only be square if you adjust your window to be square.+-- This example loads a PNG file with JuicyPixels and displays the image on a+-- square. Since the window is not square and no aspect ratio transformation+-- was applied, the picture is squished. -- -- @ -- module Main where --  -- import Control.Monad.Loops (whileM_)--- import Data.Functor ((\<$\>)) -- import qualified Data.Vector.Storable as V -- import Codec.Picture -- import Data.Word@@ -270,7 +273,7 @@ --         , -0.5,  0.5, 0, 0 --         ,  0.5, -0.5, 1, 1 --         ,  0.5,  0.5, 1, 0 ] :: V.Vector Float---   vbo <- newVBO blob StaticDraw+--   vbo <- newBufferObject blob StaticDraw --   bindVBO vbo --   setVertexLayout [ Attrib "position" 2 GLFloat --                   , Attrib "texcoord" 2 GLFloat ]@@ -280,7 +283,7 @@ --   -- load the texture with JuicyPixels --   let fromRight (Right x) = x --   ImageRGBA8 (Image w h image) <- fromRight \<$\> readImage "logo.png"---   texture <- newTexture2D image (Dimensions w h) :: IO (Tex2D RGBA)+--   texture <- newTexture2D image (w,h) RGBA  --   setTex2DFiltering Linear --   return (vao, prog, texture) --
+ Graphics/GL/Low/Types.hs view
@@ -0,0 +1,61 @@+module Graphics.GL.Low.Types where++import Graphics.GL++import Graphics.GL.Low.Classes++-- | Handle to a VAO.+newtype VAO = VAO { fromVAO :: GLuint }+  deriving Show++-- | Handle to a buffer object, such as a VBO or an element array.+newtype BufferObject = BufferObject { fromBufferObject :: GLuint }+  deriving Show++-- | A framebuffer object is an alternative rendering destination. Once an FBO+-- is bound to framebuffer binding target, it is possible to attach images+-- (textures or RBOs) for color, depth, or stencil rendering.+newtype FBO = FBO { fromFBO :: GLuint }+  deriving Show++-- | An RBO is a kind of image object used for rendering. The only thing+-- you can do with an RBO is attach it to an FBO.+data RBO = RBO+  { rboObjectName :: GLuint+  , rboFormat     :: ImageFormat } +    deriving Show++-- | Handle to a texture object. It may be a Tex2D or a cubemap.+data Texture = Texture+  { texObjectName  :: GLuint+  , texFormat      :: ImageFormat }++-- | Handle to a shader program.+newtype Program = Program { fromProgram :: GLuint } +  deriving Show++-- | Handle to a shader object.+newtype Shader = Shader { fromShader :: GLuint } +  deriving Show++data ImageFormat =+  RGB |+  RGBA |+  Alpha |+  Luminance |+  LuminanceAlpha |+  Depth24 |+  Depth24Stencil8+    deriving (Show, Read, Eq, Ord)++instance ToGL ImageFormat where+  toGL imf = case imf of+    RGB -> GL_RGB+    RGBA -> GL_RGBA+    Alpha -> GL_ALPHA+    Luminance -> GL_LUMINANCE+    LuminanceAlpha -> GL_LUMINANCE_ALPHA+    Depth24 -> GL_DEPTH_COMPONENT24+    Depth24Stencil8 -> GL_DEPTH24_STENCIL8++
Graphics/GL/Low/VAO.hs view
@@ -1,39 +1,37 @@  module Graphics.GL.Low.VAO ( --- | Vertex Array Objects (VAO). Despite having almost no operations of its--- own, the VAO mechanism is one of the most complex pieces of OpenGL. A VAO--- has mutable state which associates vertex shader input variables (actually--- the integer location of the variable) with three things:+-- | Vertex Array Objects (VAO) are at the core of controlling OpenGL. Each VAO+-- has mutable state which associates vertex shader input variables with three+-- things: -- -- - The VBO to read from.--- - The position in the vertex array to read from.+-- - Where in the VBO to read from. -- - The interpretation of the bytes found there (32-bit float, 16-bit int, etc). ----- You set these VAO parameters with the following dance:+-- You set these VAO parameters with a sequence of commands: -- -- - Bind a VAO -- - Bind a VBO -- - Use a Program--- - call 'Graphics.GL.Low.VertexAttrib.setVertexLayout' which will--- lookup the position of the input variables and issue the appropriate--- glVertexAttribPointer calls.+-- - Call 'Graphics.GL.Low.VertexAttrib.setVertexLayout' ----- After a VAO is configured against a Program, either can be swapped in or--- out freely and they will still work when both are swapped in again together.+-- After a VAO is configured against a Program, either one can be swapped in or+-- out freely. They will still work when both are swapped back in together. An+-- "in-use" shader program will use whatever VAO is bound for getting its+-- vertex inputs. It is up to the programmer to ensure that the VAO has been+-- configured with the right variable positions for the current shader. ----- An "in-use" program will use whatever VAO is bound for getting its vertex--- inputs. It is up to the programmer to ensure that the VAO has been--- configured with the right variable positions for the current program. Two--- ways to do this are to use a consistent set of variables for all shaders or--- restrict a set of VAOs to only be allowed with specific Program objects.+-- After being bound, VAOs will also remember the last element array that is+-- bound to the element array buffer binding target. Later on, when a VAO is+-- re-bound, the element array will be restored automatically. ----- The currently bound VBO is not remembered or restored by binding a VAO, but--- the currently bound ElementArray is. This detail won't affect you if you--- always explicitly bind an ElementArray after binding a VAO. Alternatively--- you can exploit this to bundle particular models and their element arrays--- as a VAO.+-- __Gotcha:__ VAOs do /not/ remember what is bound to the array buffer binding+-- target. So VBOs will not be restored when a VAO is bound. --+-- A VAO must be created and bound with `bindVAO` before you can see any+-- graphics.+-- -- Diagram of possible VAO contents: -- -- <<vao.png VAO Diagram>>@@ -63,25 +61,24 @@  import Foreign.Storable import Foreign.Marshal-import Control.Monad.IO.Class  import Graphics.GL -import Graphics.GL.Low.Internal.Types+import Graphics.GL.Low.Types import Graphics.GL.Low.Classes  -- | Create a new VAO. The only thing you can do with a VAO is bind it to--- the vertex array binding target.-newVAO :: (MonadIO m) => m VAO-newVAO = liftIO $ do+-- the vertex array binding target (bindVAO) or delete it.+newVAO :: IO VAO+newVAO = do   n <- alloca (\ptr -> glGenVertexArrays 1 ptr >> peek ptr)   return (VAO n)  -- | Delete a VAO.-deleteVAO :: (MonadIO m) => VAO -> m ()-deleteVAO (VAO n) = liftIO $ withArray [n] (\ptr -> glDeleteVertexArrays 1 ptr)+deleteVAO :: VAO -> IO ()+deleteVAO (VAO n) = withArray [n] (\ptr -> glDeleteVertexArrays 1 ptr)  -- | Assign the VAO to the vertex array binding target. The VAO already bound -- will be replaced, if any.-bindVAO :: (MonadIO m) => VAO -> m ()+bindVAO :: VAO -> IO () bindVAO (VAO n) = glBindVertexArray n
Graphics/GL/Low/VertexAttrib.hs view
@@ -9,15 +9,15 @@ --   , Attrib "shininess" 1 GLFloat   -- next 4 bytes maps to:   in float shininess; --   , Attrib "texcoord"  2 GLFloat   -- next 8 bytes maps to:   in vec2 texcoord; --   , Unused 2                       -- next 2 bytes ignored---   , Attrib "seed"      1 GLShort ] -- next 2 bytes read as 16-bit signed int---                                    --   and mapped to: in float seed;+--   , Attrib "seed"      1 GLShort ] -- next 2 bytes maps to:   in float seed; bytes are treated as 16-bit signed int+-- -- @ ----- In this example four mappings from the current VBO to the variables--- in the current Program will be established in the current VAO.+-- In this example four mappings are established between the current shader+-- and the current VBO. The information is stored in the current VAO.    setVertexLayout,-  VertexLayout(..),+  LayoutElement(..),   DataType(..) ) where @@ -27,7 +27,6 @@ import Foreign.Marshal import Foreign.Storable import Control.Monad (forM_)-import Control.Monad.IO.Class  import Graphics.GL import Graphics.GL.Low.Classes@@ -36,7 +35,7 @@ -- component format and number of components for that attribute in the -- vertex data. Alternatively the size of an unused section of the data -- in bytes.-data VertexLayout =+data LayoutElement =   Attrib String Int DataType | -- ^ Name, component count and component format of a vertex attribute.   Unused Int -- ^ Size in bytes of an unused section of the vertex data.     deriving Show@@ -54,8 +53,8 @@  -- | This configures the currently bound VAO. It calls glVertexAttribPointer -- and glEnableVertexAttribArray.-setVertexLayout :: (MonadIO m) => [VertexLayout] -> m ()-setVertexLayout layout = liftIO $ do+setVertexLayout :: [LayoutElement] -> IO ()+setVertexLayout layout = do   p <- alloca (\ptr -> glGetIntegerv GL_CURRENT_PROGRAM ptr >> peek ptr)   if p == 0     then return ()@@ -84,7 +83,7 @@   toGL GLInt           = GL_INT   toGL GLUnsignedInt   = GL_UNSIGNED_INT -elaborateLayout :: Int -> [VertexLayout] -> [(String, Int, Int, DataType)]+elaborateLayout :: Int -> [LayoutElement] -> [(String, Int, Int, DataType)] elaborateLayout here layout = case layout of   [] -> []   (Unused n):xs -> elaborateLayout (here+n) xs@@ -92,7 +91,7 @@     let size = n * sizeOfType ty in     (name, n, here, ty) : elaborateLayout (here+size) xs -totalLayout :: [VertexLayout] -> Int+totalLayout :: [LayoutElement] -> Int totalLayout layout = sum (map arraySize layout) where   arraySize (Unused n) = n   arraySize (Attrib _ n ty) = n * sizeOfType ty
lowgl.cabal view
@@ -10,13 +10,13 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.3.1.2+version:             0.4.0.0  -- A short (one-line) description of the package. synopsis:            Basic gl wrapper and reference  -- A longer description of the package.-description:         This library exposes a vastly simplified subset of OpenGL that is hopefully still complete enough for many purposes, such as following tutorials, making simple games, and demos.+description:         This library exposes a simplified subset of OpenGL that I hope is complete enough for following tutorials and making simple games or demos.  -- The license under which the package is released. license:             BSD2@@ -51,22 +51,19 @@   exposed-modules:     Graphics.GL.Low                        Graphics.GL.Low.Blending                        Graphics.GL.Low.BufferObject-                       Graphics.GL.Low.Color                        Graphics.GL.Low.Classes                        Graphics.GL.Low.Cube-                       Graphics.GL.Low.Depth+                       Graphics.GL.Low.Common                        Graphics.GL.Low.Error                        Graphics.GL.Low.EntirePictureUpFront                        Graphics.GL.Low.Framebuffer-                       Graphics.GL.Low.ImageFormat                        Graphics.GL.Low.Render                        Graphics.GL.Low.Shader                        Graphics.GL.Low.Stencil                        Graphics.GL.Low.Texture                        Graphics.GL.Low.VAO                        Graphics.GL.Low.VertexAttrib-                       Graphics.GL.Low.Common-                       Graphics.GL.Low.Internal.Types+                       Graphics.GL.Low.Types      -- Modules included in this library but not exported.   -- other-modules:       @@ -96,4 +93,4 @@ source-repository this   type: git   location: https://github.com/evanrinehart/lowgl-  tag: 0.3.1.2+  tag: 0.4.0.0