packages feed

lowgl 0.3.1.1 → 0.3.1.2

raw patch · 16 files changed

+261/−187 lines, 16 filesdep +transformersdep ~base

Dependencies added: transformers

Dependency ranges changed: base

Files

Graphics/GL/Low.hs view
@@ -20,7 +20,7 @@   -- `linear' package for matrices.   --   ---  -- See specific modules for topic-specific docs and example code+  -- See specific modules for topic-specific docs and example code:   --   -- @"Graphics.GL.Low.VAO"@   --
Graphics/GL/Low/Blending.hs view
@@ -24,13 +24,14 @@   -- $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 :: Blending -> IO ()+enableBlending :: (MonadIO m) => Blending -> m () enableBlending (Blending s d f (r,g,b,a)) = do   glBlendFunc (toGL s) (toGL d)   glBlendEquation (toGL f)@@ -39,7 +40,7 @@   glEnable GL_BLEND  -- | Disable alpha blending.-disableBlending :: IO ()+disableBlending :: (MonadIO m) => m () disableBlending = glDisable GL_BLEND  -- | This blending configuration is suitable for ordinary alpha blending@@ -78,7 +79,7 @@   FuncAdd | -- ^ the default   FuncSubtract |   FuncReverseSubtract-    deriving Show+    deriving (Eq, Ord, Show, Read)  instance Default BlendEquation where   def = FuncAdd@@ -198,7 +199,7 @@ -- drawGreen = do --   setUniform3f "color" [V3 0 1 0] --   setUniform1f "alpha" [0.5]---   setUniform44 "move" [eye4]+--   setUniform44 "move" [identity] --   drawTriangles 3 --  -- drawRed = do
Graphics/GL/Low/BufferObject.hs view
@@ -61,17 +61,14 @@ 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.Classes --- | Handle to a VBO.-data VBO = VBO GLuint deriving Show --- | Handle to an element array buffer object.-data ElementArray = ElementArray GLuint deriving Show- -- | Usage hint for allocation of buffer object storage. data UsageHint = StaticDraw  -- ^ Data will seldomly change.                | DynamicDraw -- ^ Data will change.@@ -83,72 +80,63 @@   toGL DynamicDraw = GL_DYNAMIC_DRAW   toGL StreamDraw  = GL_STREAM_DRAW -instance GLObject VBO where-  glObjectName (VBO n) = fromIntegral n -instance GLObject ElementArray where-  glObjectName (ElementArray n) = fromIntegral n -instance BufferObject VBO--instance BufferObject ElementArray-- -- | Create a buffer object from a blob of bytes. The usage argument hints -- at how often you will modify the data.-newVBO :: Storable a => Vector a -> UsageHint -> IO VBO+newVBO :: (MonadIO m, Storable a) => Vector a -> UsageHint -> m VBO newVBO = newBufferObject VBO GL_ARRAY_BUFFER  -- | Delete a VBO or ElementArray.-deleteBufferObject :: BufferObject a => a -> IO ()-deleteBufferObject bo = withArray [glObjectName bo] (\ptr -> glDeleteBuffers 1 ptr)+deleteBufferObject :: (MonadIO m, BufferObject a) => a -> m ()+deleteBufferObject bo = liftIO $ withArray [glObjectName bo] (\ptr -> glDeleteBuffers 1 ptr)  -- | Modify the data in the currently bound VBO starting from the specified -- index in bytes.-updateVBO :: Storable a => Vector a -> Int -> IO ()+updateVBO :: (MonadIO m, Storable a) => Vector a -> Int -> m () 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 :: VBO -> IO ()+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 :: Storable a => Vector a -> UsageHint -> IO ElementArray+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 -- specified index in bytes.-updateElementArray :: Storable a => Vector a -> Int -> IO ()+updateElementArray :: (MonadIO m, Storable a) => Vector a -> Int -> m () 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 :: ElementArray -> IO ()+bindElementArray :: (MonadIO m) => ElementArray -> m () bindElementArray (ElementArray n) = glBindBuffer GL_ELEMENT_ARRAY_BUFFER n  -newBufferObject :: forall a b . Storable a => (GLuint -> b) -> GLenum -> Vector a -> UsageHint -> IO b+newBufferObject :: forall m a b. (MonadIO m, Storable a) => (GLuint -> b) -> GLenum -> Vector a -> UsageHint -> m b newBufferObject ctor target src usage = do-  n <- alloca (\ptr -> glGenBuffers 1 ptr >> peek ptr)+  n <- liftIO $ 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+  liftIO . withForeignPtr fptr $ \ptr -> glBufferData     target     (fromIntegral (len * size))     (castPtr (ptr `plusPtr` off))     (toGL usage)   return (ctor n) -updateBufferObject :: forall a . Storable a => GLenum -> Vector a -> Int -> IO ()+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)-  withForeignPtr fptr $ \ptr -> glBufferSubData+  liftIO . withForeignPtr fptr $ \ptr -> glBufferSubData     target     (fromIntegral offset)     (fromIntegral (len * size))
Graphics/GL/Low/Classes.hs view
@@ -25,6 +25,12 @@ class ToGL a where   toGL :: (Num b, Eq b) => a -> b +instance ToGL Bool where+  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 view
@@ -1,19 +1,20 @@ 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 :: IO ()+enableColorWriting :: (MonadIO m) => m () enableColorWriting = glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE  -- | Disable rendering to color buffer.-disableColorWriting :: IO ()+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 :: (Float, Float, Float) -> IO ()+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/Depth.hs view
@@ -1,17 +1,18 @@ 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 :: IO ()+enableDepthTest :: (MonadIO m) => m () enableDepthTest = glEnable GL_DEPTH_TEST  -- | Disable the depth test and depth buffer updates.-disableDepthTest :: IO ()+disableDepthTest :: (MonadIO m) => m () disableDepthTest = glDisable GL_DEPTH_TEST  -- | Clear the depth buffer with the maximum depth value.-clearDepthBuffer :: IO ()+clearDepthBuffer :: (MonadIO m) => m () clearDepthBuffer = glClear GL_DEPTH_BUFFER_BIT
Graphics/GL/Low/Error.hs view
@@ -16,6 +16,7 @@  import Control.Exception import Data.Typeable+import Control.Monad.IO.Class  import Graphics.GL @@ -47,7 +48,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 :: IO (Maybe GLError)+getGLError :: (MonadIO m) => m (Maybe GLError) getGLError = do   n <- glGetError   return $ case n of@@ -60,9 +61,9 @@     _ -> error ("unknown GL error " ++ show n)  -- | Throws an exception if 'getGLError' returns non-Nothing.-assertNoGLError :: IO ()+assertNoGLError :: (MonadIO m) => m () assertNoGLError = do   me <- getGLError   case me of     Nothing -> return ()-    Just e  -> throwIO e+    Just e  -> liftIO $ throwIO e
Graphics/GL/Low/Framebuffer.hs view
@@ -46,25 +46,18 @@ 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.Classes import Graphics.GL.Low.Common import Graphics.GL.Low.Cube import Graphics.GL.Low.Texture  --- | 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 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 a = RBO { unRBO :: GLuint } deriving Show- -- | The default framebuffer. data DefaultFramebuffer = DefaultFramebuffer deriving Show @@ -74,34 +67,24 @@ instance Framebuffer DefaultFramebuffer where   framebufferName _ = 0 -instance Framebuffer FBO where-  framebufferName = glObjectName -instance GLObject FBO where-  glObjectName (FBO n) = fromIntegral n--instance GLObject (RBO a) where-  glObjectName (RBO n) = fromIntegral n- -- | Binds an FBO or the default framebuffer to the framebuffer binding target. -- Replaces the framebuffer already bound there.-bindFramebuffer :: Framebuffer a => a -> IO ()+bindFramebuffer :: (MonadIO m, Framebuffer a) => a -> m () bindFramebuffer x = glBindFramebuffer GL_FRAMEBUFFER (framebufferName x)  -- | Create a new framebuffer object. Before the framebuffer can be used for -- rendering it must have a color image attachment.-newFBO :: IO FBO-newFBO = do-  n <- alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)-  return (FBO n)+newFBO :: (MonadIO m) => m FBO+newFBO = liftIO . fmap FBO $ alloca (\ptr -> glGenFramebuffers 1 ptr >> peek ptr)  -- | Delete an FBO.-deleteFBO :: FBO -> IO ()-deleteFBO (FBO n) = withArray [n] (\ptr -> glDeleteFramebuffers 1 ptr)+deleteFBO :: (MonadIO m) => FBO -> m ()+deleteFBO (FBO n) = liftIO $ withArray [n] (\ptr -> glDeleteFramebuffers 1 ptr)  -- | Attach a 2D texture to the FBO currently bound to the -- framebuffer binding target.-attachTex2D :: Attachable a => Tex2D a -> IO ()+attachTex2D :: (MonadIO m, Attachable a) => Tex2D a -> m () attachTex2D tex =   glFramebufferTexture2D     GL_FRAMEBUFFER@@ -112,7 +95,7 @@  -- | Attach one of the sides of a cubemap texture to the FBO currently bound -- to the framebuffer binding target.-attachCubeMap :: Attachable a => CubeMap a -> Side -> IO ()+attachCubeMap :: (MonadIO m, Attachable a) => CubeMap a -> Side -> m () attachCubeMap cm side =   glFramebufferTexture2D     GL_FRAMEBUFFER@@ -123,14 +106,14 @@  -- | Attach an RBO to the FBO currently bound to the framebuffer binding -- target.-attachRBO :: Attachable a => RBO a -> IO ()+attachRBO :: (MonadIO m, Attachable a) => RBO a -> m () attachRBO rbo = glFramebufferRenderbuffer   GL_FRAMEBUFFER (attachPoint rbo) GL_RENDERBUFFER (unRBO rbo)  -- | Create a new renderbuffer with the specified dimensions.-newRBO :: InternalFormat a => Int -> Int -> IO (RBO a)+newRBO :: (MonadIO m, InternalFormat a) => Int -> Int -> m (RBO a) newRBO w h = do-  n <- alloca (\ptr -> glGenRenderbuffers 1 ptr >> peek ptr)+  n <- liftIO $ alloca (\ptr -> glGenRenderbuffers 1 ptr >> peek ptr)   rbo <- return (RBO n)   glBindRenderbuffer GL_RENDERBUFFER n   glRenderbufferStorage@@ -141,8 +124,8 @@   return rbo  -- | Delete an RBO.-deleteRBO :: RBO a -> IO ()-deleteRBO (RBO n) = withArray [n] (\ptr -> glDeleteRenderbuffers 1 ptr)+deleteRBO :: (MonadIO m) => RBO a -> m ()+deleteRBO (RBO n) = liftIO $ withArray [n] (\ptr -> glDeleteRenderbuffers 1 ptr)   -- $example
+ Graphics/GL/Low/Internal/Types.hs view
@@ -0,0 +1,105 @@+{-# 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
@@ -47,6 +47,7 @@ import Foreign.Ptr import Foreign.Marshal import Foreign.Storable+import Control.Monad.IO.Class  import Graphics.GL @@ -86,70 +87,70 @@   -drawPoints :: Int -> IO ()+drawPoints :: (MonadIO m) => Int -> m () drawPoints = drawArrays GL_POINTS -drawLines :: Int -> IO ()+drawLines :: (MonadIO m) => Int -> m () drawLines = drawArrays GL_LINES -drawLineStrip :: Int -> IO ()+drawLineStrip :: (MonadIO m) => Int -> m () drawLineStrip = drawArrays GL_LINE_STRIP -drawLineLoop :: Int -> IO ()+drawLineLoop :: (MonadIO m) => Int -> m () drawLineLoop = drawArrays GL_LINE_LOOP -drawTriangles :: Int -> IO ()+drawTriangles :: (MonadIO m) => Int -> m () drawTriangles = drawArrays GL_TRIANGLES -drawTriangleStrip :: Int -> IO ()+drawTriangleStrip :: (MonadIO m) => Int -> m () drawTriangleStrip = drawArrays GL_TRIANGLE_STRIP -drawTriangleFan :: Int -> IO ()+drawTriangleFan :: (MonadIO m) => Int -> m () drawTriangleFan = drawArrays GL_TRIANGLE_FAN -drawArrays :: GLenum -> Int -> IO ()+drawArrays :: (MonadIO m) => GLenum -> Int -> m () drawArrays mode n = glDrawArrays mode 0 (fromIntegral n) -drawIndexedPoints :: Int -> IndexFormat -> IO ()+drawIndexedPoints :: (MonadIO m) => Int -> IndexFormat -> m () drawIndexedPoints = drawIndexed GL_POINTS -drawIndexedLines :: Int -> IndexFormat -> IO ()+drawIndexedLines :: (MonadIO m) => Int -> IndexFormat -> m () drawIndexedLines = drawIndexed GL_LINES -drawIndexedLineStrip :: Int -> IndexFormat -> IO ()+drawIndexedLineStrip :: (MonadIO m) => Int -> IndexFormat -> m () drawIndexedLineStrip = drawIndexed GL_LINE_STRIP -drawIndexedLineLoop :: Int -> IndexFormat -> IO ()+drawIndexedLineLoop :: (MonadIO m) => Int -> IndexFormat -> m () drawIndexedLineLoop = drawIndexed GL_LINE_LOOP -drawIndexedTriangles :: Int -> IndexFormat -> IO ()+drawIndexedTriangles :: (MonadIO m) => Int -> IndexFormat -> m () drawIndexedTriangles = drawIndexed GL_TRIANGLES -drawIndexedTriangleStrip :: Int -> IndexFormat -> IO ()+drawIndexedTriangleStrip :: (MonadIO m) => Int -> IndexFormat -> m () drawIndexedTriangleStrip = drawIndexed GL_TRIANGLE_STRIP -drawIndexedTriangleFan :: Int -> IndexFormat -> IO ()+drawIndexedTriangleFan :: (MonadIO m) => Int -> IndexFormat -> m () drawIndexedTriangleFan = drawIndexed GL_TRIANGLE_FAN -drawIndexed :: GLenum -> Int -> IndexFormat -> IO ()+drawIndexed :: (MonadIO m) => GLenum -> Int -> IndexFormat -> m () 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 :: Viewport -> IO ()+enableScissorTest :: (MonadIO m) => Viewport -> m () 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 :: IO ()+disableScissorTest :: (MonadIO m) => m () disableScissorTest = glDisable GL_SCISSOR_TEST   -- | Enable facet 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 :: Culling -> IO ()+enableCulling :: (MonadIO m) => Culling -> m () enableCulling c = do   case c of     CullFront -> glCullFace GL_FRONT@@ -158,10 +159,10 @@   glEnable GL_CULL_FACE  -- | Disable facet culling. Front and back faces will now be rendered.-disableCulling :: IO ()+disableCulling :: (MonadIO m) => m () disableCulling = glDisable GL_CULL_FACE  -- | Set the viewport. The default viewport simply covers the entire window.-setViewport :: Viewport -> IO ()+setViewport :: (MonadIO m) => Viewport -> m () setViewport (Viewport x y w h) =   glViewport (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
Graphics/GL/Low/Shader.hs view
@@ -60,18 +60,19 @@ 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.Classes import Graphics.GL.Low.VertexAttrib --- | Handle to a shader program.-newtype Program = Program GLuint deriving Show  -- | Either a vertex shader or a fragment shader.-data ShaderType = VertexShader | FragmentShader deriving Show+data ShaderType = VertexShader | FragmentShader +  deriving (Eq, Ord, Show, Read)  instance ToGL ShaderType where   toGL VertexShader = GL_VERTEX_SHADER@@ -88,20 +89,21 @@ instance Exception ProgramError  -- | Same as 'newProgram' but does not throw exceptions.-newProgramSafe :: String -> String -> IO (Either ProgramError Program)-newProgramSafe vcode fcode = try $ newProgram vcode fcode+newProgramSafe :: (MonadIO m) => String -> String -> m (Either ProgramError Program)+newProgramSafe vcode fcode = liftIO . try $ newProgram vcode fcode  -- | Delete a program.-deleteProgram :: Program -> IO ()+deleteProgram :: (MonadIO m) => Program -> m () 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 :: String -- ^ vertex shader source code+newProgram :: (MonadIO m) +           => String -- ^ vertex shader source code            -> String -- ^ fragment shader source code-           -> IO Program-newProgram vcode fcode = do+           -> m Program+newProgram vcode fcode = liftIO $ do   vertexShaderId <- compileShader vcode VertexShader   fragmentShaderId <- compileShader fcode FragmentShader   programId <- glCreateProgram@@ -123,11 +125,11 @@  -- | Install a program into the rendering pipeline. Replaces the program -- already in use, if any.-useProgram :: Program -> IO ()+useProgram :: (MonadIO m) => Program -> m () useProgram (Program n) = glUseProgram n -compileShader :: String -> ShaderType -> IO GLuint-compileShader code vertOrFrag = do+compileShader :: (MonadIO m) => String -> ShaderType -> m GLuint+compileShader code vertOrFrag = liftIO $ do   shaderId <- glCreateShader (toGL vertOrFrag)   withCString code $ \ptr -> with ptr $ \pptr -> do     glShaderSource shaderId 1 pptr nullPtr@@ -145,55 +147,55 @@       FragmentShader -> throwIO (FragmentShaderError errors)   return shaderId -setUniform1f :: String -> [Float] -> IO ()+setUniform1f :: (MonadIO m) => String -> [Float] -> m () setUniform1f = setUniform glUniform1fv -setUniform2f :: String -> [V2 Float] -> IO ()+setUniform2f :: (MonadIO m) => String -> [V2 Float] -> m () setUniform2f = setUniform   (\loc cnt val -> glUniform2fv loc cnt (castPtr val)) -setUniform3f :: String -> [V3 Float] -> IO ()+setUniform3f :: (MonadIO m) => String -> [V3 Float] -> m () setUniform3f = setUniform   (\loc cnt val -> glUniform3fv loc cnt (castPtr val)) -setUniform4f :: String -> [V4 Float] -> IO ()+setUniform4f :: (MonadIO m) => String -> [V4 Float] -> m () setUniform4f = setUniform   (\loc cnt val -> glUniform4fv loc cnt (castPtr val)) -setUniform1i :: String -> [Int] -> IO ()+setUniform1i :: (MonadIO m) => String -> [Int] -> m () setUniform1i = setUniform   (\loc cnt val -> glUniform1iv loc cnt (castPtr val)) -setUniform2i :: String -> [V2 Int] -> IO ()+setUniform2i :: (MonadIO m) => String -> [V2 Int] -> m () setUniform2i = setUniform    (\loc cnt val -> glUniform2iv loc cnt (castPtr val)) -setUniform3i :: String -> [V3 Int] -> IO ()+setUniform3i :: (MonadIO m) => String -> [V3 Int] -> m () setUniform3i = setUniform   (\loc cnt val -> glUniform3iv loc cnt (castPtr val)) -setUniform4i :: String -> [V4 Int] -> IO ()+setUniform4i :: (MonadIO m) => String -> [V4 Int] -> m () setUniform4i = setUniform   (\loc cnt val -> glUniform4iv loc cnt (castPtr val)) -setUniform44 :: String -> [M44 Float] -> IO ()+setUniform44 :: (MonadIO m) => String -> [M44 Float] -> m () setUniform44 = setUniform   (\loc cnt val -> glUniformMatrix4fv loc cnt GL_FALSE (castPtr val)) -setUniform33 :: String -> [M33 Float] -> IO ()+setUniform33 :: (MonadIO m) => String -> [M33 Float] -> m () setUniform33 = setUniform   (\loc cnt val -> glUniformMatrix3fv loc cnt GL_FALSE (castPtr val)) -setUniform22 :: String -> [M22 Float] -> IO ()+setUniform22 :: (MonadIO m) => String -> [M22 Float] -> m () setUniform22 = setUniform   (\loc cnt val -> glUniformMatrix2fv loc cnt GL_FALSE (castPtr val)) -setUniform :: Storable a+setUniform :: (MonadIO m, Storable a)            => (GLint -> GLsizei -> Ptr a -> IO ())            -> String            -> [a]-           -> IO ()-setUniform glAction name xs = withArrayLen xs $ \n bytes -> do+           -> m ()+setUniform glAction name xs = liftIO . withArrayLen xs $ \n bytes -> do   p <- alloca (\ptr -> glGetIntegerv GL_CURRENT_PROGRAM ptr >> peek ptr)   if p == 0     then return ()
Graphics/GL/Low/Stencil.hs view
@@ -31,23 +31,24 @@ 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 :: Stencil -> IO ()+enableStencil :: (MonadIO m) => Stencil -> m () enableStencil (Stencil f r m op1 op2 op3) = do   glStencilFunc (toGL f) (fromIntegral r) (fromIntegral m)-  glStencilOp (toGL op1) (toGL op2) (toGL op2)+  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 :: IO ()+disableStencil :: (MonadIO m) => m () disableStencil = glDisable GL_STENCIL_TEST  -- | Clear the stencil buffer with all zeros.-clearStencilBuffer :: IO ()+clearStencilBuffer :: (MonadIO m) => m () clearStencilBuffer = glClear GL_STENCIL_BUFFER_BIT  -- | In this basic configuration of the stencil, anything rendered will
Graphics/GL/Low/Texture.hs view
@@ -37,16 +37,19 @@  ) where +import Prelude hiding (sequence) import Foreign.Ptr import Foreign.Marshal import Foreign.Storable import Data.Vector.Storable import Data.Word import Control.Applicative-import Data.Traversable (sequenceA)+import Data.Traversable (sequence)+import Control.Monad.IO.Class  import Graphics.GL +import Graphics.GL.Low.Internal.Types import Graphics.GL.Low.Classes import Graphics.GL.Low.Common import Graphics.GL.Low.Cube@@ -55,15 +58,15 @@ -- | 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 :: (Storable a, InternalFormat b)+newTexture2D :: (MonadIO m, Storable a, InternalFormat b)              => Vector a              -> Dimensions-             -> IO (Tex2D b)+             -> m (Tex2D b) newTexture2D bytes (Dimensions w h)  = do-  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)+  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)   glBindTexture GL_TEXTURE_2D n   tex <- return (Tex2D n)-  unsafeWith bytes $ \ptr -> glTexImage2D+  liftIO . unsafeWith bytes $ \ptr -> glTexImage2D     GL_TEXTURE_2D     0     (internalFormat tex)@@ -78,21 +81,21 @@  -- | Create a new cube map texture from six blobs and their respective dimensions. -- Dimensions should be powers of two.-newCubeMap :: (Storable a, InternalFormat b)+newCubeMap :: (MonadIO m, Storable a, InternalFormat b)            => Cube (Vector a, Dimensions)-           -> IO (CubeMap b)+           -> m (CubeMap b) newCubeMap images = do-  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)+  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)   glBindTexture GL_TEXTURE_CUBE_MAP n   cm <- return (CubeMap n)   let fmt = internalFormat cm-  sequenceA (liftA2 (loadCubeMapSide fmt) images cubeSideCodes)+  sequence (loadCubeMapSide fmt <$> images <*> cubeSideCodes)   glGenerateMipmap GL_TEXTURE_CUBE_MAP   return cm    -loadCubeMapSide :: Storable a => GLenum -> (Vector a, Dimensions) -> GLenum -> IO ()-loadCubeMapSide fmt (bytes, (Dimensions w h)) side = do+loadCubeMapSide :: (MonadIO m, Storable a) => GLenum -> (Vector a, Dimensions) -> GLenum -> m ()+loadCubeMapSide fmt (bytes, (Dimensions w h)) side = liftIO $ do   unsafeWith bytes $ \ptr -> glTexImage2D     side     0@@ -105,11 +108,11 @@     (castPtr ptr)  -- | Create an empty texture with the specified dimensions and format.-newEmptyTexture2D :: InternalFormat a => Int -> Int -> IO (Tex2D a)+newEmptyTexture2D :: (MonadIO m, InternalFormat a) => Int -> Int -> m (Tex2D a) newEmptyTexture2D w h = do   let w' = fromIntegral w   let h' = fromIntegral h-  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)+  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)   tex <- return (Tex2D n)   let fmt = internalFormat tex   let fmt' = internalFormat tex@@ -119,11 +122,11 @@  -- | Create a cubemap texture where each of the six sides has the specified -- dimensions and format.-newEmptyCubeMap :: InternalFormat a => Int -> Int -> IO (CubeMap a)+newEmptyCubeMap :: (MonadIO m, InternalFormat a) => Int -> Int -> m (CubeMap a) newEmptyCubeMap w h = do   let w' = fromIntegral w   let h' = fromIntegral h-  n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)+  n <- liftIO $ alloca (\ptr -> glGenTextures 1 ptr >> peek ptr)   tex <- return (CubeMap n)   let fmt = internalFormat tex   let fmt' = internalFormat tex@@ -137,41 +140,41 @@   return tex    -- | Delete a texture.-deleteTexture :: Texture a => a -> IO ()-deleteTexture x = withArray [glObjectName x] (\ptr -> glDeleteTextures 1 ptr)+deleteTexture :: (MonadIO m, Texture a) => a -> m ()+deleteTexture x = liftIO $ withArray [glObjectName x] (\ptr -> glDeleteTextures 1 ptr)  -- | Bind a 2D texture to the 2D texture binding target and the currently -- active texture unit.-bindTexture2D :: Tex2D a -> IO ()+bindTexture2D :: (MonadIO m) => Tex2D a -> m () bindTexture2D (Tex2D n) = glBindTexture GL_TEXTURE_2D n  -- | Bind a cubemap texture to the cubemap texture binding target and -- the currently active texture unit.-bindTextureCubeMap :: CubeMap a -> IO ()+bindTextureCubeMap :: (MonadIO m) => CubeMap a -> m () bindTextureCubeMap (CubeMap n) = glBindTexture GL_TEXTURE_CUBE_MAP n  -- | Set the active texture unit. The default is zero.-setActiveTextureUnit :: Enum a => a -> IO ()+setActiveTextureUnit :: (MonadIO m, Enum a) => a -> m () setActiveTextureUnit n =   (glActiveTexture . fromIntegral) (GL_TEXTURE0 + fromEnum n)  -- | Set the filtering for the 2D texture currently bound to the 2D texture -- binding target.-setTex2DFiltering :: Filtering -> IO ()+setTex2DFiltering :: (MonadIO m) => Filtering -> m () 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 :: Filtering -> IO ()+setCubeMapFiltering :: (MonadIO m) => Filtering -> m () 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 :: Wrapping -> IO ()+setTex2DWrapping :: (MonadIO m) => Wrapping -> m () setTex2DWrapping wrap = do   glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S (toGL wrap)   glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T (toGL wrap)@@ -179,20 +182,12 @@ -- | Set the wrapping mode for the cubemap texture currently bound to the -- cubemap texture binding target. Because no blending occurs between cube -- faces you probably want ClampToEdge.-setCubeMapWrapping :: Wrapping -> IO ()+setCubeMapWrapping :: (MonadIO m) => Wrapping -> m () 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)   glTexParameteri GL_TEXTURE_CUBE_MAP GL_TEXTURE_WRAP_R (toGL wrap) --- | A 2D texture. A program can sample a texture if it has been bound to--- the appropriate texture unit.-newtype Tex2D a = Tex2D GLuint deriving Show---- | 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 GLuint deriving Show- -- | Texture filtering modes. data Filtering =   Nearest | -- ^ No interpolation.@@ -220,16 +215,6 @@   { imageWidth  :: Int   , imageHeight :: Int }     deriving (Show)--instance Texture (Tex2D a) where--instance Texture (CubeMap a) where--instance GLObject (Tex2D a) where-  glObjectName (Tex2D n) = fromIntegral n--instance GLObject (CubeMap a) where-  glObjectName (CubeMap n) = fromIntegral n  -- $example --
Graphics/GL/Low/VAO.hs view
@@ -7,7 +7,7 @@ -- the integer location of the variable) with three things: -- -- - The VBO to read from.--- - The position in the each vertex array (in the VBO) to read from.+-- - The position in the vertex array 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:@@ -63,29 +63,25 @@  import Foreign.Storable import Foreign.Marshal+import Control.Monad.IO.Class  import Graphics.GL +import Graphics.GL.Low.Internal.Types import Graphics.GL.Low.Classes --- | Handle to a VAO.-newtype VAO = VAO GLuint deriving Show--instance GLObject VAO where-  glObjectName (VAO n) = fromIntegral n- -- | Create a new VAO. The only thing you can do with a VAO is bind it to -- the vertex array binding target.-newVAO :: IO VAO-newVAO = do+newVAO :: (MonadIO m) => m VAO+newVAO = liftIO $ do   n <- alloca (\ptr -> glGenVertexArrays 1 ptr >> peek ptr)   return (VAO n)  -- | Delete a VAO.-deleteVAO :: VAO -> IO ()-deleteVAO (VAO n) = withArray [n] (\ptr -> glDeleteVertexArrays 1 ptr)+deleteVAO :: (MonadIO m) => VAO -> m ()+deleteVAO (VAO n) = liftIO $ 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 :: VAO -> IO ()+bindVAO :: (MonadIO m) => VAO -> m () bindVAO (VAO n) = glBindVertexArray n
Graphics/GL/Low/VertexAttrib.hs view
@@ -27,6 +27,7 @@ import Foreign.Marshal import Foreign.Storable import Control.Monad (forM_)+import Control.Monad.IO.Class  import Graphics.GL import Graphics.GL.Low.Classes@@ -53,8 +54,8 @@  -- | This configures the currently bound VAO. It calls glVertexAttribPointer -- and glEnableVertexAttribArray.-setVertexLayout :: [VertexLayout] -> IO ()-setVertexLayout layout = do+setVertexLayout :: (MonadIO m) => [VertexLayout] -> m ()+setVertexLayout layout = liftIO $ do   p <- alloca (\ptr -> glGetIntegerv GL_CURRENT_PROGRAM ptr >> peek ptr)   if p == 0     then return ()@@ -82,10 +83,6 @@   toGL GLUnsignedShort = GL_UNSIGNED_SHORT   toGL GLInt           = GL_INT   toGL GLUnsignedInt   = GL_UNSIGNED_INT--instance ToGL Bool where-  toGL True = GL_TRUE-  toGL False = GL_FALSE  elaborateLayout :: Int -> [VertexLayout] -> [(String, Int, Int, DataType)] elaborateLayout here layout = case layout of
lowgl.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.3.1.1+version:             0.3.1.2  -- A short (one-line) description of the package. synopsis:            Basic gl wrapper and reference@@ -65,7 +65,8 @@                        Graphics.GL.Low.Texture                        Graphics.GL.Low.VAO                        Graphics.GL.Low.VertexAttrib-  other-modules:       Graphics.GL.Low.Common+                       Graphics.GL.Low.Common+                       Graphics.GL.Low.Internal.Types      -- Modules included in this library but not exported.   -- other-modules:       @@ -74,7 +75,12 @@   -- other-extensions:          -- Other library packages from which modules are imported.-  build-depends:       base >=4.7 && <4.8, vector >=0.10 && <0.11, linear >= 1.16 && <1.17, gl >=0.5 && <0.8, data-default+  build-depends:       base >=4.7 && <=4.9, +                       transformers >= 0.4 && < 0.5,+                       vector >=0.10 && <0.11, +                       linear >= 1.16 && <1.21, +                       gl >=0.5 && <0.8, +                       data-default      -- Directories containing source files.   -- hs-source-dirs:      @@ -90,4 +96,4 @@ source-repository this   type: git   location: https://github.com/evanrinehart/lowgl-  tag: 0.3.1.1+  tag: 0.3.1.2