preapare for textures

This commit is contained in:
nek0 2020-12-07 00:26:17 +01:00
parent e3fd34731b
commit ec087113f8
1 changed files with 93 additions and 0 deletions

View File

@ -0,0 +1,93 @@
{-# 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_)