canvas/app/Types/Sprite.hs

{-# LANGUAGE TypeFamilies #-}
module Types.Sprite where

import SDL (get, ($=))

import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLU

import Codec.Picture

import Linear

-- internal imports

import Classes.Renderable

data SpriteRenderObjects = SpriteRenderObjects
  { roVAO :: GL.VertexArrayObject
  , roVBO :: GL.BufferObject
  }

data SpriteShaderObjects = SpriteShaderObjects
  { soProgram        :: GLU.ShaderProgram
  }

data Sprite = Sprite
  { spritePosition :: V2 Int
  , spriteImage    :: Image PixelRGBA8
  }

instance Renderable Sprite where
  type VertexObjects Sprite = SpriteRenderObjects

  type ShaderObjects Sprite = SpriteShaderObjects

  init (SpriteRenderObjects vao vbo) (SpriteShaderObjects prog) _ = do
    GL.currentProgram $= Just (GLU.program prog)
    GL.bindVertexArrayObject $= Just vao

  draw
    (SpriteRenderObjects vao vbo)
    (SpriteShaderObjects prog)
    (Sprite pos@(V2 px py) img) = do
      let model = mkTransformation
            (Quaternion 1 (V3 0 0 0) :: Quaternion Float)
            (fmap fromIntegral $ V3 px py 0 :: V3 Float)
      GLU.setUniform prog "model" model
      GL.drawArrays GL.Triangles 0 6

  clean _ = do
    GL.currentProgram $= (Nothing :: Maybe GL.Program)
    GL.bindVertexArrayObject $= (Nothing :: Maybe GL.VertexArrayObject)