packages feed

luminance 0.2 → 0.3

raw patch · 10 files changed

+408/−100 lines, 10 files

Files

CHANGELOG.md view
@@ -1,3 +1,14 @@+# 0.3++- All textures can now be used in shaders.+- Added support for more OpenGL textures – though, framebuffers are not impacted yet.+    - `Texture1D`+    - `Texture2D`+    - `Texture3D`+    - `Cubemap`+- Changed the texture interface with type families so that we can add more in an+  easier way!+ # 0.2  #### Breaking changes
luminance.cabal view
@@ -1,5 +1,5 @@ name:                luminance-version:             0.2+version:             0.3 synopsis:            Type-safe, dependently-typed and stateless graphics framework description:         This package exposes several modules to work with /GPUs/ in a stateless and                      type-safe way. Currently, it uses __OpenGL__ as backend hardware technology but@@ -73,6 +73,7 @@                      , Graphics.Luminance.Core.Blending                      , Graphics.Luminance.Core.Buffer                      , Graphics.Luminance.Core.Cmd+                     , Graphics.Luminance.Core.Cubemap                      , Graphics.Luminance.Core.Debug                      , Graphics.Luminance.Core.Framebuffer                      , Graphics.Luminance.Core.Geometry@@ -85,6 +86,9 @@                      , Graphics.Luminance.Core.Shader.Stage                      , Graphics.Luminance.Core.Shader.Uniform                      , Graphics.Luminance.Core.Texture+                     , Graphics.Luminance.Core.Texture1D+                     , Graphics.Luminance.Core.Texture2D+                     , Graphics.Luminance.Core.Texture3D                      , Graphics.Luminance.Core.Vertex    default-extensions:  DataKinds
+ src/Graphics/Luminance/Core/Cubemap.hs view
@@ -0,0 +1,72 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Cubemap where++import Data.Foldable ( toList )+import Data.Proxy ( Proxy(..) )+import Foreign.Marshal.Array ( withArray )+import Foreign.Ptr ( castPtr )+import Graphics.Luminance.Core.Texture ( BaseTexture(..), Texture(..) )+import Graphics.Luminance.Core.Pixel ( Pixel(..) )+import Graphics.GL+import Numeric.Natural ( Natural )++data CubeFace+  = PositiveX+  | NegativeX+  | PositiveY+  | NegativeY+  | PositiveZ+  | NegativeZ+    deriving (Eq,Show)++fromCubeFace :: CubeFace -> GLint+fromCubeFace f = case f of+  PositiveX -> GL_TEXTURE_CUBE_MAP_POSITIVE_X+  NegativeX -> GL_TEXTURE_CUBE_MAP_NEGATIVE_X+  PositiveY -> GL_TEXTURE_CUBE_MAP_POSITIVE_Y+  NegativeY -> GL_TEXTURE_CUBE_MAP_NEGATIVE_Y+  PositiveZ -> GL_TEXTURE_CUBE_MAP_POSITIVE_Z+  NegativeZ -> GL_TEXTURE_CUBE_MAP_NEGATIVE_Z++-- |A cubemap.+data Cubemap f = Cubemap {+    cubemapBase :: BaseTexture+  , cubemapW    :: Natural+  , cubemapH    :: Natural+  } deriving (Eq,Show)++instance (Pixel f) => Texture (Cubemap f) where+  type TextureSize (Cubemap f) = (Natural,Natural)+  type TextureOffset (Cubemap f) = (Natural,Natural,CubeFace)+  fromBaseTexture bt (w,h) = Cubemap bt w h+  toBaseTexture = cubemapBase+  textureTypeEnum _ = GL_TEXTURE_CUBE_MAP+  textureSize (Cubemap _ w h) = (w,h)+  textureStorage _ tid levels (w,h) =+    glTextureStorage2D tid levels (pixelIFormat (Proxy :: Proxy f)) (fromIntegral w)+      (fromIntegral h)+  transferTexelsSub _ tid (x,y,f) (w,h) texels =+      withArray (toList texels) $ glTextureSubImage3D tid 0 (fromIntegral x) (fromIntegral y)+        (fromCubeFace f) (fromIntegral w) (fromIntegral h) 1 fmt+        typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy+  fillTextureSub _ tid (x,y,f) (w,h) filling =+      withArray (toList filling) $ glClearTexSubImage tid 0 (fromIntegral x) (fromIntegral y) +        (fromCubeFace f) (fromIntegral w) (fromIntegral h) 1+        fmt typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy
src/Graphics/Luminance/Core/Framebuffer.hs view
@@ -28,6 +28,7 @@ import Graphics.Luminance.Core.Renderbuffer ( createRenderbuffer, renderbufferID ) import Graphics.Luminance.Core.RW import Graphics.Luminance.Core.Texture+import Graphics.Luminance.Core.Texture2D import Graphics.Luminance.Core.Tuple import Numeric.Natural ( Natural ) @@ -232,9 +233,9 @@           -> proxy p           -> m (Texture2D p) addOutput fid ca w h mipmaps _ = do-  tex :: Texture2D p <- createTexture w h mipmaps defaultSampling+  tex :: Texture2D p <- createTexture (w,h) mipmaps defaultSampling   debugGL "addOutput" . liftIO $ glNamedFramebufferTexture fid (fromAttachment ca)-    (textureID tex) 0+    (baseTextureID $ texture2DBase tex) 0   pure tex  --------------------------------------------------------------------------------
src/Graphics/Luminance/Core/Shader/Uniform.hs view
@@ -19,7 +19,11 @@ import Foreign.Marshal.Array ( withArrayLen ) import Graphics.GL import Graphics.GL.Ext.ARB.BindlessTexture ( glProgramUniformHandleui64ARB )-import Graphics.Luminance.Core.Texture ( Texture2D(textureHandle) )+import Graphics.Luminance.Core.Cubemap ( Cubemap(cubemapBase) )+import Graphics.Luminance.Core.Texture ( BaseTexture(baseTextureHnd) )+import Graphics.Luminance.Core.Texture1D ( Texture1D(texture1DBase) )+import Graphics.Luminance.Core.Texture2D ( Texture2D(texture2DBase) )+import Graphics.Luminance.Core.Texture3D ( Texture3D(texture3DBase) )  -------------------------------------------------------------------------------- -- Uniform ---------------------------------------------------------------------@@ -189,9 +193,19 @@     glProgramUniform4fv prog l . fromIntegral  ----------------------------------------------------------------------------------- Texture2D -------------------------------------------------------------------+-- Textures --------------------------------------------------------------------++instance Uniform (Texture1D f) where+  toU prog l = U $ glProgramUniformHandleui64ARB prog l . baseTextureHnd . texture1DBase+ instance Uniform (Texture2D f) where-  toU prog l = U $ glProgramUniformHandleui64ARB prog l . textureHandle+  toU prog l = U $ glProgramUniformHandleui64ARB prog l . baseTextureHnd . texture2DBase++instance Uniform (Texture3D f) where+  toU prog l = U $ glProgramUniformHandleui64ARB prog l . baseTextureHnd . texture3DBase++instance Uniform (Cubemap f) where+  toU prog l = U $ glProgramUniformHandleui64ARB prog l . baseTextureHnd . cubemapBase  -------------------------------------------------------------------------------- -- Untuple functions -----------------------------------------------------------
src/Graphics/Luminance/Core/Texture.hs view
@@ -13,30 +13,39 @@ 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 ) +----------------------------------------------------------------------------------------------------+-- Texture parameters ------------------------------------------------------------------------------++-- |Wrap texture parameter. Such an object is used to tell how to sampling is performed when going+-- out of the texture coordinates.+--+-- 'ClampToEdge' will clamp the texture coordinates between in '[0,1]'. If you pass '1.1' or+-- '31.456', in both cases you’ll end up with '1'. Same thing for negative values clamped to '0'.+--+-- 'Repeat' will clamp the texture in '[0,1]' after applying a 'fract' on the value, yielding a+-- a repeated '[0,1]' pattern. data Wrap   = ClampToEdge-  | ClampToBorder+  -- | 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+  -- ClampToBorder -> GL_CLAMP_TO_BORDER   Repeat        -> GL_REPEAT +-- |Sampling filter. 'Nearest' will sample the nearest texel at the sampling coordinates whilst+-- 'Linear' will perform linear interpolation with the texels nearby. data Filter   = Nearest   | Linear@@ -47,6 +56,8 @@   Nearest -> GL_NEAREST   Linear  -> GL_LINEAR +-- |For textures that might require depth comparison, that type defines all the possible cases for+-- comparison. data CompareFunc   = Never   | Less@@ -60,38 +71,66 @@  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+  Never          -> GL_NEVER+  Less           -> GL_LESS+  Equal          -> GL_EQUAL+  LessOrEqual    -> GL_LEQUAL+  Greater        -> GL_GREATER   GreaterOrEqual -> GL_GEQUAL-  NotEqual -> GL_NOTEQUAL-  Always -> GL_ALWAYS+  NotEqual       -> GL_NOTEQUAL+  Always         -> GL_ALWAYS --- |2D Texture.-data Texture2D f = Texture2D {-    textureID     :: GLuint-  , textureHandle :: GLuint64-  , textureW      :: GLsizei-  , textureH      :: GLsizei-  , textureFormat :: GLenum-  , textureType   :: GLenum+----------------------------------------------------------------------------------------------------+-- Textures ----------------------------------------------------------------------------------------++class Texture t where+  type TextureSize t :: *+  type TextureOffset t :: *+  fromBaseTexture :: BaseTexture -> TextureSize t -> t+  toBaseTexture :: t -> BaseTexture+  textureTypeEnum :: proxy t -> GLenum+  textureSize :: t -> TextureSize t+  textureStorage :: proxy t+                 -> GLuint -- texture ID+                 -> GLint -- levels+                 -> TextureSize t -- size of the texture+                 -> IO ()+  transferTexelsSub :: forall a f proxy. (Foldable f,Storable a)+                    => proxy t+                    -> GLuint -- texture ID+                    -> TextureOffset t -- offset+                    -> TextureSize t -- size+                    -> f a+                    -> IO ()+  fillTextureSub :: forall a f proxy. (Foldable f,Storable a)+                 => proxy t+                 -> GLuint+                 -> TextureOffset t -- offset+                 -> TextureSize t -- size+                 -> f a+                 -> IO ()++-- OpenGL texture.+data BaseTexture = BaseTexture {+    baseTextureID  :: GLuint+  , baseTextureHnd :: GLuint64   } deriving (Eq,Show) -createTexture :: forall p m. (Pixel p,MonadIO m,MonadResource m)-              => Natural-              -> Natural++-- |'createTexture w h levels sampling' a new 'w'*'h' texture with 'levels' levels. The format is+-- set through the type.+createTexture :: forall m t. (MonadIO m,MonadResource m,Texture t)+              => TextureSize t               -> Natural               -> Sampling-              -> m (Texture2D p)-createTexture w h mipmaps sampling = do+              -> m t+createTexture size levels sampling = do     (tid,texH) <- liftIO . alloca $ \p -> do-      glCreateTextures GL_TEXTURE_2D 1 p+      glCreateTextures (textureTypeEnum (Proxy :: Proxy t)) 1 p       tid <- peek p-      glTextureStorage2D tid (fromIntegral mipmaps) ift w' h'+      textureStorage (Proxy :: Proxy t) tid (fromIntegral levels) size       glTextureParameteri tid GL_TEXTURE_BASE_LEVEL 0-      glTextureParameteri tid GL_TEXTURE_MAX_LEVEL (fromIntegral mipmaps - 1)+      glTextureParameteri tid GL_TEXTURE_MAX_LEVEL (fromIntegral levels - 1)       setTextureSampling tid sampling       texH <- glGetTextureHandleARB tid        glMakeTextureHandleResidentARB texH@@ -99,16 +138,12 @@     _ <- 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+    pure $ fromBaseTexture (BaseTexture tid texH) size -newtype Sampler = Sampler { samplerID :: GLuint } deriving (Eq,Show)+----------------------------------------------------------------------------------------------------+-- Sampling objects -------------------------------------------------------------------------------- +-- |A sampling configuration type. data Sampling = Sampling {     samplingWrapS           :: Wrap   , samplingWrapT           :: Wrap@@ -118,6 +153,18 @@   , samplingCompareFunction :: Maybe CompareFunc   } deriving (Eq,Show) +-- |Default 'Sampling' for convenience.+--+-- @+--   defaultSampling = Sampling {+--       samplingWrapS           = ClampToEdge+--     , samplingWrapT           = ClampToEdge+--     , samplingWrapR           = ClampToEdge+--     , samplingMinFilter       = Linear+--     , samplingMagFilter       = Linear+--     , samplingCompareFunction = Nothing+--     }+-- @ defaultSampling :: Sampling defaultSampling = Sampling {     samplingWrapS           = ClampToEdge@@ -128,18 +175,7 @@   , 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-+-- Apply a 'Sampling' object for a given type of object (texture, sampler, etc.). 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@@ -163,49 +199,52 @@ 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+----------------------------------------------------------------------------------------------------+-- Samplers ---------------------------------------------------------------------------------------- -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+newtype Sampler = Sampler { samplerID :: GLuint } deriving (Eq,Show) -fillWhole :: (Foldable f, MonadIO m,PixelBase p ~ a,Storable a)-          => Texture2D p+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++----------------------------------------------------------------------------------------------------+-- Texture operations ------------------------------------------------------------------------------++-- |@'uploadSub' tex offset size autolvl texels@ uploads data to a subpart of the texture’s storage.+-- The offset is given with origin at upper-left corner, and @size@ is the size of the area+-- to upload to. @autolvl@ is a 'Bool' that can be used to automatically generate mipmaps.+uploadSub :: forall a f m t. (Foldable f,MonadIO m,Storable a,Texture t)+          => t+          -> TextureOffset t+          -> TextureSize t           -> Bool           -> f a           -> m ()-fillWhole tex = fillSub tex 0 0 (fromIntegral $ textureW tex) (fromIntegral $ textureH tex)+uploadSub tex offset size autolvl texels = liftIO $ do+    transferTexelsSub (Proxy :: Proxy t) tid offset size texels+    when autolvl $ glGenerateTextureMipmap tid+  where+    tid = baseTextureID (toBaseTexture tex) -fillSub :: (Foldable f,MonadIO m,PixelBase p ~ a,Storable a)-        => Texture2D p-        -> Int-        -> Int-        -> Natural-        -> Natural+-- |Fill a subpart of the texture’s storage with a given value.+fillSub :: forall a f m t. (Foldable f,MonadIO m,Storable a,Texture t)+        => t+        -> TextureOffset t+        -> TextureSize t         -> 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+fillSub tex offset size autolvl filling = liftIO $ do+    fillTextureSub (Proxy :: Proxy t) tid offset size filling     when autolvl $ glGenerateTextureMipmap tid+  where+    tid = baseTextureID (toBaseTexture tex)
+ src/Graphics/Luminance/Core/Texture1D.hs view
@@ -0,0 +1,50 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Texture1D where++import Data.Foldable ( toList )+import Data.Proxy ( Proxy(..) )+import Foreign.Marshal.Array ( withArray )+import Foreign.Ptr ( castPtr )+import Graphics.Luminance.Core.Texture ( BaseTexture(..), Texture(..) )+import Graphics.Luminance.Core.Pixel ( Pixel(..) )+import Graphics.GL+import Numeric.Natural ( Natural )++-- |A 1D texture.+data Texture1D f = Texture1D {+    texture1DBase :: BaseTexture+  , texture1DW    :: Natural+  } deriving (Eq,Show)++instance (Pixel f) => Texture (Texture1D f) where+  type TextureSize (Texture1D f) = Natural+  type TextureOffset (Texture1D f) = Natural+  fromBaseTexture = Texture1D+  toBaseTexture = texture1DBase+  textureTypeEnum _ = GL_TEXTURE_1D+  textureSize = texture1DW+  textureStorage _ tid levels w =+    glTextureStorage1D tid levels (pixelIFormat (Proxy :: Proxy f)) (fromIntegral w)+  transferTexelsSub _ tid x w texels =+      withArray (toList texels) $ glTextureSubImage1D tid 0 (fromIntegral x) (fromIntegral w) fmt+        typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy+  fillTextureSub _ tid x w filling =+      withArray (toList filling) $ glClearTexSubImage tid 0 (fromIntegral x) 0 0 (fromIntegral w) 1 1+        fmt typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy
+ src/Graphics/Luminance/Core/Texture2D.hs view
@@ -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.Texture2D where++import Data.Foldable ( toList )+import Data.Proxy ( Proxy(..) )+import Foreign.Marshal.Array ( withArray )+import Foreign.Ptr ( castPtr )+import Graphics.Luminance.Core.Texture ( BaseTexture(..), Texture(..) )+import Graphics.Luminance.Core.Pixel ( Pixel(..) )+import Graphics.GL+import Numeric.Natural ( Natural )++-- |A 2D texture.+data Texture2D f = Texture2D {+    texture2DBase :: BaseTexture+  , texture2DW    :: Natural+  , texture2DH    :: Natural+  } deriving (Eq,Show)++instance (Pixel f) => Texture (Texture2D f) where+  type TextureSize (Texture2D f) = (Natural,Natural)+  type TextureOffset (Texture2D f) = (Natural,Natural)+  fromBaseTexture bt (w,h) = Texture2D bt w h+  toBaseTexture = texture2DBase+  textureTypeEnum _ = GL_TEXTURE_2D+  textureSize (Texture2D _ w h) = (w,h)+  textureStorage _ tid levels (w,h) =+    glTextureStorage2D tid levels (pixelIFormat (Proxy :: Proxy f)) (fromIntegral w) (fromIntegral h)+  transferTexelsSub _ tid (x,y) (w,h) texels =+      withArray (toList texels) $ glTextureSubImage2D tid 0 (fromIntegral x) (fromIntegral y)+        (fromIntegral w) (fromIntegral h) fmt typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy+  fillTextureSub _ tid (x,y) (w,h) filling =+      withArray (toList filling) $ glClearTexSubImage tid 0 (fromIntegral x)+        (fromIntegral y) 0 (fromIntegral w) (fromIntegral h) 1 fmt typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy
+ src/Graphics/Luminance/Core/Texture3D.hs view
@@ -0,0 +1,53 @@+-----------------------------------------------------------------------------+-- |+-- Copyright   : (C) 2015 Dimitri Sabadie+-- License     : BSD3+--+-- Maintainer  : Dimitri Sabadie <dimitri.sabadie@gmail.com>+-- Stability   : experimental+-- Portability : portable+-----------------------------------------------------------------------------++module Graphics.Luminance.Core.Texture3D where++import Data.Foldable ( toList )+import Data.Proxy ( Proxy(..) )+import Foreign.Marshal.Array ( withArray )+import Foreign.Ptr ( castPtr )+import Graphics.Luminance.Core.Texture ( BaseTexture(..), Texture(..) )+import Graphics.Luminance.Core.Pixel ( Pixel(..) )+import Graphics.GL+import Numeric.Natural ( Natural )++-- |A 3D texture.+data Texture3D f = Texture3D {+    texture3DBase :: BaseTexture+  , texture3DW    :: Natural+  , texture3DH    :: Natural+  , texture3DD    :: Natural+  } deriving (Eq,Show)++instance (Pixel f) => Texture (Texture3D f) where+  type TextureSize (Texture3D f) = (Natural,Natural,Natural)+  type TextureOffset (Texture3D f) = (Natural,Natural,Natural)+  fromBaseTexture bt (w,h,d) = Texture3D bt w h d+  toBaseTexture = texture3DBase+  textureTypeEnum _ = GL_TEXTURE_3D+  textureSize (Texture3D _ w h d) = (w,h,d)+  textureStorage _ tid levels (w,h,d) =+    glTextureStorage3D tid levels (pixelIFormat (Proxy :: Proxy f)) (fromIntegral w)+      (fromIntegral h) (fromIntegral d)+  transferTexelsSub _ tid (x,y,z) (w,h,d) texels =+      withArray (toList texels) $ glTextureSubImage3D tid 0 (fromIntegral x) (fromIntegral y)+        (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) fmt typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy+  fillTextureSub _ tid (x,y,z) (w,h,d) filling =+      withArray (toList filling) $ glClearTexSubImage tid 0 (fromIntegral x) (fromIntegral y)+        (fromIntegral z) (fromIntegral w) (fromIntegral h) (fromIntegral d) fmt typ . castPtr+    where+      proxy = Proxy :: Proxy f+      fmt = pixelFormat proxy+      typ = pixelType proxy
src/Graphics/Luminance/Texture.hs view
@@ -10,13 +10,7 @@  module Graphics.Luminance.Texture (     -- * Texture information and creation-    Texture2D-  , textureID-  , textureHandle-  , textureW-  , textureH-  , textureFormat-  , textureType+    Texture   , createTexture     -- * Sampling   , Sampling(..)@@ -26,10 +20,29 @@   , Wrap(..)   , CompareFunc(..)     -- * Texture operations-  , uploadWhole   , uploadSub-  , fillWhole   , fillSub+    -- * Available textures+    -- ** 1D textures+  , Texture1D+  , texture1DW+    -- ** 2D textures+  , Texture2D+  , texture2DW+  , texture2DH+    -- ** 3D textures+  , Texture3D+  , texture3DW+  , texture3DH+  , texture3DD+    -- ** Cubemaps+  , Cubemap+  , cubemapW+  , cubemapH   ) where   +import Graphics.Luminance.Core.Cubemap import Graphics.Luminance.Core.Texture+import Graphics.Luminance.Core.Texture1D+import Graphics.Luminance.Core.Texture2D+import Graphics.Luminance.Core.Texture3D