canvas/app/Types/Sprite.hs
2020-02-07 05:50:19 +01:00

55 lines
1.3 KiB
Haskell

module Types.Sprite where
import SDL (get, ($=))
import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLUtil
import Codec.Picture
import Linear
-- internal imports
import Classes.Renderable
data SpriteRenderObjects = SpriteRenderObjects
{ roVAO :: GL.VertexArrayObject
, roVBO :: GL.BufferObject
}
data SpriteShaderObjects = SpriteShaderobjects
{ soVertexShader :: GL.Shader
, soFragmentShader :: GL.Shader
, soProgram :: GL.Program
}
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) = do
GL.currenProgram $= Just prog
GL.bindVertexArrayObject $= Just vao
draw
(SpriteRenderObjects vao vbo)
(SpriteShaderObjects vs fs prog)
(Sprite pos@(V2 px py) img) = do
let model = mkTransformation
(Quaternion (V3 0 0 0) 1 :: Quaternion Float)
(fmap fromIntegral $ V3 px py 0 :: V3 Float)
GLU.setUniform program "model" model
uLoc <- get (GL.uniformLocation prog "model")
GL.uniform uLoc $= model
GL.drawArrays GL.Triangles 0 6
clean =
GL.currenProgram $= Nothing
GL.bindVertexArrayObject $= Nothing