canvas/app/Renderer.hs

196 lines
4.8 KiB
Haskell
Raw Normal View History

2020-02-07 23:15:53 +00:00
{-# LANGUAGE OverloadedStrings #-}
2020-02-09 01:38:02 +00:00
{-# LANGUAGE BangPatterns #-}
2020-02-06 04:11:10 +00:00
module Renderer where
import SDL (($=))
import qualified Graphics.Rendering.OpenGL as GL
2020-02-09 01:38:02 +00:00
import qualified Graphics.GL.Functions as GLRaw (glVertexAttribDivisor)
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-09 01:38:02 +00:00
import Control.Monad (replicateM)
import System.Random
2020-02-07 04:50:19 +00:00
-- internal imports
import Types
2020-02-09 01:38:02 +00:00
initSpriteRenderObjects aggModel = 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-09 01:38:02 +00:00
quadInstances <- GL.genObjectName
GL.bindBuffer GL.ArrayBuffer $= Just quadInstances
withArray aggModel $ \ptr ->
GL.bufferData GL.ArrayBuffer $=
( fromIntegral $ length aggModel * sizeOf (undefined :: Float)
, ptr
, GL.StaticDraw
)
GL.bindBuffer GL.ArrayBuffer $= Nothing
2020-02-06 04:11:10 +00:00
GL.bindBuffer GL.ArrayBuffer $= Just quadVBO
2020-02-09 01:38:02 +00:00
2020-02-06 04:11:10 +00:00
withArray rawVertices $ \ptr ->
2020-02-06 04:19:07 +00:00
GL.bufferData GL.ArrayBuffer $=
2020-02-09 01:38:02 +00:00
( fromIntegral $ length rawVertices * sizeOf (undefined :: Float)
2020-02-06 04:11:10 +00:00
, 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-09 01:38:02 +00:00
, GL.VertexArrayDescriptor 4 GL.Float 0 (nullPtr)
2020-02-06 04:11:10 +00:00
)
2020-02-09 01:38:02 +00:00
mapM_
(\intId -> do
GL.bindBuffer GL.ArrayBuffer $= Just quadInstances
GL.vertexAttribArray (GL.AttribLocation (3 + fromIntegral intId)) $=
GL.Enabled
GL.vertexAttribPointer (GL.AttribLocation (3 + fromIntegral intId)) $=
( GL.ToFloat
, GL.VertexArrayDescriptor
4
GL.Float
(fromIntegral $ 4 * 4 * (sizeOf (undefined :: GL.GLfloat)))
(nullPtr `plusPtr` (intId * 4 * sizeOf (undefined :: GL.GLfloat)))
)
GL.bindBuffer GL.ArrayBuffer $= Nothing
GLRaw.glVertexAttribDivisor (3 + fromIntegral intId) 1
)
([ 0 .. 3 ] :: [Int])
2020-02-07 23:15:53 +00:00
-- GL.bindBuffer GL.ArrayBuffer $= Nothing
2020-02-06 04:11:10 +00:00
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-07 23:15:53 +00:00
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
]
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
2020-02-07 23:15:53 +00:00
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)
2020-02-09 01:38:02 +00:00
loadSprites
:: Int
-> IO (AssetDetails SpriteRenderObjects SpriteShaderObjects Sprite)
loadSprites amount = do
2020-02-07 23:15:53 +00:00
let lookups =
[ ("lynx", "assets/img/lynx.png")
]
2020-02-09 01:38:02 +00:00
-- positions =
-- [ (V2 0 0)
-- ]
2020-02-07 06:51:31 +00:00
2020-02-07 23:15:53 +00:00
textObj <- initSpriteTextureObjects lookups
2020-02-07 06:51:31 +00:00
2020-02-09 01:38:02 +00:00
positions <- replicateM amount $ do
x <- randomRIO (-1, 1)
y <- randomRIO (-1, 1)
return (V2 x y)
sizes <- mapM
(\origSize -> do
scale <- randomRIO (0.1, (2 :: Float))
return (fmap (scale *) $
(fmap fromIntegral origSize) / (V2 980 540))
)
(replicate amount (snd $ snd $ head $ M.assocs textObj))
let aggModel :: [Float]
!aggModel = foldl
(\acc (pos@(V2 px py), size@(V2 sx sy)) ->
let qMatrix =
[ sx, 0, 0, 0
, 0, sy, 0, 0
, 0, 0, 1, 0
, fromIntegral px, fromIntegral py, 0, 1
]
in (acc ++ qMatrix)
)
[]
(zip positions sizes)
vertObj <- initSpriteRenderObjects aggModel
shadObj <- initSpriteShaderObjects
2020-02-07 06:51:31 +00:00
return AssetDetails
{ adVertObj = vertObj
, adShadObj = shadObj
2020-02-07 23:15:53 +00:00
, 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)
2020-02-07 06:51:31 +00:00
}