module SimpleH.GL.Texture (
Texture,
imageTexture,readTexture,readTextures,readTextures'
) where
import SimpleH
import Codec.Picture
import qualified Graphics.Rendering.OpenGL as GL
import Data.Vector.Storable (unsafeWith)
import SimpleH.GL.Base
data Texture = Texture GL.TextureObject
deriving Show
data TextureFormat = RGB | RGBA | Greyscale | GreyscaleA
pixelFormats RGBA = (GL.RGBA',GL.RGBA)
pixelFormats RGB = (GL.RGB',GL.RGB)
pixelFormats Greyscale = (GL.SLuminance8,GL.Luminance)
pixelFormats GreyscaleA = (GL.SLuminance8Alpha8,GL.LuminanceAlpha)
readTexture name = at' _eitherT $ (readImage name)^._eitherT
>>= at _eitherT<$>imageTexture
imageTexture i = at' _eitherT $ do
((f,f'),w,h,d) <- at _eitherT $ pure $ case i of
ImageRGB8 (Image w h d) -> pure (pixelFormats RGB,w,h,d)
ImageY8 (Image w h d) -> pure (pixelFormats Greyscale,w,h,d)
ImageRGBA8 (Image w h d) -> pure (pixelFormats RGBA,w,h,d)
ImageYA8 (Image w h d) -> pure (pixelFormats GreyscaleA,w,h,d)
_ -> throw "Could not load image format to texture"
lift $ do
[tex] <- GL.genObjectNames 1
GL.textureBinding GL.Texture2D GL.$= Just tex
unsafeWith d $ GL.build2DMipmaps GL.Texture2D f (fromIntegral w) (fromIntegral h)
. GL.PixelData f' GL.UnsignedByte
GL.textureFilter GL.Texture2D GL.$= ((GL.Linear', Just GL.Nearest), GL.Linear')
GL.textureFunction GL.$= GL.Modulate
return (Texture tex)
readTextures = map sequence . traverse readTexture
readTextures' = map2 (error<|>id) readTextures
instance Graphics Texture where
draw (Texture t) = GL.textureBinding GL.Texture2D GL.$= Just t