canvas/app/Renderer.hs

82 lines
1.8 KiB
Haskell
Raw Normal View History

2020-02-06 04:11:10 +00:00
module Renderer where
import SDL (($=))
import qualified Graphics.Rendering.OpenGL as GL
2020-02-07 13:57:09 +00:00
import qualified Graphics.GLUtil as GLU
import qualified Data.Map.Strict as M
2020-02-06 04:11:10 +00:00
2020-02-07 04:50:19 +00:00
import qualified Data.ByteString as BS
2020-02-07 13:57:09 +00:00
import Codec.Picture
import Linear
2020-02-06 04:11:10 +00:00
import Foreign
2020-02-07 04:50:19 +00:00
-- internal imports
import Types
initSpriteRenderObjects = do
2020-02-06 04:11:10 +00:00
quadVAO <- GL.genObjectName
2020-02-06 04:19:07 +00:00
quadVBO <- GL.genObjectName
2020-02-06 04:11:10 +00:00
GL.bindBuffer GL.ArrayBuffer $= Just quadVBO
withArray rawVertices $ \ptr ->
2020-02-06 04:19:07 +00:00
GL.bufferData GL.ArrayBuffer $=
2020-02-06 04:11:10 +00:00
( fromIntegral $ length rawVertices * sizeOf (0 :: Float)
, ptr
, GL.StaticDraw
)
GL.bindVertexArrayObject $= Just quadVAO
2020-02-06 04:19:07 +00:00
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
2020-02-06 04:11:10 +00:00
2020-02-06 04:19:07 +00:00
GL.vertexAttribPointer (GL.AttribLocation 0) $=
2020-02-06 04:11:10 +00:00
( GL.ToFloat
2020-02-06 04:19:07 +00:00
, GL.VertexArrayDescriptor 4 GL.Float 0 (plusPtr nullPtr 0)
2020-02-06 04:11:10 +00:00
)
GL.bindBuffer GL.ArrayBuffer $= Nothing
GL.bindVertexArrayObject $= Nothing
2020-02-07 04:50:19 +00:00
2020-02-07 13:57:09 +00:00
return (SpriteRenderObjects quadVAO quadVBO)
2020-02-06 04:11:10 +00:00
where
rawVertices :: [Float]
rawVertices =
[ 0, 1, 0, 0
, 1, 0, 1, 0
, 0, 0, 0, 0
, 0, 1, 0, 1
, 1, 1, 1, 1
, 1, 0, 1, 0
]
2020-02-07 04:50:19 +00:00
initSpriteShaderObjects = do
vertexShaderSrc <- BS.readFile "shader/vertex.sl"
fragmentShaderSrc <- BS.readFile "shader/fragment.sl"
2020-02-07 13:57:09 +00:00
shaderProgram <- GLU.simpleShaderProgramBS vertexShaderSrc fragmentShaderSrc
2020-02-07 06:51:31 +00:00
2020-02-07 13:57:09 +00:00
return (SpriteShaderObjects shaderProgram)
2020-02-07 06:51:31 +00:00
loadSprites :: IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite)
loadSprites = do
rawImg <- readImage "assets/img/lynx.jpg"
2020-02-07 13:57:09 +00:00
let img = case rawImg of
Left err -> error err
Right dynImg -> convertRGBA8 dynImg
2020-02-07 06:51:31 +00:00
vertObj <- initSpriteRenderObjects
2020-02-07 13:57:09 +00:00
shadObj <- initSpriteShaderObjects
2020-02-07 06:51:31 +00:00
return AssetDetails
{ adVertObj = vertObj
, adShadObj = shadObj
, adDataObj = M.singleton "lynx" (Sprite (V2 0 0) img)
}