diff --git a/Graphics/GL/Low.hs b/Graphics/GL/Low.hs --- a/Graphics/GL/Low.hs +++ b/Graphics/GL/Low.hs @@ -428,7 +428,7 @@ -- * Framebuffers -- | See also "Graphics.GL.Low.Framebuffer" - DefaultFramebuffer, + DefaultFramebuffer(..), FBO, bindFramebuffer, newFBO, @@ -445,6 +445,7 @@ -- * Errors GLError(..), getGLError, + assertNoGLError, -- * Image Formats Alpha, diff --git a/Graphics/GL/Low/Error.hs b/Graphics/GL/Low/Error.hs --- a/Graphics/GL/Low/Error.hs +++ b/Graphics/GL/Low/Error.hs @@ -11,6 +11,7 @@ module Graphics.GL.Low.Error ( GLError(..), getGLError, + assertNoGLError, ) where import Control.Exception @@ -57,3 +58,11 @@ GL_INVALID_FRAMEBUFFER_OPERATION -> Just InvalidFramebufferOperation GL_OUT_OF_MEMORY -> Just OutOfMemory _ -> error ("unknown GL error " ++ show n) + +-- | Throws an exception if 'getGLError' returns non-Nothing. +assertNoGLError :: IO () +assertNoGLError = do + me <- getGLError + case me of + Nothing -> return () + Just e -> throwIO e diff --git a/Graphics/GL/Low/Framebuffer.hs b/Graphics/GL/Low/Framebuffer.hs --- a/Graphics/GL/Low/Framebuffer.hs +++ b/Graphics/GL/Low/Framebuffer.hs @@ -1,16 +1,48 @@ +-- | Framebuffers, FBO, RBO... +-- +-- == Example +-- +-- This example program renders an animating object to an off-screen +-- framebuffer. The resulting texture is then show on a full-screen quad +-- with an effect. +-- +-- @ +-- +-- @ +-- +-- The vertex shader for this program is +-- +-- @ +-- +-- @ +-- +-- The two fragment shaders, one for the object, one for the effect, are +-- +-- @ +-- +-- @ +-- +-- @ +-- +-- @ +-- +-- And the output looks like +-- +-- <> + {-# LANGUAGE RankNTypes #-} module Graphics.GL.Low.Framebuffer ( - FBO, - RBO, - DefaultFramebuffer, - bindFramebuffer, newFBO, + bindFramebuffer, deleteFBO, attachTex2D, attachCubeMap, attachRBO, newRBO, - deleteRBO + deleteRBO, + FBO, + DefaultFramebuffer(..), + RBO, ) where import Foreign.Ptr @@ -35,8 +67,7 @@ -- you can do with an RBO is attach it to an FBO. data RBO a = RBO { unRBO :: GLuint } deriving Show --- | The default framebuffer. Bind this to render to the screen as usual. --- Use the Default instance method 'def' to construct it. +-- | The default framebuffer. data DefaultFramebuffer = DefaultFramebuffer deriving Show instance Default DefaultFramebuffer where diff --git a/Graphics/GL/Low/ImageFormat.hs b/Graphics/GL/Low/ImageFormat.hs --- a/Graphics/GL/Low/ImageFormat.hs +++ b/Graphics/GL/Low/ImageFormat.hs @@ -26,7 +26,7 @@ data Depth24Stencil8 = Depth24Stencil8 deriving Show instance InternalFormat RGB where - internalFormat _ = GL_RGB8 + internalFormat _ = GL_RGB instance InternalFormat RGBA where internalFormat _ = GL_RGBA instance InternalFormat Alpha where diff --git a/Graphics/GL/Low/Stencil.hs b/Graphics/GL/Low/Stencil.hs --- a/Graphics/GL/Low/Stencil.hs +++ b/Graphics/GL/Low/Stencil.hs @@ -16,13 +16,16 @@ -- - When the stencil test fails or -- - When the stencil test passes then the depth test fails or -- - When both tests pass. --- --- An example way of updating the stencil buffer is to write zero, or to write --- the ref value mentioned above to the location being tested. --- --- > example program here -module Graphics.GL.Low.Stencil where +module Graphics.GL.Low.Stencil ( + enableStencil, + disableStencil, + clearStencilBuffer, + basicStencil, + Stencil(..), + StencilFunc(..), + StencilOp(..) +) where import Data.Default import Data.Bits diff --git a/Graphics/GL/Low/Texture.hs b/Graphics/GL/Low/Texture.hs --- a/Graphics/GL/Low/Texture.hs +++ b/Graphics/GL/Low/Texture.hs @@ -1,21 +1,140 @@ +-- | 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). +-- +-- 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 +-- assign a texture to a texture unit, use 'setActiveTextureUnit' then bind +-- 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 +-- sampler because the default unit is zero. +-- +-- == 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. +-- +-- @ +-- module Main where +-- +-- import Control.Monad.Loops (whileM_) +-- import Data.Functor ((\<$\>)) +-- import qualified Data.Vector.Storable as V +-- import Codec.Picture +-- import Data.Word +-- +-- import qualified Graphics.UI.GLFW as GLFW +-- import Linear +-- import Graphics.GL.Low +-- +-- main = do +-- GLFW.init +-- GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 3) +-- GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 2) +-- GLFW.windowHint (GLFW.WindowHint'OpenGLForwardCompat True) +-- GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core) +-- mwin <- GLFW.createWindow 640 480 \"Texture\" Nothing Nothing +-- case mwin of +-- Nothing -> putStrLn "createWindow failed" +-- Just win -> do +-- GLFW.makeContextCurrent (Just win) +-- GLFW.swapInterval 1 +-- (vao, prog, texture) <- setup +-- whileM_ (not \<$\> GLFW.windowShouldClose win) $ do +-- GLFW.pollEvents +-- draw vao prog texture +-- GLFW.swapBuffers win +-- +-- setup = do +-- -- establish a VAO +-- vao <- newVAO +-- bindVAO vao +-- -- load the shader +-- vsource <- readFile "texture.vert" +-- fsource <- readFile "texture.frag" +-- prog <- newProgram vsource fsource +-- useProgram prog +-- -- load the vertices +-- let blob = V.fromList -- a quad has four vertices +-- [ -0.5, -0.5, 0, 1 +-- , -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 +-- bindVBO vbo +-- setVertexLayout [ Attrib "position" 2 GLFloat +-- , Attrib "texcoord" 2 GLFloat ] +-- -- load the element array to draw a quad with two triangles +-- indices <- newElementArray (V.fromList [0,1,2,3,2,1] :: V.Vector Word8) StaticDraw +-- bindElementArray indices +-- -- 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) +-- setTex2DFiltering Linear +-- return (vao, prog, texture) +-- +-- draw vao prog texture = do +-- clearColorBuffer (0.5, 0.5, 0.5) +-- bindVAO vao +-- useProgram prog +-- bindTexture2D texture +-- drawIndexedTriangles 6 UByteIndices +-- @ +-- +-- The vertex shader for this example looks like +-- +-- @ +-- #version 150 +-- in vec2 position; +-- in vec2 texcoord; +-- out vec2 Texcoord; +-- void main() +-- { +-- gl_Position = vec4(position, 0.0, 1.0); +-- Texcoord = texcoord; +-- } +-- @ +-- +-- And the fragment shader looks like +-- +-- @ +-- #version 150 +-- in vec2 Texcoord; +-- out vec4 outColor; +-- uniform sampler2D tex; +-- void main() +-- { +-- outColor = texture(tex, Texcoord); +-- } +-- @ +-- +-- Should produce output like +-- +-- <> + module Graphics.GL.Low.Texture ( - Tex2D, - CubeMap, - Filtering(..), - Wrapping(..), - Dimensions(..), newTexture2D, - deleteTexture, newCubeMap, newEmptyTexture2D, newEmptyCubeMap, + deleteTexture, bindTexture2D, bindTextureCubeMap, setActiveTextureUnit, setTex2DFiltering, setCubeMapFiltering, setTex2DWrapping, - setCubeMapWrapping + setCubeMapWrapping, + Tex2D, + CubeMap, + Filtering(..), + Wrapping(..), + Dimensions(..), ) where import Foreign.Ptr @@ -32,55 +151,14 @@ import Graphics.GL.Low.Common import Graphics.GL.Low.Cube --- | 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. - Linear -- ^ Linear interpolation. - deriving Show - -instance ToGL Filtering where - toGL Nearest = GL_NEAREST - toGL Linear = GL_LINEAR - --- | Texture wrapping modes. -data Wrapping = - Repeat | -- ^ Tile the texture past the boundary. - MirroredRepeat | -- ^ Tile the texture but mirror every other tile. - ClampToEdge -- ^ Use the edge color for anything past the boundary. - deriving Show - -instance ToGL Wrapping where - 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) - -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 - --- | Create a new 2D texture from a blob and its image format. --- Dimensions should be powers of two. -newTexture2D :: InternalFormat a => Vector Word8 -> Dimensions -> IO (Tex2D a) +-- | 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) + => Vector a + -> Dimensions + -> IO (Tex2D b) newTexture2D bytes (Dimensions w h) = do n <- alloca (\ptr -> glGenTextures 1 ptr >> peek ptr) glBindTexture GL_TEXTURE_2D n @@ -95,26 +173,25 @@ (internalFormat tex) GL_UNSIGNED_BYTE (castPtr ptr) + glGenerateMipmap GL_TEXTURE_2D return tex --- | Delete a texture. -deleteTexture :: Texture a => a -> IO () -deleteTexture x = withArray [glObjectName x] (\ptr -> glDeleteTextures 1 ptr) - --- | Create a new cube map texture from six blobs and their respective formats. +-- | Create a new cube map texture from six blobs and their respective dimensions. -- Dimensions should be powers of two. -newCubeMap :: InternalFormat a - => Cube (Vector Word8, Dimensions) - -> IO (CubeMap a) +newCubeMap :: (Storable a, InternalFormat b) + => Cube (Vector a, Dimensions) + -> IO (CubeMap b) newCubeMap images = do n <- 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) + glGenerateMipmap GL_TEXTURE_CUBE_MAP return cm + -loadCubeMapSide :: GLenum -> (Vector Word8, Dimensions) -> GLenum -> IO () +loadCubeMapSide :: Storable a => GLenum -> (Vector a, Dimensions) -> GLenum -> IO () loadCubeMapSide fmt (bytes, (Dimensions w h)) side = do unsafeWith bytes $ \ptr -> glTexImage2D side @@ -159,6 +236,9 @@ glTexImage2D GL_TEXTURE_CUBE_MAP_NEGATIVE_Z 0 fmt w' h' 0 fmt' GL_UNSIGNED_BYTE nullPtr return tex +-- | Delete a texture. +deleteTexture :: Texture a => a -> IO () +deleteTexture x = withArray [glObjectName x] (\ptr -> glDeleteTextures 1 ptr) -- | Bind a 2D texture to the 2D texture binding target and the currently -- active texture unit. @@ -204,3 +284,49 @@ 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. + Linear -- ^ Linear interpolation. + deriving Show + +instance ToGL Filtering where + toGL Nearest = GL_NEAREST + toGL Linear = GL_LINEAR + +-- | Texture wrapping modes. +data Wrapping = + Repeat | -- ^ Tile the texture past the boundary. + MirroredRepeat | -- ^ Tile the texture but mirror every other tile. + ClampToEdge -- ^ Use the edge color for anything past the boundary. + deriving Show + +instance ToGL Wrapping where + 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) + +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 diff --git a/Graphics/GL/Low/VertexAttrib.hs b/Graphics/GL/Low/VertexAttrib.hs --- a/Graphics/GL/Low/VertexAttrib.hs +++ b/Graphics/GL/Low/VertexAttrib.hs @@ -43,12 +43,11 @@ Unused Int -- ^ Size in bytes of an unused section of the vertex data. deriving Show --- | The size and interpretation of a vertex attribute component. Normalized --- components will be mapped to floats in the range [0, 1]. +-- | The size and interpretation of a vertex attribute component. data DataType = GLFloat | -- ^ 4-byte float - GLUnsignedByte | -- ^ unsigned byte GLByte | -- ^ signed byte + GLUnsignedByte | -- ^ unsigned byte GLShort | -- ^ 2-byte signed integer GLUnsignedShort | -- ^ 2-byte unsigned integer GLInt | -- ^ 4-byte signed integer diff --git a/lowgl.cabal b/lowgl.cabal --- a/lowgl.cabal +++ b/lowgl.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.3.0.0 +version: 0.3.1.0 -- A short (one-line) description of the package. synopsis: Basic gl wrapper and reference @@ -89,4 +89,4 @@ source-repository this type: git location: https://github.com/evanrinehart/lowgl - tag: 0.3.0.0 + tag: 0.3.1.0