luminance (empty) → 0.1

raw patch · 39 files changed

+2561/−0 lines, 39 filesdep +basedep +contravariantdep +glsetup-changed

Dependencies added: base, contravariant, gl, mtl, resourcet, semigroups, transformers, void

Files

• CHANGELOG.md +4/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• luminance.cabal +113/−0
• src/Graphics/Luminance.hs +27/−0
• src/Graphics/Luminance/Batch.hs +22/−0
• src/Graphics/Luminance/Blending.hs +30/−0
• src/Graphics/Luminance/Buffer.hs +33/−0
• src/Graphics/Luminance/Cmd.hs +20/−0
• src/Graphics/Luminance/Core/Batch.hs +103/−0
• src/Graphics/Luminance/Core/Blending.hs +111/−0
• src/Graphics/Luminance/Core/Buffer.hs +165/−0
• src/Graphics/Luminance/Core/Cmd.hs +51/−0
• src/Graphics/Luminance/Core/Debug.hs +81/−0
• src/Graphics/Luminance/Core/Framebuffer.hs +309/−0
• src/Graphics/Luminance/Core/Geometry.hs +97/−0
• src/Graphics/Luminance/Core/Pixel.hs +151/−0
• src/Graphics/Luminance/Core/Query.hs +46/−0
• src/Graphics/Luminance/Core/RW.hs +33/−0
• src/Graphics/Luminance/Core/RenderCmd.hs +31/−0
• src/Graphics/Luminance/Core/Renderbuffer.hs +33/−0
• src/Graphics/Luminance/Core/Shader/Program.hs +127/−0
• src/Graphics/Luminance/Core/Shader/Stage.hs +106/−0
• src/Graphics/Luminance/Core/Shader/Uniform.hs +206/−0
• src/Graphics/Luminance/Core/Texture.hs +211/−0
• src/Graphics/Luminance/Core/Tuple.hs +32/−0
• src/Graphics/Luminance/Core/Vertex.hs +94/−0
• src/Graphics/Luminance/Framebuffer.hs +37/−0
• src/Graphics/Luminance/Geometry.hs +18/−0
• src/Graphics/Luminance/Pixel.hs +41/−0
• src/Graphics/Luminance/Query.hs +20/−0
• src/Graphics/Luminance/RW.hs +22/−0
• src/Graphics/Luminance/RenderCmd.hs +19/−0
• src/Graphics/Luminance/Shader.hs +17/−0
• src/Graphics/Luminance/Shader/Program.hs +22/−0
• src/Graphics/Luminance/Shader/Stage.hs +26/−0
• src/Graphics/Luminance/Shader/Uniform.hs +17/−0
• src/Graphics/Luminance/Texture.hs +35/−0
• src/Graphics/Luminance/Vertex.hs +19/−0

@@ -0,0 +1,4 @@+### 0.1++- Initial revision. Do not consider this revision as a stable release. It’s experimental. The+  first stable release will be **1.0**.

@@ -0,0 +1,30 @@+Copyright (c) 2015, Dimitri Sabadie <dimitri.sabadie@gmail.com>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Dimitri Sabadie <dimitri.sabadie@gmail.com> nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,113 @@+name:                luminance+version:             0.1+synopsis:            Type-safe, dependently-typed and stateless graphics framework+description:         This package exposes several modules to work with /GPU/ in a stateless and+                     type-safe way. Currently, it uses **OpenGL** as backend hardware technology but+                     others will be added later on, such as **Vulkan**.+                     .+                     The initial unstable version is /0.1/. Consider everything in that version as+                     part of an experiment, even though the library should be free of bugs. If you+                     find any, please report an issue. If you think something could be enhanced,+                     feel free to fill in an issue as well.+                     .+                     One very important point is the fact that **luminance** has nothing to do with+                     /3D engines/ or /scene development kits/. Don’t expect to find /materials/,+                     /lights/ or /mesh/ loaders. It’s just a graphics framework initiated to fix the+                     design choices of **OpenGL**. It won’t change in any other way.+license:             BSD3+license-file:        LICENSE+author:              Dimitri Sabadie <dimitri.sabadie@gmail.com>+maintainer:          Dimitri Sabadie <dimitri.sabadie@gmail.com>+copyright:           Dimitri Sabadie+homepage:            https://github.com/phaazon/luminance+bug-reports:         https://github.com/phaazon/luminance/issues+category:            Graphics+extra-source-files:  CHANGELOG.md++build-type:          Simple+cabal-version:       >= 1.10++source-repository head+  type:     git+  location: git://github.com/phaazon/luminance.git++flag debug-gl+  description:         Enable OpenGL stdout debug (for development only)+  default:             False+  manual:              True++library+  ghc-options:         -W -Wall++  if flag(debug-gl)+    cpp-options:       -DDEBUG_GL++  exposed-modules:     Graphics.Luminance+                     , Graphics.Luminance.Batch+                     , Graphics.Luminance.Blending+                     , Graphics.Luminance.Buffer+                     , Graphics.Luminance.Cmd+                     , Graphics.Luminance.Core.Tuple+                     , Graphics.Luminance.Framebuffer+                     , Graphics.Luminance.Geometry+                     , Graphics.Luminance.Pixel+                     , Graphics.Luminance.Query+                     , Graphics.Luminance.RW+                     , Graphics.Luminance.RenderCmd+                     , Graphics.Luminance.Shader+                     , Graphics.Luminance.Shader.Program+                     , Graphics.Luminance.Shader.Stage+                     , Graphics.Luminance.Shader.Uniform+                     , Graphics.Luminance.Texture+                     , Graphics.Luminance.Vertex++  other-modules:       Graphics.Luminance.Core.Batch+                     , Graphics.Luminance.Core.Blending+                     , Graphics.Luminance.Core.Buffer+                     , Graphics.Luminance.Core.Cmd+                     , Graphics.Luminance.Core.Debug+                     , Graphics.Luminance.Core.Framebuffer+                     , Graphics.Luminance.Core.Geometry+                     , Graphics.Luminance.Core.Pixel+                     , Graphics.Luminance.Core.Query+                     , Graphics.Luminance.Core.RenderCmd+                     , Graphics.Luminance.Core.Renderbuffer+                     , Graphics.Luminance.Core.RW+                     , Graphics.Luminance.Core.Shader.Program+                     , Graphics.Luminance.Core.Shader.Stage+                     , Graphics.Luminance.Core.Shader.Uniform+                     , Graphics.Luminance.Core.Texture+                     , Graphics.Luminance.Core.Vertex++  default-extensions:  DataKinds+                     , DeriveFoldable+                     , DeriveFunctor+                     , FlexibleContexts+                     , FlexibleInstances+                     , GADTs+                     , GeneralizedNewtypeDeriving+                     , MultiParamTypeClasses+                     , MultiWayIf+                     , PolyKinds+                     , RankNTypes+                     , ScopedTypeVariables+                     , StandaloneDeriving+                     , TupleSections+                     , TypeFamilies+                     , TypeOperators++  other-extensions:    CPP+                     , UndecidableInstances++  build-depends:       base           >= 4.8  && < 4.9+                     , contravariant  >= 1.3  && < 1.4+                     , gl             >= 0.7  && < 0.8+                     , mtl            >= 2.2  && < 2.3+                     , resourcet      >= 1.1  && < 1.2+                     , semigroups     >= 0.16 && < 0.17+                     , transformers   >= 0.4  && < 0.5+                     , void           >= 0.7  && < 0.8++  hs-source-dirs:      src++  default-language:    Haskell2010

@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance (+    module X+  ) where++import Graphics.Luminance.Batch as X+import Graphics.Luminance.Blending as X+import Graphics.Luminance.Buffer as X+import Graphics.Luminance.Cmd as X+import Graphics.Luminance.Framebuffer as X+import Graphics.Luminance.Geometry as X+import Graphics.Luminance.Pixel as X+import Graphics.Luminance.Query as X+import Graphics.Luminance.RenderCmd as X+import Graphics.Luminance.RW as X+import Graphics.Luminance.Shader as X+import Graphics.Luminance.Texture as X+import Graphics.Luminance.Vertex as X

@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Batch (+    -- * Framebuffer batch+    FBBatch+  , framebufferBatch+    -- * Shader program batch+  , SPBatch+  , AnySPBatch+  , anySPBatch+  , shaderProgramBatch+  ) where++import Graphics.Luminance.Core.Batch

