85 lines
2.3 KiB
Haskell
85 lines
2.3 KiB
Haskell
{-# LANGUAGE TypeFamilies #-}
|
|
module Types.Sprite where
|
|
|
|
import Data.Maybe (maybe)
|
|
import qualified Data.Map.Strict as M
|
|
|
|
import SDL (get, ($=))
|
|
|
|
import qualified Graphics.Rendering.OpenGL as GL
|
|
import qualified Graphics.GL.Core33 as GLRaw
|
|
-- import qualified Graphics.GLUtil as GLU
|
|
|
|
import Codec.Picture
|
|
|
|
import Linear
|
|
|
|
import Foreign.Ptr
|
|
|
|
import Foreign.Marshal.Utils (with)
|
|
|
|
import Unsafe.Coerce (unsafeCoerce)
|
|
|
|
-- internal imports
|
|
|
|
import Classes.Renderable
|
|
import Types.CanvasShader
|
|
|
|
data SpriteRenderObjects = SpriteRenderObjects
|
|
{ roVAO :: GL.VertexArrayObject
|
|
, roVBO :: GL.BufferObject
|
|
}
|
|
|
|
data SpriteShaderObjects = SpriteShaderObjects
|
|
{ soProgram :: CanvasShader
|
|
}
|
|
|
|
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 (CanvasShader att uni prog))
|
|
texture
|
|
_ = do
|
|
GL.currentProgram $= Just prog
|
|
GL.bindVertexArrayObject $= Just vao
|
|
GL.activeTexture $= GL.TextureUnit 0
|
|
GL.textureBinding GL.Texture2D $= Just texture
|
|
-- let projection = ortho (-960) 960 (-540) 540 (-1) 1 :: M44 Float
|
|
-- GLU.setUniform prog "projection" (projection)
|
|
|
|
draw
|
|
(SpriteRenderObjects vao vbo)
|
|
(SpriteShaderObjects (CanvasShader att uni 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
|
|
maybe
|
|
(const (putStrLn warn >> return ()))
|
|
(flip asUniform . fst)
|
|
(M.lookup "pm" uni)
|
|
(projection !*! model)
|
|
GL.drawArrays GL.Triangles 0 6
|
|
where
|
|
warn = "WARNING: uniform pm is not active"
|
|
v `asUniform` loc = with v $ GLRaw.glUniformMatrix4fv (unsafeCoerce loc) 1 1 . castPtr
|
|
|
|
clean _ = do
|
|
GL.currentProgram $= (Nothing :: Maybe GL.Program)
|
|
GL.bindVertexArrayObject $= (Nothing :: Maybe GL.VertexArrayObject)
|
|
GL.texture GL.Texture2D $= GL.Disabled
|