Image.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Aztecs.GL.D2.Image (Image (..), loadImage, TextureFilter (..)) where

import Aztecs
import Aztecs.GL.D2.Image.Internal
import Aztecs.GL.Internal
import Aztecs.Transform
import qualified Codec.Picture as JP
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.ByteString as BS
import qualified Data.Vector.Storable as VS
import Foreign
import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import Graphics.Rendering.OpenGL.GL (TextureFilter (..))
import Prelude hiding (lookup)

-- | Image component
data Image = Image
  { -- | Image source data
    imageData :: JP.Image JP.PixelRGBA8,
    -- | Image texture filtering mode
    imageFilter :: !TextureFilter
  }

instance (MonadIO m) => Component m Image where
  componentOnInsert e img = inAnyWindowContext $ do
    let w = JP.imageWidth $ imageData img
        h = JP.imageHeight $ imageData img
        pixels = JP.imageData $ imageData img
        imgData = BS.pack $ VS.toList pixels

    res <- liftIO $ GL.genObjectNames 1
    tex <- case res of
      [tex] -> return tex
      _ -> error "Failed to generate texture object"

    liftIO $ do
      GL.textureBinding GL.Texture2D $= Just tex

      -- Set texture parameters (use Nearest filtering for crisp pixel art)
      GL.textureFilter GL.Texture2D $= ((imageFilter img, Nothing), imageFilter img)
      GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat)
      GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat)

      -- Upload texture data
      BS.useAsCString imgData $ \ptr -> do
        GL.texImage2D
          GL.Texture2D
          GL.NoProxy
          0
          GL.RGBA8
          (GL.TextureSize2D (fromIntegral w) (fromIntegral h))
          0
          (GL.PixelData GL.RGBA GL.UnsignedByte (castPtr ptr))
      GL.textureBinding GL.Texture2D $= Nothing
    insert e . bundle $ ImageState tex (V2 (fromIntegral w) (fromIntegral h))

loadImage :: FilePath -> IO Image
loadImage path = do
  eImg <- JP.readImage path
  case eImg of
    Left err -> error $ "Failed to load image: " ++ err
    Right dynImg -> let img = JP.convertRGBA8 dynImg in return $ Image img GL.Nearest