pituicat/src/Types/Texture.hs

module Types.Texture where

import SDL (($=), get)

import qualified Graphics.Rendering.OpenGL as GL

import SDL (($=), get)

import Codec.Picture
import Codec.Picture.Extra

import Data.Vector.Storable (unsafeWith)

import Linear

import Foreign
import Foreign.Ptr

-- internal imports

import Classes.Graphics.Bindable

data Texture = Texture
  { textureId   :: GL.TextureObject
  , textureSlot :: GL.TextureUnit
  }
  deriving (Eq, Show)

instance Bindable Texture where

  bind t = do
    GL.activeTexture $= textureSlot t
    GL.textureBinding GL.Texture2D $= Just (textureId t)

  unbind t = GL.textureBinding GL.Texture2D $= Nothing

newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture)
newTexture fp slot = do

  -- read in image from filesystem
  img <- flipVertically <$> convertRGBA8 <$>
    either
      (\err -> error $ "reading image file " <> fp <> " failed: " <> err)
      id
    <$>
      readImage fp

  -- 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.Repeat)
    GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat)

    -- put data into GPU memory
    loadTexture tex dimensions data_

    -- unbind texture
    unbind tex

    -- pass texture object out
    return (fmap fromIntegral dimensions, 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_)