canvas/app/Types/Sprite.hs
2020-02-07 14:57:09 +01:00

53 lines
1.3 KiB
Haskell

{-# 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)