{-# 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 , spriteSize :: V2 Int } instance Renderable Sprite where type VertexObjects Sprite = SpriteRenderObjects type ShaderObjects Sprite = SpriteShaderObjects init (SpriteRenderObjects vao vbo) (SpriteShaderObjects prog) texture _ = do GL.currentProgram $= Just (GLU.program prog) GL.bindVertexArrayObject $= Just vao GL.activeTexture $= GL.TextureUnit 0 GL.textureBinding GL.Texture2D $= Just texture GL.clearColor $= GL.Color4 1 1 1 1 -- let projection = ortho (-960) 960 (-540) 540 (-1) 1 :: M44 Float -- GLU.setUniform prog "projection" (projection) draw (SpriteRenderObjects vao vbo) (SpriteShaderObjects prog) (Sprite pos@(V2 px py) size) = do let (V2 sx sy) = fmap fromIntegral size model = fmap (fmap fromIntegral) $ V4 (V4 sx 0 0 px) (V4 0 sy 0 py) (V4 0 0 1 0) (V4 0 0 0 1) :: M44 Float projection = ortho (-960) 960 (-540) 540 (-1) 1 -- putStrLn $ show model GLU.setUniform prog "pm" (projection !*! model) GL.drawArrays GL.Triangles 0 6 clean _ = do GL.currentProgram $= (Nothing :: Maybe GL.Program) GL.bindVertexArrayObject $= (Nothing :: Maybe GL.VertexArrayObject) GL.texture GL.Texture2D $= GL.Disabled