123 lines
3 KiB
Haskell
123 lines
3 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
module Renderer where
|
|
|
|
import SDL (($=))
|
|
|
|
import qualified Graphics.Rendering.OpenGL as GL
|
|
import qualified Graphics.GLUtil as GLU
|
|
|
|
import qualified Data.Map.Strict as M
|
|
|
|
import qualified Data.ByteString as BS
|
|
|
|
import Codec.Picture
|
|
|
|
import Linear
|
|
|
|
import Foreign
|
|
|
|
-- internal imports
|
|
|
|
import Types
|
|
|
|
initSpriteRenderObjects = do
|
|
quadVAO <- GL.genObjectName
|
|
quadVBO <- GL.genObjectName
|
|
|
|
GL.bindBuffer GL.ArrayBuffer $= Just quadVBO
|
|
withArray rawVertices $ \ptr ->
|
|
GL.bufferData GL.ArrayBuffer $=
|
|
( fromIntegral $ length rawVertices * sizeOf (0 :: Float)
|
|
, ptr
|
|
, GL.StaticDraw
|
|
)
|
|
|
|
GL.bindVertexArrayObject $= Just quadVAO
|
|
|
|
GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
|
|
|
|
GL.vertexAttribPointer (GL.AttribLocation 0) $=
|
|
( GL.ToFloat
|
|
, GL.VertexArrayDescriptor 4 GL.Float 0 (plusPtr nullPtr 0)
|
|
)
|
|
|
|
-- GL.bindBuffer GL.ArrayBuffer $= Nothing
|
|
GL.bindVertexArrayObject $= Nothing
|
|
|
|
return (SpriteRenderObjects quadVAO quadVBO)
|
|
|
|
rawVertices :: [Float]
|
|
rawVertices =
|
|
[ 0, 1, 0, 1
|
|
, 1, 0, 1, 0
|
|
, 0, 0, 0, 0
|
|
|
|
, 0, 1, 0, 1
|
|
, 1, 1, 1, 1
|
|
, 1, 0, 1, 0
|
|
]
|
|
|
|
initSpriteShaderObjects = do
|
|
vertexShaderSrc <- BS.readFile "shader/vertex.sl"
|
|
fragmentShaderSrc <- BS.readFile "shader/fragment.sl"
|
|
|
|
shaderProgram <- GLU.simpleShaderProgramBS vertexShaderSrc fragmentShaderSrc
|
|
|
|
return (SpriteShaderObjects shaderProgram)
|
|
|
|
initSpriteTextureObjects
|
|
:: [(String, FilePath)]
|
|
-> IO (M.Map AssetId (GL.TextureObject, V2 Int))
|
|
initSpriteTextureObjects lookupList = do
|
|
M.fromList <$> mapM
|
|
(\(name, fp) -> do
|
|
-- texture <- Gl.genObjectName
|
|
-- GL.bindBuffer GL.ArrayBuffer $= Just texture
|
|
-- withArray rawVertices $ \ptr ->
|
|
-- GL.bufferData GL.ArrayBuffer $=
|
|
-- ( fromIntegral $ length rawVertices * sizeof (0 :: Float)
|
|
-- , ptr
|
|
-- , GL.StaticDraw
|
|
-- )
|
|
-- GL.vertexAttribPointer (GL.AttribLocation 1) $=
|
|
-- ( GL.ToFloat
|
|
-- , GL.VertexArrayDescriptor 2 GL.Float 0 (plusPtr nullPtr 0)
|
|
-- )
|
|
ts <- loadTex fp
|
|
return (name, ts)
|
|
)
|
|
lookupList
|
|
|
|
loadTex :: FilePath -> IO (GL.TextureObject, V2 Int)
|
|
loadTex fp = do
|
|
t <- either error id <$> GLU.readTexture fp
|
|
img <- convertRGBA8 <$> either error id <$> readImage fp
|
|
let size = V2 (imageWidth img) (imageHeight img)
|
|
return (t, size)
|
|
|
|
loadSprites :: IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite)
|
|
loadSprites = do
|
|
let lookups =
|
|
[ ("lynx", "assets/img/lynx.png")
|
|
]
|
|
positions =
|
|
[ (V2 0 0)
|
|
]
|
|
|
|
vertObj <- initSpriteRenderObjects
|
|
shadObj <- initSpriteShaderObjects
|
|
textObj <- initSpriteTextureObjects lookups
|
|
|
|
return AssetDetails
|
|
{ adVertObj = vertObj
|
|
, adShadObj = shadObj
|
|
, adTextObj = M.fromList $ map (\(k, v) -> (k, fst v)) (M.assocs textObj)
|
|
, adDataObj = M.fromList $
|
|
map
|
|
(\(k, v) ->
|
|
( k
|
|
, map (\pos -> Sprite pos (snd v)) positions
|
|
)
|
|
)
|
|
(M.assocs textObj)
|
|
}
|