Copyright | (C) 2015 Dimitri Sabadie |
---|---|
License | BSD3 |
Maintainer | Dimitri Sabadie <dimitri.sabadie@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell2010 |
- class Texture t where
- type TextureSize t :: *
- type TextureOffset t :: *
- createTexture :: forall m t. (MonadIO m, MonadResource m, Texture t) => TextureSize t -> Natural -> Sampling -> m t
- data Sampling = Sampling {}
- defaultSampling :: Sampling
- data Filter
- data Wrap
- data CompareFunc
- = Never
- | Less
- | Equal
- | LessOrEqual
- | Greater
- | GreaterOrEqual
- | NotEqual
- | Always
- uploadSub :: forall a m t. (MonadIO m, Storable a, Texture t) => t -> TextureOffset t -> TextureSize t -> Bool -> Vector a -> m ()
- fillSub :: forall a m t. (MonadIO m, Storable a, Texture t) => t -> TextureOffset t -> TextureSize t -> Bool -> Vector a -> m ()
- data Texture1D f
- texture1DW :: Texture1D f -> Natural
- data Texture1DArray n f
- texture1DArrayW :: Texture1DArray n f -> Natural
- data Texture2D f
- texture2DW :: Texture2D f -> Natural
- texture2DH :: Texture2D f -> Natural
- data Texture2DArray n f
- texture2DArrayW :: Texture2DArray n f -> Natural
- data Texture3D f
- texture3DW :: Texture3D f -> Natural
- texture3DH :: Texture3D f -> Natural
- texture3DD :: Texture3D f -> Natural
- data Cubemap f
- data CubeFace
- cubemapSize :: Cubemap f -> Natural
- data CubemapArray n f
- cubemapArraySize :: CubemapArray n f -> Natural
- module Graphics.Luminance.Pixel
Texture information and creation
class Texture t
Class of all textures.
fromBaseTexture, toBaseTexture, textureTypeEnum, textureSize, textureStorage, transferTexelsSub, fillTextureSub
type TextureSize t :: *
Size of a texture. This is an associated type – type family – because the dimensionality of a texture relies on its type.
type TextureOffset t :: *
In order to index regions of texels in texture, we need another associated type – for the same
dimensionality reason as for TextureSize
.
createTexture :: forall m t. (MonadIO m, MonadResource m, Texture t) => TextureSize t -> Natural -> Sampling -> m t
'createTexture w h levels sampling' a new 'w'*'h' texture with levels
levels. The format is
set through the type.
Sampling
Default Sampling
for convenience.
defaultSampling = Sampling { samplingWrapS = ClampToEdge , samplingWrapT = ClampToEdge , samplingWrapR = ClampToEdge , samplingMinFilter = Linear , samplingMagFilter = Linear , samplingCompareFunction = Nothing }
Texture sampler customization
data Filter
data Wrap
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.
ClampToEdge | |
Repeat | ClampToBorder |
MirroredRepeat |
data CompareFunc
For textures that might require depth comparison, that type defines all the possible cases for comparison.
Texture operations
uploadSub :: forall a m t. (MonadIO m, Storable a, Texture t) => t -> TextureOffset t -> TextureSize t -> Bool -> Vector a -> m ()
fillSub :: forall a m t. (MonadIO m, Storable a, Texture t) => t -> TextureOffset t -> TextureSize t -> Bool -> Vector a -> m ()
Fill a subpart of the texture’s storage with a given value.
Available textures
1D textures
data Texture1D f
A 1D texture.
texture1DW :: Texture1D f -> Natural
Array texture
data Texture1DArray n f
A 1D texture array.
Eq (Texture1DArray n f) | |
Show (Texture1DArray n f) | |
(KnownNat n, Pixel f) => Texture (Texture1DArray n f) | |
type TextureSize (Texture1DArray n f) = Natural | |
type TextureOffset (Texture1DArray n f) = (Natural, Natural) |
texture1DArrayW :: Texture1DArray n f -> Natural
2D textures
data Texture2D f
A 2D texture.
texture2DW :: Texture2D f -> Natural
texture2DH :: Texture2D f -> Natural
Array texture
data Texture2DArray n f
A 2D texture array.
Eq (Texture2DArray n f) | |
Show (Texture2DArray n f) | |
(KnownNat n, Pixel f) => Texture (Texture2DArray n f) | |
type TextureSize (Texture2DArray n f) = (Natural, Natural) | |
type TextureOffset (Texture2DArray n f) = (Natural, Natural, Natural) |
texture2DArrayW :: Texture2DArray n f -> Natural
3D textures
data Texture3D f
A 3D texture.
texture3DW :: Texture3D f -> Natural
texture3DH :: Texture3D f -> Natural
texture3DD :: Texture3D f -> Natural
Cubemaps
data Cubemap f
A cubemap.
cubemapSize :: Cubemap f -> Natural
Array textures
data CubemapArray n f
A cubemap array.
Eq (CubemapArray n f) | |
Show (CubemapArray n f) | |
(KnownNat n, Pixel f) => Texture (CubemapArray n f) | |
type TextureSize (CubemapArray n f) = Natural | |
type TextureOffset (CubemapArray n f) = (Natural, Natural, Natural, CubeFace) |
cubemapArraySize :: CubemapArray n f -> Natural
Pixel formats
module Graphics.Luminance.Pixel