93 lines
2.2 KiB
Haskell
93 lines
2.2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Graphics.Texture where
|
|
|
|
import SDL (($=), get)
|
|
|
|
import qualified Graphics.Rendering.OpenGL as GL
|
|
|
|
import Codec.Picture
|
|
import Codec.Picture.Extra
|
|
|
|
import Data.Either
|
|
|
|
import Data.Vector.Storable as VS
|
|
|
|
import Data.String (fromString)
|
|
|
|
import Foreign.Ptr
|
|
import Foreign.Marshal.Alloc (free)
|
|
|
|
import Linear
|
|
|
|
-- internal imports
|
|
|
|
import Classes.Graphics.Bindable
|
|
|
|
data Texture = Texture
|
|
{ texId :: GL.TextureObject
|
|
, texSlot :: GL.TextureUnit
|
|
}
|
|
|
|
instance Bindable Texture where
|
|
|
|
bind t = do
|
|
GL.activeTexture $= texSlot t
|
|
GL.textureBinding GL.Texture2D $= Just (texId t)
|
|
|
|
unbind _ = GL.textureBinding GL.Texture2D $= Nothing
|
|
|
|
newTexture :: FilePath -> GL.GLuint -> IO (Either String Texture)
|
|
newTexture fp slot = do
|
|
|
|
eimg <- readImage fp
|
|
|
|
case eimg of
|
|
Left err ->
|
|
let mesg = ("reading file " <> fp <> " failed: " <> show err)
|
|
logIO Error (fromString mesg)
|
|
return $ Left mesg
|
|
|
|
Right rawImg -> do
|
|
|
|
-- convert image format
|
|
let img = flipVertically $ convertRGBA8 rawImg
|
|
|
|
-- extract the raw pointer from vector
|
|
unsafeWith (imageData img) $ \ptr -> do
|
|
-- create texture object
|
|
tex <- Texture
|
|
<$> GL.genObjectName
|
|
<*> (pure $ GL.TextureUnit slot)
|
|
-- <*> (pure fp)
|
|
let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img)
|
|
-- <*> (pure $ componentCount (VS.head $ imageData img))
|
|
data_ = castPtr ptr
|
|
|
|
-- bind texture
|
|
bind tex
|
|
|
|
-- set texture parameters
|
|
GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
|
|
GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)
|
|
GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
|
|
|
|
-- put data into GPU memory
|
|
loadTexture tex dimensions data_
|
|
|
|
-- unbind texture
|
|
unbind tex
|
|
|
|
-- pass texture object out
|
|
return $ Right tex
|
|
|
|
loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO ()
|
|
loadTexture tex dimensions data_ =
|
|
let (V2 w h) = dimensions
|
|
in GL.texImage2D
|
|
GL.Texture2D
|
|
GL.NoProxy
|
|
0
|
|
GL.RGBA'
|
|
(GL.TextureSize2D w h)
|
|
0
|
|
(GL.PixelData GL.RGBA GL.UnsignedByte data_)
|