canvas/app/Renderer.hs

{-# 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)
    }