@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-- That module exports blending-related types and functions.+--+-- Given two pixels @src@ and @dst@ – source and destination, we associate+-- each pixel a /blending factor/ – respectively, @srcK@ and @dstK@. @src@ is+-- the pixel being computed, and @dst@ is the pixel that is already stored in+-- the framebuffer.+--+-- The pixels can be blended in several ways. See the documentation of+-- 'BlendingMode' for further details.+--+-- The factors are encoded with 'BlendingFactor'.+-----------------------------------------------------------------------------++module Graphics.Luminance.Blending (+    -- * Blending modes+    BlendingMode(..)+    -- * Blending factors+  , BlendingFactor(..)+  ) where++import Graphics.Luminance.Core.Blending

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Buffer (+    -- * Buffer creation+    Buffer+  , bufferID+  , createBuffer+  , createBuffer_+    -- * Buffer access+  , BufferRW+    -- * Buffer regions+  , Region+  , BuildRegion+  , newRegion+    -- * Operations on buffer regions+  , readWhole+  , writeWhole+  , fill+  , (@?)+  , (@!)+  , writeAt+  , writeAt'+  ) where++import Graphics.Luminance.Core.Buffer

@@ -0,0 +1,20 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Cmd (+    -- * Command type+    Cmd+  , runCmd+    -- * Available commands+  , draw+  , blit+  ) where++import Graphics.Luminance.Core.Cmd

@@ -0,0 +1,103 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Batch where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.Bits+import Data.Foldable ( traverse_ )+import Foreign.Ptr ( nullPtr )+import Graphics.GL+import Graphics.Luminance.Core.Blending ( setBlending )+import Graphics.Luminance.Core.Framebuffer ( Framebuffer(..) )+import Graphics.Luminance.Core.Geometry ( Geometry(..), VertexArray(..) )+import Graphics.Luminance.Core.Shader.Program ( Program(..) )+import Graphics.Luminance.Core.RenderCmd ( RenderCmd(..) )+import Graphics.Luminance.Core.Shader.Uniform ( U(..) )++--------------------------------------------------------------------------------+-- Framebuffer batch -----------------------------------------------------------++-- |'Framebuffer' batch.+--+-- A 'FBBatch' is used to expose a 'Framebuffer' and share it between several shader program+-- batches.+data FBBatch rw c d = FBBatch {+    fbBatchFramebuffer :: Framebuffer rw c d+  , fbBatchSPBatch     :: [AnySPBatch rw c d]+  }++-- |Run a 'FBBatch'.+runFBBatch :: (MonadIO m) => FBBatch rw c d -> m ()+runFBBatch (FBBatch fb spbs) = do+  liftIO $ glBindFramebuffer GL_DRAW_FRAMEBUFFER (fromIntegral $ framebufferID fb)+  liftIO $ glClear $ GL_DEPTH_BUFFER_BIT .|. GL_COLOR_BUFFER_BIT+  traverse_ (\(AnySPBatch spb) -> runSPBatch spb) spbs++-- |Share a 'Framebuffer' between several shader program batches.+framebufferBatch :: Framebuffer rw c d -> [AnySPBatch rw c d] -> FBBatch rw c d+framebufferBatch = FBBatch++--------------------------------------------------------------------------------+-- Shader program batch --------------------------------------------------------++-- |Shader 'Program' batch.+--+-- Such a batch is used to share a 'Program' between several 'RenderCmd'. It also+-- gathers a uniform @'U' u@ and a 'u' value to send to the uniform.+--+-- The 'u' type can be used to send uniforms for the whole batch. It can be useful+-- for cold values – that won’t change very often for a given frame – like the resolution of the+-- screen, the mouse cursor coordinates, the time, and so on and so forth.+--+-- The 'v' type variable is used to add uniforms per-'RenderCmd'.+data SPBatch rw c d u v = SPBatch {+    spBatchShaderProgram :: Program+  , spBatchUniform       :: U u+  , spBatchUniformValue  :: u+  , spBatchGeometries    :: [RenderCmd rw c d v Geometry]+  }++-- |Abstract 'SPBatch' over uniform interface.+data AnySPBatch rw c d = forall u v. AnySPBatch (SPBatch rw c d u v)++-- FIXME: should we call this function 'abstractSPBatch'?+-- |Abstract 'SPBatch'.+anySPBatch :: SPBatch rw c d u v -> AnySPBatch rw c d+anySPBatch = AnySPBatch++-- Run a 'SPBatch' in 'MonadIO'.+runSPBatch :: (MonadIO m) => SPBatch rw c d u v -> m ()+runSPBatch (SPBatch prog uni u geometries) = do+  liftIO $ do+    glUseProgram (programID prog)+    runU uni u+  traverse_ drawGeometry geometries++-- |Create a new 'SPBatch'.+shaderProgramBatch :: Program -> U u -> u -> [RenderCmd rw c d v Geometry] -> SPBatch rw c d u v+shaderProgramBatch = SPBatch++--------------------------------------------------------------------------------+-- Geometry draw function ------------------------------------------------------++-- Draw the 'Geometry' held by a 'RenderCmd'.+drawGeometry :: (MonadIO m) => RenderCmd rw c d u Geometry -> m ()+drawGeometry (RenderCmd blending depthTest uni u geometry) = do+  setBlending blending+  (if depthTest then glEnable else glDisable) GL_DEPTH_TEST+  liftIO (runU uni u)+  case geometry of+    DirectGeometry (VertexArray vid mode vbNb) -> do+      glBindVertexArray vid+      glDrawArrays mode 0 vbNb+    IndexedGeometry (VertexArray vid mode ixNb) -> do+      glBindVertexArray vid+      glDrawElements mode ixNb GL_UNSIGNED_INT nullPtr

@@ -0,0 +1,111 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+--+-- That module exports blending-related types and functions.+--+-- Given two pixels @src@ and @dst@ – source and destination, we associate+-- each pixel a /blending factor/ – respectively, @srcK@ and @dstK@. @src@ is+-- the pixel being computed, and @dst@ is the pixel that is already stored in+-- the framebuffer.+--+-- The pixels can be blended in several ways. See the documentation of+-- 'BlendingMode' for further details.+--+-- The factors are encoded with 'BlendingFactor'.+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Blending where++import Control.Monad.IO.Class ( MonadIO(..) )+import Graphics.GL++-- |All different blending modes.+--+-- 'Additive' represents the following blending equation:+--+-- @blended = src * srcK + dst * dstK+--+-- 'Subtract' represents the following blending equation:+--+-- @blended = src * srcK - dst * dstK+--+-- Because subtracting is not commutating, 'ReverseSubtract' represents the following additional+-- blending equation:+--+-- @blended = dst * dstK - src * srcK@+--+-- 'Min' represents the following blending equation:+--+-- @blended = min src dst@+--+-- 'Max' represents the following blending equation:+--+-- @blended = max src dst@+data BlendingMode+  = Additive+  | Subtract+  | ReverseSubtract+  | Min+  | Max+    deriving (Eq,Show)++fromBlendingMode :: BlendingMode -> GLenum+fromBlendingMode m = case m of+  Additive        -> GL_FUNC_ADD+  Subtract        -> GL_FUNC_SUBTRACT+  ReverseSubtract -> GL_FUNC_REVERSE_SUBTRACT+  Min             -> GL_MIN+  Max             -> GL_MAX++-- |Blending factors.+data BlendingFactor+  = One+  | Zero+  | SrcColor+  | NegativeSrcColor+  | DestColor+  | NegativeDestColor+  | SrcAlpha+  | NegativeSrcAlpha+  | DstAlpha+  | NegativeDstAlpha+  -- | ConstantColor+  -- | NegativeConstantColor+  -- | ConstantAlpha+  -- | NegativeConstantAlpha+  | SrcAlphaSaturate+    deriving (Eq,Show)++fromBlendingFactor :: BlendingFactor -> GLenum+fromBlendingFactor f = case f of+  One                   -> GL_ONE+  Zero                  -> GL_ZERO+  SrcColor              -> GL_SRC_COLOR+  NegativeSrcColor      -> GL_ONE_MINUS_SRC_COLOR+  DestColor             -> GL_DST_COLOR+  NegativeDestColor     -> GL_ONE_MINUS_DST_COLOR+  SrcAlpha              -> GL_SRC_ALPHA+  NegativeSrcAlpha      -> GL_ONE_MINUS_SRC_ALPHA+  DstAlpha              -> GL_DST_ALPHA+  NegativeDstAlpha      -> GL_ONE_MINUS_DST_ALPHA+  -- ConstantColor         -> GL_CONSTANT_COLOR+  -- NegativeConstantColor -> GL_ONE_MINUS_CONSTANT_COLOR+  -- ConstantAlpha         -> GL_CONSTANT_ALPHA+  -- NegativeConstantAlpha -> GL_ONE_MINUS_CONSTANT_ALPHA+  SrcAlphaSaturate      -> GL_SRC_ALPHA_SATURATE++-- Sets blending mode and both factors after having initialized the blending if something is+-- passed. If 'Nothing', that function disables the blending.+setBlending :: (MonadIO m) => Maybe (BlendingMode,BlendingFactor,BlendingFactor) -> m ()+setBlending blending = liftIO $ case blending of+  Just (mode,src,dst) -> do+    glEnable GL_BLEND+    glBlendEquation (fromBlendingMode mode)+    glBlendFunc (fromBlendingFactor src) (fromBlendingFactor dst)+  Nothing -> glDisable GL_BLEND

@@ -0,0 +1,165 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Buffer where++import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.RWS ( RWS, ask, get, evalRWS, execRWS, put )+import Control.Monad.Trans.Resource ( MonadResource, register )+import Data.Bits ( (.|.) )+import Data.Foldable ( toList )+import Data.Word ( Word32 )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( peekArray, pokeArray )+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( Ptr, castPtr, nullPtr, plusPtr )+import Foreign.Storable ( Storable(..) )+import Graphics.GL+import Graphics.Luminance.Core.RW++-- |A 'Buffer' is an opaque and untyped region of abstract GPU memory. You cannot do much with it+-- and you might even not see the type in the user interface as it’s not really needed. It’s shown+-- for informational purposes only.+newtype Buffer = Buffer { bufferID :: GLuint } deriving (Eq,Show)++-- Create a new 'Buffer' and return its GPU address by mapping it to a @Ptr ()@.+mkBuffer :: (MonadIO m,MonadResource m)+         => GLbitfield+         -> Word32+         -> m (Buffer,Ptr ())+mkBuffer flags size = do+  (bid,mapped) <- liftIO . alloca $ \p -> do+    glCreateBuffers 1 p+    bid <- peek p+    mapped <- createStorage bid flags size+    pure (bid,mapped)+  _ <- register . with bid $ glDeleteBuffers 1+  pure (Buffer bid,mapped)++-- Create the required OpenGL storage for a 'Buffer'.+createStorage :: GLuint -> GLbitfield -> Word32 -> IO (Ptr ())+createStorage bid flags size = do+    glNamedBufferStorage bid bytes nullPtr flags+    ptr <- glMapNamedBufferRange bid 0 bytes flags+    pure ptr+  where+    bytes = fromIntegral size++-- |Create a new 'Buffer' using regions through the 'BuildRegion' monadic type. The 'Buffer' is+-- returned as well as the computed 'a' value  in the 'BuildRegion'.+--+-- Typically, the user will wrap the 'Region' in the 'a' type.+mkBufferWithRegions :: (MonadIO m,MonadResource m)+                    => GLbitfield+                    -> BuildRegion rw a+                    -> m (a,Buffer)+mkBufferWithRegions flags buildRegions = do+    (buffer,mapped) <- mkBuffer flags bytes+    pure (fst $ evalRWS built mapped 0,buffer)+  where+    built = runBuildRegion buildRegions+    (bytes,_) = execRWS built nullPtr 0++-- |'Buffer'’s 'Region's can have reads and writes. That typeclass makes implements all possible+-- cases.+class BufferRW rw where+  bufferFlagsFromRW :: rw -> GLenum++instance BufferRW R where+  bufferFlagsFromRW _ = GL_MAP_READ_BIT++instance BufferRW RW where+  bufferFlagsFromRW _ = GL_MAP_READ_BIT .|. GL_MAP_WRITE_BIT++instance BufferRW W where+  bufferFlagsFromRW _ = GL_MAP_WRITE_BIT++-- |Create a new 'Buffer' and expose 'Region's. Through the 'BuildRegion' type, you can yield new+-- regions and embed them in the type of your choice. The function returns that type.+createBuffer :: forall a m rw. (BufferRW rw,MonadIO m,MonadResource m)+             => BuildRegion rw a+             -> m a+createBuffer = fmap fst . mkBufferWithRegions (bufferFlagsFromRW (undefined :: rw) .|. GL_MAP_PERSISTENT_BIT .|. GL_MAP_COHERENT_BIT)++-- Special case of 'createBuffer', returning the 'Buffer' in addition for internal uses.+createBuffer_ :: forall a m rw. (BufferRW rw,MonadIO m,MonadResource m)+              => BuildRegion rw a+              -> m (a,Buffer)+createBuffer_ = mkBufferWithRegions $+  bufferFlagsFromRW (undefined :: rw) .|. GL_MAP_PERSISTENT_BIT .|. GL_MAP_COHERENT_BIT++-- |A 'Region' is a GPU typed memory area. It can be pictured as a GPU array.+data Region rw a = Region {+    regionPtr :: Ptr a+  , regionSize :: RegionSize a+  } deriving (Eq,Show)++-- FIXME: do we really need that?!+-- |Size of a region, in elements. You don’t have to worry about bytes consideration. If you want+-- a @Region rw Float@ with 10 elements in it, use @RegionSize 10@. That’s as simple as that.+newtype RegionSize a = RegionSize Word32 deriving (Eq,Num,Show)++-- Get the size in bytes of a 'RegionSize'.+bytesOfR :: forall a. (Storable a) => RegionSize a -> Word32+bytesOfR (RegionSize size) = fromIntegral (sizeOf (undefined :: a)) * size++-- |Convenient type to build 'Region's.+newtype BuildRegion rw a = BuildRegion {+    runBuildRegion :: RWS (Ptr ()) () Word32 a+  } deriving (Applicative,Functor,Monad)++-- |Create a new 'Region' by providing the number of wished elements.+newRegion :: forall rw a. (Storable a) => Word32 -> BuildRegion rw (Region rw a)+newRegion size = BuildRegion $ do+    offset <- get+    put $ offset + bytesOfR regionS+    ptr <- ask+    pure $ Region (castPtr $ ptr `plusPtr` fromIntegral offset) regionS+  where+    regionS :: RegionSize a+    regionS = RegionSize size++-- |Read a whole 'Region'.+readWhole :: (MonadIO m,Readable r,Storable a) => Region r a -> m [a]+readWhole (Region p (RegionSize nb)) = liftIO $ peekArray (fromIntegral nb) p++-- |Write the whole 'Region'. If value are missing, only the provided values will replace the+-- existing ones. If there are more values than the size of the 'Region', they are ignored.+writeWhole :: (Foldable f,MonadIO m,Storable a,Writable w)+           => Region w a+           -> f a+           -> m ()+writeWhole (Region p (RegionSize nb)) values =+  liftIO . pokeArray p . take (fromIntegral nb) $ toList values++-- |Fill a 'Region' with a value.+fill :: (MonadIO m,Storable a,Writable w) => Region w a -> a -> m ()+fill (Region p (RegionSize nb)) a =+  liftIO . pokeArray p $ replicate (fromIntegral nb) a++-- |Index getter. Bounds checking is performed and returns 'Nothing' if out of bounds.+(@?) :: (MonadIO m,Storable a,Readable r) => Region r a -> Word32 -> m (Maybe a)+Region p (RegionSize nb) @? i+  | i >= nb = pure Nothing+  | otherwise = liftIO $ Just <$> peekElemOff p (fromIntegral i)++-- |Index getter. Unsafe version of '(@?)'.+(@!) :: (MonadIO m,Storable a,Readable r) => Region r a -> Word32 -> m a+Region p _ @! i = liftIO $ peekElemOff p (fromIntegral i)++-- |Index setter. Bounds checking is performed and nothing is done if out of bounds.+writeAt :: (MonadIO m,Storable a,Writable w) => Region w a -> Word32 -> a -> m ()+writeAt (Region p (RegionSize nb)) i a+  | i >= nb = pure ()+  | otherwise = liftIO $ pokeElemOff p (fromIntegral i) a++-- |Index setter. Unsafe version of 'writeAt''.+writeAt' :: (MonadIO m,Storable a,Writable w) => Region w a -> Word32 -> a -> m ()+writeAt' (Region p _) i a = liftIO $ pokeElemOff p (fromIntegral i) a

@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Cmd where++import Control.Monad.IO.Class ( MonadIO(..) )+import Graphics.Luminance.Core.Batch+import Graphics.Luminance.Core.Framebuffer+import Graphics.Luminance.Core.RW ( Readable, Writable )+import Graphics.Luminance.Core.Texture ( Filter )+import Numeric.Natural ( Natural )++-- |Command type. Used to accumulate GPU commands. Use 'runCmd' to execute+-- the whole chain of commands.+newtype Cmd a = Cmd (IO a) deriving (Applicative,Functor,Monad)++runCmd :: (MonadIO m) => Cmd a -> m a+runCmd (Cmd a) = liftIO a++-- |Draw a framebuffer batch and return the framebuffer’s output.+draw :: FBBatch rw c d -> Cmd (Output c d)+draw fbb = Cmd $ do+  runFBBatch fbb+  pure . framebufferOutput $ fbBatchFramebuffer fbb++-- |Blit a framebuffer batch onto a framebuffer and return the framebuffer’s output of the write+-- framebuffer.+blit :: (Readable r,Writable w)+     => Framebuffer r c0 d0+     -> Framebuffer w c1 d1+     -> Int+     -> Int+     -> Natural+     -> Natural+     -> Int+     -> Int+     -> Natural+     -> Natural+     -> FramebufferBlitMask+     -> Filter+     -> Cmd (Output c1 d1)+blit r w rx ry rwidth rheight wx wy wwidth wheight mask flt = Cmd $ do+  framebufferBlit r w rx ry rwidth rheight wx wy wwidth wheight mask flt+  pure (framebufferOutput w)

@@ -0,0 +1,81 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Debug where++import Control.Monad ( unless )+import Control.Monad.IO.Class ( MonadIO(..) )+#if DEBUG_GL+import Data.Foldable ( traverse_ )+#endif+import Graphics.GL++--------------------------------------------------------------------------------+-- Clearing errors -------------------------------------------------------------++-- Clear OpenGL errors until we get GL_NO_ERROR.+clearGLError :: (MonadIO m) => m ()+clearGLError = do+  e <- liftIO glGetError+  unless (e == GL_NO_ERROR) clearGLError++--------------------------------------------------------------------------------+-- OpenGL errors ---------------------------------------------------------------++-- |OpenGL error type.+data GLError+  = InvalidEnum+  | InvalidValue+  | InvalidOperation+  | InvalidFramebufferOperation+  | OutOfMemory+  | StackUnderflow+  | StackOverflow+    deriving (Eq,Show)++fromGLError :: GLError -> GLenum+fromGLError e = case e of+  InvalidEnum                 -> GL_INVALID_ENUM+  InvalidValue                -> GL_INVALID_VALUE+  InvalidOperation            -> GL_INVALID_OPERATION+  InvalidFramebufferOperation -> GL_INVALID_FRAMEBUFFER_OPERATION+  OutOfMemory                 -> GL_OUT_OF_MEMORY+  StackUnderflow              -> GL_STACK_UNDERFLOW+  StackOverflow               -> GL_STACK_OVERFLOW++toGLError :: GLenum -> Maybe GLError+toGLError e = case e of+  GL_INVALID_ENUM                  -> Just InvalidEnum+  GL_INVALID_VALUE                 -> Just InvalidValue+  GL_INVALID_OPERATION             -> Just InvalidOperation+  GL_INVALID_FRAMEBUFFER_OPERATION -> Just InvalidFramebufferOperation+  GL_OUT_OF_MEMORY                 -> Just OutOfMemory+  GL_STACK_UNDERFLOW               -> Just StackUnderflow+  GL_STACK_OVERFLOW                -> Just StackOverflow+  _                                -> Nothing++-- |Given a context 'String' and an action, that function clears the OpenGL errors in order to run+-- the action in a sane and error-free OpenGL context. If an error has occured, print it on 'stderr'+-- along with the 'String' context. Otherwise, simply it returns the action’s result.+--+-- Keep in mind that you can mute that function’s implementation by disabling the cabal flag+-- 'debug-gl', which is the default setting.+debugGL :: (MonadIO m) => String -> m a -> m a+#if DEBUG_GL+debugGL ctx gl = do+  clearGLError+  a <- gl+  liftIO $ fmap toGLError glGetError >>= traverse_ (\e -> putStrLn ctx >> print e)+  pure a+#else+debugGL _ = id+#endif

@@ -0,0 +1,309 @@+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Framebuffer where++import Control.Monad ( unless )+import Control.Monad.Except ( MonadError(..) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Trans.Resource ( MonadResource, register )+import Data.Bits ( (.|.) )+import Data.Proxy ( Proxy(..) )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( withArrayLen )+import Foreign.Marshal.Utils ( with )+import Foreign.Storable ( peek )+import Graphics.GL+import Graphics.Luminance.Core.Debug+import Graphics.Luminance.Core.Pixel+import Graphics.Luminance.Core.Renderbuffer ( createRenderbuffer, renderbufferID )+import Graphics.Luminance.Core.RW+import Graphics.Luminance.Core.Texture+import Graphics.Luminance.Core.Tuple+import Numeric.Natural ( Natural )++---------------------------------------------------------------------------------+-- Framebuffer ------------------------------------------------------------------++-- |A 'Framebuffer' represents two buffers: a /color/ buffer and /depth/ buffer.+-- You can select which one you want and specify the formats to use by providing 'Pixel'+-- types. If you want to mute a buffer, use '()'.+data Framebuffer rw c d = Framebuffer {+    framebufferID :: GLuint+  , framebufferOutput :: Output c d+  }++-- |A 'Framebuffer' with the /depth/ buffer muted.+type ColorFramebuffer rw c = Framebuffer rw c ()++-- |A 'Framebuffer' with the /color/ buffer muted. Can be used to implement fast pre-passes.+type DepthFramebuffer rw d = Framebuffer rw () d++-- |@'createFramebuffer' w h mipmaps@ creates a new 'Framebuffer' with dimension @w * h@ and+-- allocating spaces for @mipmaps@ level of textures. The textures are created by providing a+-- correct type.+--+-- For the color part, you can pass either:+--+-- - '()': that will mute the color buffer of the framebuffer;+-- - @'Format' t c@: that will create a single texture with the wished color format;+-- - or @a ':.' b@: that will create a chain of textures; 'a' and 'b' cannot be '()'.+--+-- For the depth part, you can pass either:+--+-- - '()': that will mute the depth buffer of the framebuffer;+-- - @'Format' t c@: that will create a single texture with the wished depth format.+--+-- Finally, the @rw@ parameter can be set to 'R', 'W' or 'RW' to specify which kind of framebuffer+-- access you’ll need.+createFramebuffer :: forall c d e m rw. (HasFramebufferError e,MonadError e m,MonadIO m,MonadResource m,FramebufferColorAttachment c,FramebufferColorRW rw,FramebufferDepthAttachment d,FramebufferTarget rw)+                  => Natural+                  -> Natural+                  -> Natural+                  -> m (Framebuffer rw c d)+createFramebuffer w h mipmaps = do+  fid <- liftIO . alloca $ \p -> do+    debugGL "createFramebuffer" $ glCreateFramebuffers 1 p+    peek p+  (colorOutputNb,colorTexs) <- addColorOutput fid 0 w h mipmaps (Proxy :: Proxy c)+  (hasDepthOutput,depthTex) <- addDepthOutput fid w h mipmaps (Proxy :: Proxy d)+  setColorBuffers fid colorOutputNb (Proxy :: Proxy rw)+  unless hasDepthOutput $ setDepthRenderbuffer fid w h+  _ <- register . with fid $ glDeleteFramebuffers 1+  status <- glCheckNamedFramebufferStatus fid $ framebufferTarget (Proxy :: Proxy rw)+  if +    | status == GL_FRAMEBUFFER_COMPLETE -> pure $ Framebuffer fid (Output colorTexs depthTex)+    | otherwise -> throwError . fromFramebufferError . IncompleteFramebuffer $ translateFramebufferStatus status++-- Translate OpenGL framebuffer status into human readable versions.+translateFramebufferStatus :: GLenum -> String+translateFramebufferStatus status = case status of+  GL_FRAMEBUFFER_UNDEFINED                     -> "undefined default read or write framebuffer"+  GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT         -> "incomplete attachment"+  GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT -> "missing image attachment"+  GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER        -> "incomplete draw buffer"+  GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER        -> "incomplete read buffer"+  GL_FRAMEBUFFER_UNSUPPORTED                   -> "unsupported (internal) format(s)"+  GL_FRAMEBUFFER_INCOMPLETE_MULTISAMPLE        -> "incomplete multisample configuration"+  GL_FRAMEBUFFER_INCOMPLETE_LAYER_TARGETS      -> "layered attachment mismatch"+  _                                            -> "unknown error"++--------------------------------------------------------------------------------+-- Framebuffer attachment ------------------------------------------------------++-- Framebuffer attachment.+data Attachment+  = ColorAttachment Natural+  | DepthAttachment+  deriving (Eq,Ord,Show)++fromAttachment :: (Eq a,Num a) => Attachment -> a+fromAttachment a = case a of+  ColorAttachment i -> GL_COLOR_ATTACHMENT0 + fromIntegral i+  DepthAttachment   -> GL_DEPTH_ATTACHMENT++--------------------------------------------------------------------------------+-- Framebuffer color attachment ------------------------------------------------++-- |Typeclass of possible framebuffer color attachments.+class FramebufferColorAttachment c where+  addColorOutput :: (MonadIO m,MonadResource m)+                 => GLuint+                 -> Natural+                 -> Natural+                 -> Natural+                 -> Natural+                 -> proxy c+                 -> m (Natural,TexturizeFormat c)++instance FramebufferColorAttachment () where+  addColorOutput _ _ _ _ _ _ = pure (0,())++instance (ColorPixel (Format t c)) => FramebufferColorAttachment (Format t c) where+  addColorOutput fid ca w h mipmaps proxy =+    fmap (1,) $ addOutput fid (ColorAttachment ca) w h mipmaps proxy++instance (ColorPixel a,ColorPixel b,FramebufferColorAttachment a,FramebufferColorAttachment b) => FramebufferColorAttachment (a :. b) where+  addColorOutput fid ca w h mipmaps _ = do+    (d0,tex0) <- addColorOutput fid ca w h mipmaps (Proxy :: Proxy a)+    (d1,tex1) <- addColorOutput fid (succ ca) w h mipmaps (Proxy :: Proxy b)+    pure $ (d0 + d1,tex0 :. tex1)++-- Given the maximum number of attachments in a color attachment, retrieve the list of OpenGL+-- enumerations to represent all the color buffers.+colorAttachmentsFromMax :: Natural -> [GLenum]+colorAttachmentsFromMax m = [fromAttachment (ColorAttachment a) | a <- [0..m-1]]++-- Set the OpenGL color buffers.+setColorBuffers :: forall m proxy rw. (FramebufferColorRW rw,MonadIO m)+                => GLuint +                -> Natural+                -> proxy rw+                -> m ()+setColorBuffers fid colorOutputNb _ = case colorOutputNb of+  0 -> do+    -- disable color outputs+    debugGL "setColorBuffers 1" $ glNamedFramebufferDrawBuffer fid GL_NONE+    debugGL "setColorBuffers 2" $ glNamedFramebufferReadBuffer fid GL_NONE+  _ -> setFramebufferColorRW fid colorOutputNb (Proxy :: Proxy rw)++--------------------------------------------------------------------------------+-- Framebuffer depth attachment ------------------------------------------------++-- |Typeclass of possible framebuffer depth attachments.+class FramebufferDepthAttachment d where+  addDepthOutput :: (MonadIO m,MonadResource m)+                 => GLuint+                 -> Natural+                 -> Natural+                 -> Natural+                 -> proxy d+                 -> m (Bool,TexturizeFormat d)++instance FramebufferDepthAttachment () where+  addDepthOutput _ _ _ _ _ = pure (False,())++instance (Pixel (Format t (CDepth d))) => FramebufferDepthAttachment (Format t (CDepth d)) where+  addDepthOutput fid w h mipmaps proxy = fmap (True,) $ addOutput fid DepthAttachment w h mipmaps proxy++-- Create a renderbuffer used to mute depth information and link it to a framebuffer.+setDepthRenderbuffer :: (MonadIO m,MonadResource m)+                     => GLuint+                     -> Natural+                     -> Natural+                     -> m ()+setDepthRenderbuffer fid w h = do+  renderbuffer <- createRenderbuffer w h (Proxy :: Proxy Depth32F)+  debugGL "setDepthRenderBuffer" $ glNamedFramebufferRenderbuffer fid (fromAttachment DepthAttachment) GL_RENDERBUFFER+    (renderbufferID renderbuffer)++--------------------------------------------------------------------------------+-- Framebuffer color read/write configuration ----------------------------------++-- |Typeclass used to implement read/write operation per color attachment.+class FramebufferColorRW rw where+  setFramebufferColorRW :: (MonadIO m) => GLuint -> Natural -> proxy rw -> m ()++instance FramebufferColorRW W where+  setFramebufferColorRW fid nb _ = liftIO $ do+    withArrayLen (colorAttachmentsFromMax nb) $ \n buffers ->+      debugGL "setFramebufferColorRW[W]" $ glNamedFramebufferDrawBuffers fid (fromIntegral n) buffers++instance FramebufferColorRW RW where+  setFramebufferColorRW fid nb _ = liftIO $ do+    withArrayLen (colorAttachmentsFromMax nb) $ \n buffers ->+      debugGL "setFramebufferColorRW[RW]" $ glNamedFramebufferDrawBuffers fid (fromIntegral n) buffers++--------------------------------------------------------------------------------+-- Framebuffer read/write target configuration ---------------------------------++-- |Framebuffer representation of 'R', 'W' and 'RW'.+class FramebufferTarget rw where+  framebufferTarget :: proxy rw -> GLenum++instance FramebufferTarget R where+  framebufferTarget _ = GL_READ_FRAMEBUFFER++instance FramebufferTarget W where+  framebufferTarget _ = GL_DRAW_FRAMEBUFFER++instance FramebufferTarget RW where+  framebufferTarget _ = GL_FRAMEBUFFER++--------------------------------------------------------------------------------+-- Framebuffer outputs ---------------------------------------------------------++-- Create a new texture and link it to the framebuffer.+addOutput :: forall m p proxy. (MonadIO m,MonadResource m,Pixel p)+          => GLuint+          -> Attachment+          -> Natural+          -> Natural+          -> Natural+          -> proxy p+          -> m (Texture2D p)+addOutput fid ca w h mipmaps _ = do+  tex :: Texture2D p <- createTexture w h mipmaps defaultSampling+  debugGL "addOutput" . liftIO $ glNamedFramebufferTexture fid (fromAttachment ca)+    (textureID tex) 0+  pure tex++--------------------------------------------------------------------------------+-- Framebuffer textures accessors ----------------------------------------------++-- |Given a 'Format', inject it into a 'Texture2D' to handle it.+type family TexturizeFormat a :: * where+  TexturizeFormat ()           = ()+  TexturizeFormat (Format t c) = Texture2D (Format t c)+  TexturizeFormat (a :. b)     = TexturizeFormat a :. TexturizeFormat b++-- |Framebuffer output.+data Output c d = Output (TexturizeFormat c) (TexturizeFormat d)++--------------------------------------------------------------------------------+-- Framebuffer blitting --------------------------------------------------------++-- |Mask for framebuffer blit operation.+data FramebufferBlitMask+  = BlitColor+  | BlitDepth+  | BlitBoth+    deriving (Eq,Show)++fromFramebufferBlitMask :: FramebufferBlitMask -> GLbitfield+fromFramebufferBlitMask mask = case mask of+  BlitColor -> GL_COLOR_BUFFER_BIT+  BlitDepth -> GL_DEPTH_BUFFER_BIT+  BlitBoth  -> GL_COLOR_BUFFER_BIT .|. GL_DEPTH_BUFFER_BIT++-- Blit two framebuffers.+framebufferBlit :: (MonadIO m,Readable r,Writable w)+                => Framebuffer r c d+                -> Framebuffer w c' d'+                -> Int+                -> Int+                -> Natural+                -> Natural+                -> Int+                -> Int+                -> Natural+                -> Natural+                -> FramebufferBlitMask+                -> Filter+                -> m ()+framebufferBlit src dst srcX srcY srcW srcH dstX dstY dstW dstH mask flt = liftIO . debugGL "blit" $+    glBlitNamedFramebuffer (framebufferID src) (framebufferID dst) srcX0 srcY0 srcX1 srcY1 dstX0+      dstY0 dstX1 dstY1 (fromFramebufferBlitMask mask) (fromFilter flt)+  where+    srcX0 = fromIntegral srcX+    srcY0 = fromIntegral srcY+    srcX1 = srcX0 + fromIntegral srcW+    srcY1 = srcY0 + fromIntegral srcH+    dstX0 = fromIntegral dstX+    dstY0 = fromIntegral dstY+    dstX1 = dstX0 + fromIntegral dstW+    dstY1 = dstY0 + fromIntegral dstH++--------------------------------------------------------------------------------+-- Special framebuffers --------------------------------------------------------++-- |The default 'Framebuffer' represents the screen (back buffer with double buffering).+defaultFramebuffer :: Framebuffer RW () ()+defaultFramebuffer = Framebuffer 0 (Output () ())++---------------------------------------------------------------------------------+-- Framebuffer errors -----------------------------------------------------------++newtype FramebufferError = IncompleteFramebuffer String deriving (Eq,Show)++class HasFramebufferError a where+  fromFramebufferError :: FramebufferError -> a

@@ -0,0 +1,97 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Geometry where++import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Trans.Resource ( MonadResource, register )+import Data.Proxy ( Proxy(..) )+import Data.Word ( Word32 )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Utils ( with )+import Foreign.Storable ( Storable(..) )+import Graphics.GL+import Graphics.Luminance.Core.Buffer+import Graphics.Luminance.Core.RW ( W )+import Graphics.Luminance.Core.Vertex++-- OpenGL vertex array. Used as a shared type for embedding in most complex 'Geometry' type.+data VertexArray = VertexArray {+    vertexArrayID :: GLuint+  , vertexArrayMode :: GLenum+  , vertexArrayCount :: GLsizei+  } deriving (Eq,Show)+  +-- |A 'Geometry' represents a GPU version of a mesh; that is, vertices attached with indices and a+-- geometry mode. You can have 'Geometry' in two flavours:+--+-- - *direct geometry*: doesn’t require any indices as all vertices are unique and in the right+--   order to connect vertices between each other ;+-- - *indexed geometry*: requires indices to know how to connect and share vertices between each+--   other.+data Geometry+  = DirectGeometry VertexArray+  | IndexedGeometry VertexArray+    deriving (Eq,Show)++-- |The 'GeometryMode' is used to specify how vertices should be connected between each other.+--+-- A 'Point' mode won’t connect vertices at all and will leave them as a vertices cloud.+--+-- A 'Line' mode will connect vertices two-by-two. You then have to provide pairs of indices to+-- correctly connect vertices and form lines.+--+-- A 'Triangle' mode will connect vertices three-by-three. You then have to provide triplets of+-- indices to correctly connect vertices and form triangles.+data GeometryMode+  = Point+  | Line+  | Triangle+    deriving (Eq,Show)++fromGeometryMode :: GeometryMode -> GLenum+fromGeometryMode m = case m of+  Point    -> GL_POINTS+  Line     -> GL_LINES+  Triangle -> GL_TRIANGLES++-- |This function is the single one to create 'Geometry'. It takes a 'Foldable' type of vertices+-- used to provide the 'Geometry' with vertices and might take a 'Foldable' of indices ('Word32').+-- If you don’t pass indices ('Nothing'), you end up with a *direct geometry*. Otherwise, you get an+-- *indexed geometry*. You also have to provide a 'GeometryMode' to state how you want the vertices+-- to be connected with each other.+createGeometry :: forall f m v. (Foldable f,MonadIO m,MonadResource m,Storable v,Vertex v)+               => f v+               -> Maybe (f Word32)+               -> GeometryMode+               -> m Geometry+createGeometry vertices indices mode = do+    -- create the vertex array object (OpenGL-side)+    vid <- liftIO . alloca $ \p -> do+      glCreateVertexArrays 1 p+      peek p+    _ <- register . with vid $ glDeleteVertexArrays 1+    -- vertex buffer+    (vreg :: Region W v,vbo) <- createBuffer_ $ newRegion (fromIntegral vertNb)+    writeWhole vreg vertices+    liftIO $ glVertexArrayVertexBuffer vid vertexBindingIndex (bufferID vbo) 0 (fromIntegral $ sizeOf (undefined :: v))+    setFormatV vid 0 (Proxy :: Proxy v)+    -- element buffer, if required+    case indices of+      Just indices' -> do+        (ireg :: Region W Word32,ibo) <- createBuffer_ $ newRegion (fromIntegral ixNb)+        writeWhole ireg indices'+        glVertexArrayElementBuffer vid (bufferID ibo)+        pure . IndexedGeometry $ VertexArray vid mode' (fromIntegral ixNb)+      Nothing -> pure . DirectGeometry $ VertexArray vid mode' (fromIntegral vertNb)+  where+    vertNb = length vertices+    ixNb   = length indices+    mode'  = fromGeometryMode mode

@@ -0,0 +1,151 @@+{-# LANGUAGE UndecidableInstances #-}++-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++-- FIXME: #13+module Graphics.Luminance.Core.Pixel where++import Data.Proxy ( Proxy(..) )+import Data.Word ( Word8 )+import Graphics.GL++--------------------------------------------------------------------------------+-- Channel size ----------------------------------------------------------------++class ChannelSize c where+  channelSize :: (Num size) => proxy c -> size++-- |A 8-bit channel.+data C8 = C8 deriving (Eq,Ord,Show)++instance ChannelSize C8 where+  channelSize _ = 8++-- |A 16-bit channel.+data C16 = C16 deriving (Eq,Ord,Show)++instance ChannelSize C16 where+  channelSize _ = 16++-- |A 32-bit channel.+data C32 = C32 deriving (Eq,Ord,Show)++instance ChannelSize C32 where+  channelSize _ = 32++--------------------------------------------------------------------------------+-- Channel type ----------------------------------------------------------------++class ChannelType t where+  channelType :: proxy t -> GLenum++-- |Channels are integral values.+data CInts = CInts deriving (Eq,Ord,Show)++instance ChannelType CInts where+  channelType _ = GL_INT++-- |Channels are unsigned integral values.+data CUInts = CUInts deriving (Eq,Ord,Show)++instance ChannelType CUInts where+  channelType _ = GL_UNSIGNED_INT++-- |Channels are floating values.+data CFloats = CFloats deriving (Eq,Ord,Show)++instance ChannelType CFloats where+  channelType _ = GL_FLOAT++--------------------------------------------------------------------------------+-- Channel shape ---------------------------------------------------------------++-- |A red channel only.+data CR a = CR deriving (Eq,Ord,Show)++-- |Rd and green channels.+data CRG a b = CRG deriving (Eq,Ord,Show)++-- |Red, green and blue channels.+data CRGB a b c = CRGB deriving (Eq,Ord,Show)++-- |Red, green, blue and alpha channels.+data CRGBA a b c d = CRGBA deriving (Eq,Ord,Show)++-- |A depth channel.+data CDepth a = CDepth deriving (Eq,Ord,Show)++--------------------------------------------------------------------------------+-- Pixel format ----------------------------------------------------------------++-- |A pixel format.+data Format t c = Format deriving (Eq,Ord,Show)++instance (ChannelType t) => ChannelType (Format t c) where+  channelType _ = channelType (Proxy :: Proxy t)++type RGB8UI   = Format CUInts  (CRGB C8 C8 C8)+type RGBA8UI  = Format CUInts  (CRGBA C8 C8 C8 C8)++type RGBA8F   = Format CFloats (CRGBA C8 C8 C8 C8)++type RGB32F   = Format CFloats (CRGB C32 C32 C32)+type RGBA32F  = Format CFloats (CRGBA C32 C32 C32 C32)+type Depth32F = Format CFloats (CDepth C32)++--------------------------------------------------------------------------------+-- OpenGL pixels ---------------------------------------------------------------++class Pixel f where+  type PixelBase f :: *+  pixelFormat  :: p f -> GLenum+  pixelIFormat :: p f -> GLenum+  pixelType    :: p f -> GLenum++instance Pixel RGB8UI where+  type PixelBase RGB8UI = Word8+  pixelFormat  _ = GL_RGB_INTEGER+  pixelIFormat _ = GL_RGB8UI+  pixelType    _ = GL_UNSIGNED_BYTE++instance Pixel RGBA8UI where+  type PixelBase RGBA8UI = Word8+  pixelFormat  _ = GL_RGBA_INTEGER+  pixelIFormat _ = GL_RGBA8UI+  pixelType    _ = GL_UNSIGNED_BYTE++instance Pixel RGB32F where+  type PixelBase RGB32F = Float+  pixelFormat  _ = GL_RGB+  pixelIFormat _ = GL_RGB32F+  pixelType    _ = GL_FLOAT++instance Pixel RGBA32F where+  type PixelBase RGBA32F = Float+  pixelFormat  _ = GL_RGBA+  pixelIFormat _ = GL_RGBA32F+  pixelType    _ = GL_FLOAT++instance Pixel Depth32F where+  type PixelBase Depth32F = Float+  pixelFormat  _ = GL_DEPTH_COMPONENT+  pixelIFormat _ = GL_DEPTH_COMPONENT32F+  pixelType    _ = GL_FLOAT++--------------------------------------------------------------------------------+-- Pixel kind ------------------------------------------------------------------++class (Pixel p) => ColorPixel p++instance (Pixel (Format t (CR r))) => ColorPixel (Format t (CR r))+instance (Pixel (Format t (CRG r g))) => ColorPixel (Format t (CRG r g))+instance (Pixel (Format t (CRGB r g b))) => ColorPixel (Format t (CRGB r g b))+instance (Pixel (Format t (CRGBA r g b a))) => ColorPixel (Format t (CRGBA r g b a))

@@ -0,0 +1,46 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Query where++import Control.Monad ( (>=>) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Data.Traversable ( for )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Storable ( peek )+import Foreign.C.String ( peekCString )+import Foreign.Ptr ( castPtr )+import Graphics.GL++-- Nicer version of 'glGetString'.+getString :: (MonadIO m) => GLenum -> m String+getString name = liftIO $ glGetString name >>= peekCString . castPtr++-- |Get the OpenGL vendor 'String'.+getGLVendor :: (MonadIO m) => m String+getGLVendor = getString GL_VENDOR++-- |Get the OpenGL renderer 'String'.+getGLRenderer :: (MonadIO m) => m String+getGLRenderer = getString GL_RENDERER++-- |Get the OpenGL version 'String'.+getGLVersion :: (MonadIO m) => m String+getGLVersion = getString GL_VERSION++-- |Get the GLSL version 'String'.+getGLSLVersion :: (MonadIO m) => m String+getGLSLVersion = getString GL_SHADING_LANGUAGE_VERSION++-- |Retrieve all the supported OpenGL extensions as 'String's.+getGLExtensions :: (MonadIO m) => m [String]+getGLExtensions = liftIO $ do+  num <- alloca $ \num -> glGetIntegerv GL_NUM_EXTENSIONS num >> peek num+  for [0..fromIntegral num - 1] $ glGetStringi GL_EXTENSIONS  >=> peekCString . castPtr

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.RW where++-- |Readable typeclass, for types that admit reads.+class Readable r where++-- |Writable typeclass, for types that admit writes.+class Writable w where++-- |Read-only type.+data R  = R deriving (Eq,Ord,Show)++instance Readable R++-- |Write-only type.+data W  = W deriving (Eq,Ord,Show)++instance Writable W++-- |Read-write type.+data RW = RW deriving (Eq,Ord,Show)++instance Readable RW+instance Writable RW

@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.RenderCmd where++import Graphics.Luminance.Core.Blending+import Graphics.Luminance.Core.Shader.Uniform ( U(..) )++-- FIXME: we need to make a tighter link between c and blending and between d and the depth test.+data RenderCmd rw c d u a = RenderCmd (Maybe (BlendingMode,BlendingFactor,BlendingFactor)) Bool (U u) u a++instance Functor (RenderCmd rw c d u) where+  fmap f (RenderCmd blending depthTest uni u a) = RenderCmd blending depthTest uni u (f a)++renderCmd :: Maybe (BlendingMode,BlendingFactor,BlendingFactor)+          -> Bool+          -> U u+          -> u +          -> a +          -> RenderCmd rw c d u a+renderCmd = RenderCmd++stdRenderCmd :: U u -> u -> a -> RenderCmd rw c d u a+stdRenderCmd = RenderCmd Nothing True

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Renderbuffer where++import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Trans.Resource ( MonadResource, register )+import Data.Proxy ( Proxy )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Utils ( with )+import Foreign.Storable ( peek )+import Graphics.GL+import Graphics.Luminance.Core.Pixel ( Pixel(pixelIFormat) )+import Numeric.Natural ( Natural )++newtype Renderbuffer = Renderbuffer { renderbufferID :: GLuint } deriving (Eq,Show)++createRenderbuffer :: (MonadIO m,MonadResource m,Pixel f) => Natural -> Natural -> Proxy f -> m Renderbuffer+createRenderbuffer w h depthProxy = do+  rid <- liftIO . alloca $ \p -> do+    glCreateRenderbuffers 1 p+    rid <- peek p+    glNamedRenderbufferStorage rid (pixelIFormat depthProxy) (fromIntegral w) (fromIntegral h)+    pure rid+  _ <- register . with rid $ glDeleteRenderbuffers 1+  pure $ Renderbuffer rid

@@ -0,0 +1,127 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Core.Shader.Program where++import Control.Applicative ( liftA2 )+import Control.Monad.Except ( MonadError(throwError) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Trans.Resource ( MonadResource, register )+import Data.Foldable ( traverse_ )+import Foreign.C ( peekCString, withCString )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( allocaArray )+import Foreign.Ptr ( castPtr, nullPtr )+import Foreign.Storable ( peek )+import Graphics.Luminance.Core.Shader.Stage ( Stage(..) )+import Graphics.Luminance.Core.Shader.Uniform ( U, Uniform(..) )+import Graphics.GL+import Numeric.Natural ( Natural )++--------------------------------------------------------------------------------+-- Shader program --------------------------------------------------------------++-- |Shader program.+newtype Program = Program { programID :: GLuint }++-- |Create a new shader 'Program'.+--+-- That function takes a list of 'Stage's and a uniform interface builder function and yields a+-- 'Program' and the interface.+--+-- The builder function takes a function you can use to retrieve uniforms. You can pass+-- 'Left name' to map a 'String' to a uniform or you can pass 'Right sem' to map a semantic+-- 'Natural' to a uniform. If the uniform can’t be retrieved, throws 'InactiveUniform'.+--+-- In the end, you get the new 'Program' and a polymorphic value you can choose the type of in+-- the function you pass as argument. You can use that value to gather uniforms for instance.+createProgram :: (HasProgramError e,MonadError e m,MonadIO m,MonadResource m)+              => [Stage]+              -> ((forall a. (Uniform a) => Either String Natural -> m (U a)) -> m i)+              -> m (Program,i)+createProgram stages buildIface = do+  (pid,linked,cl) <- liftIO $ do+    pid <- glCreateProgram+    traverse_ (glAttachShader pid . stageID) stages+    glLinkProgram pid+    linked <- isLinked pid+    ll <- clogLength pid+    cl <- clog ll pid+    pure (pid,linked,cl)+  if+    | linked    -> do+        _ <- register $ glDeleteProgram pid+        let prog = Program pid+        iface <- buildIface $ ifaceWith prog+        pure (prog,iface)+    | otherwise -> throwError . fromProgramError $ LinkFailed cl++-- |A simpler version of 'createProgram'. That function assumes you don’t need a uniform interface+-- and then just returns the 'Program'.+createProgram_ :: (HasProgramError e,MonadError e m,MonadIO m,MonadResource m)+                => [Stage]+                -> m Program+createProgram_ stages = fmap fst $ createProgram stages (\_ -> pure ())++-- |Is a shader program linked?+isLinked :: GLuint -> IO Bool+isLinked pid = do+  ok <- alloca $ liftA2 (*>) (glGetProgramiv pid GL_LINK_STATUS) peek+  pure $ ok == GL_TRUE++-- |Shader program link log’s length.+clogLength :: GLuint -> IO Int+clogLength pid =+  fmap fromIntegral .+    alloca $ liftA2 (*>) (glGetProgramiv pid GL_INFO_LOG_LENGTH) peek++-- |Shader program link log.+clog :: Int -> GLuint -> IO String+clog l pid =+  allocaArray l $+    liftA2 (*>) (glGetProgramInfoLog pid (fromIntegral l) nullPtr)+      (peekCString . castPtr)++-- |Either map a 'String' or 'Natural' to a uniform.+ifaceWith :: (HasProgramError e,MonadError e m,MonadIO m,Uniform a)+          => Program+          -> Either String Natural+          -> m (U a)+ifaceWith prog access = case access of+    Left name -> do+      location <- liftIO . withCString name $ glGetUniformLocation pid+      if+        | isActive location -> pure $ toU pid location+        | otherwise         -> throwError . fromProgramError $ InactiveUniform access+    Right sem+      | isActive sem -> pure $ toU pid (fromIntegral sem)+      | otherwise    -> throwError . fromProgramError $ InactiveUniform access+  where+    pid = programID prog+    isActive :: (Ord a,Num a) => a -> Bool+    isActive = (> -1)++--------------------------------------------------------------------------------+-- Shader program errors -------------------------------------------------------++-- |Shader program error.+--+-- 'LinkFailed reason' happens when a program fails to link. 'reason' contains the error message.+--+-- 'InactiveUniform uni' happens at linking when a uniform is inactive in the program; that+-- is, unused or semantically set to a negative value.+data ProgramError+  = LinkFailed String+  | InactiveUniform (Either String Natural)+    deriving (Eq,Show)++-- |Types that can handle 'ProgramError' – read as, “have”.+class HasProgramError a where+  fromProgramError :: ProgramError -> a

@@ -0,0 +1,106 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Core.Shader.Stage where++import Control.Applicative ( liftA2 )+import Control.Monad.Except ( MonadError(throwError) )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Trans.Resource ( MonadResource, register )+import Graphics.GL+import Foreign.C.String ( peekCString, withCString )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( allocaArray )+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( castPtr, nullPtr )+import Foreign.Storable ( peek )++--------------------------------------------------------------------------------+-- Shader stages ---------------------------------------------------------------++-- |A shader 'Stage'.+newtype Stage = Stage { stageID :: GLuint }++-- |Create a new tessellation control shader from a 'String' representation of its source code.+createTessCtrlShader :: (HasStageError e,MonadError e m,MonadIO m,MonadResource m) => String -> m Stage+createTessCtrlShader = mkShader GL_TESS_CONTROL_SHADER++-- |Create a new tessellation evaluation shader from a 'String' representation of its source code.+createTessEvalShader :: (HasStageError e,MonadError e m,MonadIO m,MonadResource m) => String -> m Stage+createTessEvalShader = mkShader GL_TESS_EVALUATION_SHADER++-- |Create a new vertex shader from a 'String' representation of its source code.+createVertexShader :: (HasStageError e,MonadError e m,MonadIO m,MonadResource m) => String -> m Stage+createVertexShader = mkShader GL_VERTEX_SHADER++-- |Create a new geometry shader from a 'String' representation of its source code.+createGeometryShader :: (HasStageError e,MonadError e m,MonadIO m,MonadResource m) => String -> m Stage+createGeometryShader = mkShader GL_GEOMETRY_SHADER++-- |Create a new fragment shader from a 'String' representation of its source code.+createFragmentShader :: (HasStageError e,MonadError e m,MonadIO m,MonadResource m) => String -> m Stage+createFragmentShader = mkShader GL_FRAGMENT_SHADER++-- |Create a new compute shader from a 'String' representation of its source code.+createComputeShader :: (HasStageError e,MonadError e m,MonadIO m,MonadResource m) => String -> m Stage+createComputeShader = mkShader GL_COMPUTE_SHADER++-- Create a shader from the kind of shader and its source code 'String' representation.+mkShader :: (HasStageError e,MonadError e m,MonadIO m,MonadResource m)+         => GLenum+         -> String+         -> m Stage+mkShader target src = do+  (sid,compiled,cl) <- liftIO $ do+    sid <- glCreateShader target+    withCString src $ \cstr -> do+      with cstr $ \pcstr -> glShaderSource sid 1 pcstr nullPtr+      glCompileShader sid+      compiled <- isCompiled sid+      ll <- clogLength sid+      cl <- clog ll sid+      pure (sid,compiled,cl)+  if+    | compiled  -> do+        _ <- register $ glDeleteShader sid+        pure $ Stage sid+    | otherwise -> throwError . fromStageError $ CompilationFailed cl++-- Is a shader compiled?+isCompiled :: GLuint -> IO Bool+isCompiled sid = do+  ok <- alloca $ liftA2 (*>) (glGetShaderiv sid GL_COMPILE_STATUS) peek+  pure $ ok == GL_TRUE++-- Shader compilation log’s length.+clogLength :: GLuint -> IO Int+clogLength sid =+  fmap fromIntegral . alloca $+    liftA2 (*>) (glGetShaderiv sid GL_INFO_LOG_LENGTH) peek++-- Shader compilation log.+clog :: Int -> GLuint -> IO String+clog l sid =+  allocaArray l $+    liftA2 (*>) (glGetShaderInfoLog sid (fromIntegral l) nullPtr)+      (peekCString . castPtr)++--------------------------------------------------------------------------------+-- Shader stage errors ---------------------------------------------------------++-- |Error type of shaders.+--+-- 'CompilationFailed reason' occurs when a shader fails to compile, and the 'String' 'reason'+-- contains a description of the failure.+newtype StageError = CompilationFailed String deriving (Eq,Show)++-- |Types that can handle 'StageError'.+class HasStageError a where+  fromStageError :: StageError -> a

@@ -0,0 +1,206 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Core.Shader.Uniform where++import Data.Functor.Contravariant ( Contravariant(..) )+import Data.Functor.Contravariant.Divisible ( Decidable(..), Divisible(..) )+import Data.Int ( Int32 )+import Data.Semigroup ( Semigroup(..) )+import Data.Void ( absurd )+import Data.Word ( Word32 )+import Foreign.Marshal.Array ( withArrayLen )+import Graphics.GL+import Graphics.GL.Ext.ARB.BindlessTexture ( glProgramUniformHandleui64ARB )+import Graphics.Luminance.Core.Texture ( Texture2D(textureHandle) )++--------------------------------------------------------------------------------+-- Uniform ---------------------------------------------------------------------++-- |Class of types that can be sent down to shaders. That class is closed because shaders cannot+-- handle a lot of uniform types. However, you should have a look at the 'U' documentation for+-- further information about how to augment the scope of the types you can send down to shaders.+class Uniform a where+  toU :: GLuint -> GLint -> U a++-- |A shader uniform. @'U' a@ doesn’t hold any value. It’s more like a mapping between the host+-- code and the shader the uniform was retrieved from.+--+-- 'U' is contravariant in its argument. That means that you can use 'contramap' to build more+-- interesting uniform types. It’s also a divisible contravariant functor, then you can divide+-- structures to take advantage of divisible contravariant properties and then glue several 'U'+-- with different types. That can be useful to build a uniform type by gluing its fields.+--+-- Another interesting part is the fact that 'U' is also monoidal. You can accumulate several of+-- them with '(<>)' if they have the same type. That means that you can join them so that when you+-- pass an actual value, it gets shared inside the resulting value.+--+-- The '()' instance doesn’t do anything and doesn’t even use its argument ('()').+newtype U a = U { runU :: a -> IO () }++instance Contravariant U where+  contramap f u = U $ runU u . f++instance Decidable U where+  lose f = U $ absurd . f+  choose f p q = U $ either (runU p) (runU q) . f++instance Divisible U where+  divide f p q = U $ \a -> do+    let (b,c) = f a+    runU p b+    runU q c+  conquer = mempty++instance Monoid (U a) where+  mempty = U . const $ pure ()+  mappend = (<>)++instance Semigroup (U a) where+  u <> v = U $ \a -> runU u a >> runU v a++--------------------------------------------------------------------------------+-- Unit instance ---------------------------------------------------------------++instance Uniform () where+  toU _ _ = mempty++--------------------------------------------------------------------------------+-- Int32 instances -------------------------------------------------------------++-- scalar+instance Uniform Int32 where+  toU prog l = U $ glProgramUniform1i prog l++-- D2+instance Uniform (Int32,Int32) where+  toU prog l = U $ \(x,y) -> glProgramUniform2i prog l x y++-- D3+instance Uniform (Int32,Int32,Int32) where+  toU prog l = U $ \(x,y,z) -> glProgramUniform3i prog l x y z++-- D4+instance Uniform (Int32,Int32,Int32,Int32) where+  toU prog l = U $ \(x,y,z,w) -> glProgramUniform4i prog l x y z w++-- scalar array+instance Uniform [Int32] where+  toU prog l = U $ \v -> withArrayLen v $ glProgramUniform1iv prog l . fromIntegral++-- D2 array+instance Uniform [(Int32,Int32)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unPair v) $+    glProgramUniform2iv prog l . fromIntegral++-- D3 array+instance Uniform [(Int32,Int32,Int32)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unTriple v) $+    glProgramUniform3iv prog l . fromIntegral++-- D4 array+instance Uniform [(Int32,Int32,Int32,Int32)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unQuad v) $+    glProgramUniform4iv prog l . fromIntegral++--------------------------------------------------------------------------------+-- Word32 instances ------------------------------------------------------------++-- scalar+instance Uniform Word32 where+  toU prog l = U $ glProgramUniform1ui prog l++-- D2+instance Uniform (Word32,Word32) where+  toU prog l = U $ \(x,y) -> glProgramUniform2ui prog l x y++-- D3+instance Uniform (Word32,Word32,Word32) where+  toU prog l = U $ \(x,y,z) -> glProgramUniform3ui prog l x y z++-- D4+instance Uniform (Word32,Word32,Word32,Word32) where+  toU prog l = U $ \(x,y,z,w) -> glProgramUniform4ui prog l x y z w++-- scalar array+instance Uniform [Word32] where+  toU prog l = U $ \v -> withArrayLen v $+    glProgramUniform1uiv prog l . fromIntegral++-- D2 array+instance Uniform [(Word32,Word32)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unPair v) $+    glProgramUniform2uiv prog l . fromIntegral++-- D3 array+instance Uniform [(Word32,Word32,Word32)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unTriple v) $+    glProgramUniform3uiv prog l . fromIntegral++-- D4 array+instance Uniform [(Word32,Word32,Word32,Word32)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unQuad v) $+    glProgramUniform4uiv prog l . fromIntegral++--------------------------------------------------------------------------------+-- Float instances -------------------------------------------------------------++-- scalar+instance Uniform Float where+  toU prog l = U $ glProgramUniform1f prog l++-- D2+instance Uniform (Float,Float) where+  toU prog l = U $ \(x,y) -> glProgramUniform2f prog l x y++-- D3+instance Uniform (Float,Float,Float) where+  toU prog l = U $ \(x,y,z) -> glProgramUniform3f prog l x y z++-- D4+instance Uniform (Float,Float,Float,Float) where+  toU prog l = U $ \(x,y,z,w) -> glProgramUniform4f prog l x y z w++-- scalar array+instance Uniform [Float] where+  toU prog l = U $ \v -> withArrayLen v $+    glProgramUniform1fv prog l . fromIntegral++-- D2 array+instance Uniform [(Float,Float)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unPair v) $+    glProgramUniform2fv prog l . fromIntegral++-- D3 array+instance Uniform [(Float,Float,Float)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unTriple v) $+    glProgramUniform3fv prog l . fromIntegral++-- D4 array+instance Uniform [(Float,Float,Float,Float)] where+  toU prog l = U $ \v -> withArrayLen (concatMap unQuad v) $+    glProgramUniform4fv prog l . fromIntegral++--------------------------------------------------------------------------------+-- Texture2D -------------------------------------------------------------------+instance Uniform (Texture2D f) where+  toU prog l = U $ glProgramUniformHandleui64ARB prog l . textureHandle++--------------------------------------------------------------------------------+-- Untuple functions -----------------------------------------------------------++unPair :: (a,a) -> [a]+unPair (x,y) = [x,y]++unTriple :: (a,a,a) -> [a]+unTriple (x,y,z) = [x,y,z]++unQuad :: (a,a,a,a) -> [a]+unQuad (x,y,z,w) = [x,y,z,w]

@@ -0,0 +1,211 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Texture where++import Control.Monad ( when )+import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad.Trans.Resource ( MonadResource, register )+import Data.Foldable ( toList )+import Data.Proxy ( Proxy(..) )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( withArray )+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( castPtr )+import Foreign.Storable ( Storable(peek) )+import Graphics.GL+import Graphics.GL.Ext.ARB.BindlessTexture+import Graphics.Luminance.Core.Pixel+import Numeric.Natural ( Natural )++data Wrap+  = ClampToEdge+  | ClampToBorder+  | Repeat+    deriving (Eq,Show)++fromWrap :: (Eq a,Num a) => Wrap -> a+fromWrap w = case w of+  ClampToEdge   -> GL_CLAMP_TO_EDGE+  ClampToBorder -> GL_CLAMP_TO_BORDER+  Repeat        -> GL_REPEAT++data Filter+  = Nearest+  | Linear+    deriving (Eq,Show)++fromFilter :: (Eq a,Num a) => Filter -> a+fromFilter f = case f of+  Nearest -> GL_NEAREST+  Linear  -> GL_LINEAR++data CompareFunc+  = Never+  | Less+  | Equal+  | LessOrEqual+  | Greater+  | GreaterOrEqual+  | NotEqual+  | Always+    deriving (Eq,Show)++fromCompareFunc :: (Eq a,Num a) => CompareFunc -> a+fromCompareFunc f = case f of+  Never -> GL_NEVER+  Less -> GL_LESS+  Equal -> GL_EQUAL+  LessOrEqual -> GL_LEQUAL+  Greater -> GL_GREATER+  GreaterOrEqual -> GL_GEQUAL+  NotEqual -> GL_NOTEQUAL+  Always -> GL_ALWAYS++-- |2D Texture.+data Texture2D f = Texture2D {+    textureID     :: GLuint+  , textureHandle :: GLuint64+  , textureW      :: GLsizei+  , textureH      :: GLsizei+  , textureFormat :: GLenum+  , textureType   :: GLenum+  } deriving (Eq,Show)++createTexture :: forall p m. (Pixel p,MonadIO m,MonadResource m)+              => Natural+              -> Natural+              -> Natural+              -> Sampling+              -> m (Texture2D p)+createTexture w h mipmaps sampling = do+    (tid,texH) <- liftIO . alloca $ \p -> do+      glCreateTextures GL_TEXTURE_2D 1 p+      tid <- peek p+      glTextureStorage2D tid (fromIntegral mipmaps) ift w' h'+      glTextureParameteri tid GL_TEXTURE_BASE_LEVEL 0+      glTextureParameteri tid GL_TEXTURE_MAX_LEVEL (fromIntegral mipmaps - 1)+      setTextureSampling tid sampling+      texH <- glGetTextureHandleARB tid +      glMakeTextureHandleResidentARB texH+      pure (tid,texH)+    _ <- register $ do+      glMakeTextureHandleNonResidentARB texH+      with tid $ glDeleteTextures 1+    pure $ Texture2D tid texH w' h' ft typ+  where+    ft  = pixelFormat (Proxy :: Proxy p)+    ift = pixelIFormat (Proxy :: Proxy p)+    typ = pixelType (Proxy :: Proxy p)+    w'  = fromIntegral w+    h'  = fromIntegral h++newtype Sampler = Sampler { samplerID :: GLuint } deriving (Eq,Show)++data Sampling = Sampling {+    samplingWrapS           :: Wrap+  , samplingWrapT           :: Wrap+  , samplingWrapR           :: Wrap+  , samplingMinFilter       :: Filter+  , samplingMagFilter       :: Filter+  , samplingCompareFunction :: Maybe CompareFunc+  } deriving (Eq,Show)++defaultSampling :: Sampling+defaultSampling = Sampling {+    samplingWrapS           = ClampToEdge+  , samplingWrapT           = ClampToEdge+  , samplingWrapR           = ClampToEdge+  , samplingMinFilter       = Linear+  , samplingMagFilter       = Linear+  , samplingCompareFunction = Nothing+  }++createSampler :: (MonadIO m,MonadResource m)+              => Sampling+              -> m Sampler+createSampler s = do+  sid <- liftIO . alloca $ \p -> do+    glCreateSamplers 1 p+    sid <- peek p+    setSamplerSampling sid s+    pure sid+  _ <- register . with sid $ glDeleteSamplers 1+  pure $ Sampler sid++setSampling :: (Eq a,Eq b,MonadIO m,Num a,Num b) => (GLenum -> a -> b -> IO ()) -> GLenum -> Sampling -> m ()+setSampling f objID s = liftIO $ do+  -- wraps+  f objID GL_TEXTURE_WRAP_S . fromWrap $ samplingWrapS s+  f objID GL_TEXTURE_WRAP_T . fromWrap $ samplingWrapT s+  f objID GL_TEXTURE_WRAP_R . fromWrap $ samplingWrapR s+  -- filters+  f objID GL_TEXTURE_MIN_FILTER . fromFilter $ samplingMinFilter s+  f objID GL_TEXTURE_MAG_FILTER . fromFilter $ samplingMagFilter s+  -- comparison function+  case samplingCompareFunction s of+    Just cmpf -> do+      f objID GL_TEXTURE_COMPARE_FUNC $ fromCompareFunc cmpf+      f objID GL_TEXTURE_COMPARE_MODE GL_COMPARE_REF_TO_TEXTURE+    Nothing ->+      f objID GL_TEXTURE_COMPARE_MODE GL_NONE++setTextureSampling :: (MonadIO m) => GLenum -> Sampling -> m ()+setTextureSampling = setSampling glTextureParameteri++setSamplerSampling :: (MonadIO m) => GLenum -> Sampling -> m ()+setSamplerSampling = setSampling glSamplerParameteri++uploadWhole :: (Foldable f,MonadIO m,PixelBase p ~ a,Storable a)+            => Texture2D p+            -> Bool+            -> f a+            -> m ()+uploadWhole (Texture2D tid _ w h fmt typ) autolvl dat =+  liftIO $ do+    withArray (toList dat) $ glTextureSubImage2D tid 0 0 0 w h fmt typ . castPtr+    when autolvl $ glGenerateTextureMipmap tid++uploadSub :: (Foldable f,MonadIO m,PixelBase p ~ a,Storable a)+          => Texture2D p+          -> Int+          -> Int+          -> Natural+          -> Natural+          -> Bool+          -> f a+          -> m ()+uploadSub (Texture2D tid _ _ _ fmt typ) x y w h autolvl dat =+  liftIO $ do+    withArray (toList dat) $ glTextureSubImage2D tid 0 (fromIntegral x)+      (fromIntegral y) (fromIntegral w) (fromIntegral h) fmt typ . castPtr+    when autolvl $ glGenerateTextureMipmap tid++fillWhole :: (Foldable f, MonadIO m,PixelBase p ~ a,Storable a)+          => Texture2D p+          -> Bool+          -> f a+          -> m ()+fillWhole tex = fillSub tex 0 0 (fromIntegral $ textureW tex) (fromIntegral $ textureH tex)++fillSub :: (Foldable f,MonadIO m,PixelBase p ~ a,Storable a)+        => Texture2D p+        -> Int+        -> Int+        -> Natural+        -> Natural+        -> Bool+        -> f a+        -> m ()+fillSub (Texture2D tid _ _ _ fmt typ) x y w h autolvl filling =+  liftIO $ do+    withArray (toList filling) $ glClearTexSubImage tid 0 (fromIntegral x)+      (fromIntegral y) 0 (fromIntegral w) (fromIntegral h) 1 fmt typ . castPtr+    when autolvl $ glGenerateTextureMipmap tid

@@ -0,0 +1,32 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Tuple where++import Foreign.Storable ( Storable(..) )+import Foreign.Ptr ( castPtr, plusPtr )++-- |A tuple of types, right-associated.+--+-- The 'Storable' instance is used for foreign packing on 32-bit.+data a :. b = a :. b deriving (Eq,Functor,Ord,Show)++infixr 6 :.++instance (Storable a,Storable b) => Storable (a :. b) where+  sizeOf (a :. b) = sizeOf a + sizeOf b+  alignment _ = 4 -- packed data+  peek p = do+    a <- peek $ castPtr p+    b <- peek . castPtr $ p `plusPtr` sizeOf (undefined :: a)+    pure $ a :. b+  poke p (a :. b) = do+    poke (castPtr p) a+    poke (castPtr $ p `plusPtr` sizeOf (undefined :: a)) b

@@ -0,0 +1,94 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Core.Vertex where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.Int ( Int32 )+import Data.Proxy ( Proxy(..) )+import Data.Word ( Word32 )+import Foreign.Marshal.Array ( peekArray, pokeArray )+import Foreign.Ptr ( Ptr, castPtr )+import Foreign.Storable ( Storable(..) )+import GHC.TypeLits ( KnownNat, Nat, natVal )+import Graphics.GL+import Graphics.Luminance.Core.Tuple++-- FIXME: use linear’s one?+data V :: Nat -> * -> * where+  V1 :: !a -> V 1 a+  V2 :: !a -> !a -> V 2 a+  V3 :: !a -> !a -> !a -> V 3 a+  V4 :: !a -> !a -> !a -> !a -> V 4 a++instance (Storable a) => Storable (V 1 a) where+  sizeOf _ = sizeOf (undefined :: a)+  alignment _ = alignment (undefined :: a)+  peek p = fmap V1 $ peek (castPtr p :: Ptr a)+  poke p (V1 x) = poke (castPtr p) x++instance (Storable a) => Storable (V 2 a) where+  sizeOf _ = 2 * sizeOf (undefined :: a)+  alignment _ = alignment (undefined :: a)+  peek p = do+    [x,y] <- peekArray 2 (castPtr p :: Ptr a)+    pure $ V2 x y+  poke p (V2 x y) = pokeArray (castPtr p) [x,y]++instance (Storable a) => Storable (V 3 a) where+  sizeOf _ = 3 * sizeOf (undefined :: a)+  alignment _ = alignment (undefined :: a)+  peek p = do+    [x,y,z] <- peekArray 3 (castPtr p :: Ptr a)+    pure $ V3 x y z+  poke p (V3 x y z) = pokeArray (castPtr p) [x,y,z]++instance (Storable a) => Storable (V 4 a) where+  sizeOf _ = 4 * sizeOf (undefined :: a)+  alignment _ = alignment (undefined :: a)+  peek p = do+    [x,y,z,w] <- peekArray 4 (castPtr p :: Ptr a)+    pure $ V4 x y z w+  poke p (V4 x y z w) = pokeArray (castPtr p) [x,y,z,w]++-- |A vertex might have several attributes. The types of those attributes have to implement the+-- 'VertexAttribute' typeclass in order to be used as vertex attributes.+class VertexAttribute a where+  vertexGLType :: proxy a -> GLenum++instance VertexAttribute Float where+  vertexGLType _ = GL_FLOAT++instance VertexAttribute Int32 where+  vertexGLType _ = GL_INT++instance VertexAttribute Word32 where+  vertexGLType _ = GL_UNSIGNED_INT++-- |A vertex has to implement 'Vertex' in order to be used as-is. That typeclass is closed, so you+-- you cannot add anymore instances. However, you shouldn’t need to since you can use the already+-- provided types to build up your vertex type.+class Vertex v where+  setFormatV :: (MonadIO m) => GLuint -> GLuint -> proxy v -> m ()++instance (KnownNat n,Storable a,VertexAttribute a) => Vertex (V n a) where+  setFormatV vid index _ = do+    glVertexArrayAttribFormat vid index (fromIntegral $ natVal (Proxy :: Proxy n)) (vertexGLType (Proxy :: Proxy a)) GL_FALSE 0+    glVertexArrayAttribBinding vid index vertexBindingIndex+    glEnableVertexArrayAttrib vid index++instance (Vertex a,Vertex b) => Vertex (a :. b) where+  setFormatV vid index _ = do+    setFormatV vid index (Proxy :: Proxy a)+    setFormatV vid index (Proxy :: Proxy b)++-- Used to connect vertex attribute to the vertex buffer binding point. Should be 0.+vertexBindingIndex :: GLuint+vertexBindingIndex = 0

@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Framebuffer (+    -- * Framebuffer creation+    Framebuffer+  , ColorFramebuffer+  , DepthFramebuffer+  , framebufferID+  , framebufferOutput+  , createFramebuffer+    -- * Framebuffer attachments+  , FramebufferColorAttachment+  , FramebufferDepthAttachment+    -- * Framebuffer access+  , FramebufferColorRW+  , FramebufferTarget+    -- * Framebuffer outputs+  , TexturizeFormat+  , Output(..)+    -- * Blitting+  , FramebufferBlitMask(..)+    -- * Special framebuffers+  , defaultFramebuffer+    -- * Framebuffer errors+  , FramebufferError(..)+  , HasFramebufferError(..)+  ) where++import Graphics.Luminance.Core.Framebuffer

@@ -0,0 +1,18 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Geometry (+    -- * Geometry creation+    Geometry+  , GeometryMode(..)+  , createGeometry+  ) where++import Graphics.Luminance.Core.Geometry

@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Pixel (+    -- * Channel size+    ChannelSize+  , C8(..)+  , C16(..)+  , C32(..)+    -- * Channel type+  , ChannelType+  , CInts(..)+  , CUInts(..)+  , CFloats(..)+    -- * Channel shape+  , CR(..)+  , CRG(..)+  , CRGB(..)+  , CRGBA(..)+  , CDepth(..)+    -- * Pixel format+  , Format(..)+  , Pixel+  , RGB8UI+  , RGBA8UI+  , RGBA8F+  , RGB32F+  , RGBA32F+  , Depth32F+    -- * Color pixel+  , ColorPixel+  ) where++import Graphics.Luminance.Core.Pixel

@@ -0,0 +1,20 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Query (+    -- * Available queries+    getGLVendor+  , getGLRenderer+  , getGLVersion+  , getGLSLVersion+  , getGLExtensions+  ) where++import Graphics.Luminance.Core.Query

@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.RW (+    -- * Readable types+    Readable+  , R+    -- * Writable types+  , Writable+  , W+   -- * Read/write types+  , RW+  ) where++import Graphics.Luminance.Core.RW

@@ -0,0 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.RenderCmd (+    -- * Render commands+    RenderCmd+  , renderCmd+    -- * Special render commands+  , stdRenderCmd+  ) where++import Graphics.Luminance.Core.RenderCmd

@@ -0,0 +1,17 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Shader (+    module X+  ) where++import Graphics.Luminance.Shader.Program as X+import Graphics.Luminance.Shader.Stage as X+import Graphics.Luminance.Shader.Uniform as X

@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Shader.Program (+    -- * Shader program creation+    Program+  , programID+  , createProgram+  , createProgram_+    -- * Error handling+  , ProgramError(..)+  , HasProgramError(..)+  ) where++import Graphics.Luminance.Core.Shader.Program

@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Shader.Stage (+    -- * Shader stage creation+    Stage+  , stageID+  , createTessCtrlShader+  , createTessEvalShader+  , createVertexShader+  , createGeometryShader+  , createFragmentShader+  , createComputeShader+    -- * Error handling+  , StageError(..)+  , HasStageError(..)+  ) where++import Graphics.Luminance.Core.Shader.Stage

@@ -0,0 +1,17 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Shader.Uniform (+    -- * Uniform+    Uniform+  , U+  ) where++import Graphics.Luminance.Core.Shader.Uniform

@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Texture (+    -- * Texture information and creation+    Texture2D+  , textureID+  , textureHandle+  , textureW+  , textureH+  , textureFormat+  , textureType+  , createTexture+    -- * Sampling+  , Sampling(..)+  , defaultSampling+    -- * Texture sampler customization+  , Filter(..)+  , Wrap(..)+  , CompareFunc(..)+    -- * Texture operations+  , uploadWhole+  , uploadSub+  , fillWhole+  , fillSub+  ) where+  +import Graphics.Luminance.Core.Texture

@@ -0,0 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+----------------------------------------------------------------------------++module Graphics.Luminance.Vertex (+    -- * Vertex components+    V(..)+  , VertexAttribute+    -- * Vertex+  , Vertex+  ) where++import Graphics.Luminance.Core.Vertex