module Graphics.GLUtil.Textures where
import Graphics.Rendering.OpenGL
import qualified Graphics.Rendering.OpenGL.GL.VertexArrays as GL
import Data.Array.Storable (StorableArray, withStorableArray)
import Data.ByteString.Internal (ByteString, toForeignPtr)
import Data.Vector.Storable (Vector, unsafeWith)
import Data.Word (Word8, Word16)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, plusPtr, castPtr)
import Foreign.Marshal.Array (withArray)
import Foreign.Storable (Storable)
data TexColor = TexMono | TexRGB | TexBGR | TexRGBA
data TexInfo a = TexInfo { texWidth :: GLsizei
, texHeight :: GLsizei
, texColor :: TexColor
, texData :: a }
texInfo :: Int -> Int -> TexColor -> a -> TexInfo a
texInfo w h = TexInfo (fromIntegral w) (fromIntegral h)
class Storable a => HasGLType a where
glType :: a -> DataType
instance HasGLType Int where glType _ = GL.Int
instance HasGLType Word8 where glType _ = GL.UnsignedByte
instance HasGLType Word16 where glType _ = GL.UnsignedShort
instance HasGLType Float where glType _ = GL.Float
class HasGLType (Elem a) => IsPixelData a where
type Elem a
withPixels :: a -> (Ptr (Elem a) -> IO c) -> IO c
instance HasGLType b => IsPixelData [b] where
type Elem [b] = b
withPixels = withArray
instance HasGLType b => IsPixelData (Ptr b) where
type Elem (Ptr b) = b
withPixels = flip ($)
instance HasGLType b => IsPixelData (ForeignPtr b) where
type Elem (ForeignPtr b) = b
withPixels = withForeignPtr
instance HasGLType b => IsPixelData (StorableArray i b) where
type Elem (StorableArray i b) = b
withPixels = withStorableArray
instance HasGLType b => IsPixelData (Vector b) where
type Elem (Vector b) = b
withPixels = unsafeWith
instance IsPixelData ByteString where
type Elem ByteString = Word8
withPixels b m = aux . toForeignPtr $ b
where aux (fp,o,_) = withForeignPtr fp $ \p ->
m (plusPtr p o)
newtype ShortString = ShortString ByteString
instance IsPixelData ShortString where
type Elem ShortString = Word16
withPixels (ShortString b) m = aux. toForeignPtr $ b
where aux (fp,o,_) = withForeignPtr fp $ \p ->
m (plusPtr (castPtr p :: Ptr Word16) o)
loadTexture :: IsPixelData a => TexInfo a -> IO (TextureObject)
loadTexture tex = do [obj] <- genObjectNames 1
reloadTexture obj tex
return obj
reloadTexture :: forall a. IsPixelData a =>
TextureObject -> TexInfo a -> IO ()
reloadTexture obj tex = do textureBinding Texture2D $= Just obj
loadTex $ texColor tex
where loadTex TexMono = case pixelType of
GL.UnsignedShort -> loadAux Luminance16 Luminance
_ -> loadAux Luminance' Luminance
loadTex TexRGB = loadAux RGBA' RGB
loadTex TexBGR = loadAux RGBA' BGR
loadTex TexRGBA = loadAux RGBA' RGBA
sz = TextureSize2D (texWidth tex) (texHeight tex)
pixelType = glType (undefined::Elem a)
loadAux i e = withPixels (texData tex) $
(texImage2D Nothing NoProxy 0 i sz 0 .
PixelData e pixelType)