Renderer.hs

module Glest.Renderer (
  testRenderer
) where

import Foreign
import Foreign.C.String
import Glest.Egl
import Graphics.GL.Embedded20
import Graphics.GL.Types
import Language.C.Inline (withPtr_)
import Quasar.Prelude

testRenderer :: IO ()
testRenderer = do
  initializeRenderer
  renderToDmabuf

initializeRenderer :: IO ()
initializeRenderer = do
  initializeEgl
  vendor <- glGetString' GL_VENDOR
  renderer <- glGetString' GL_RENDERER
  version <- glGetString' GL_VERSION
  shadingLanguageVersion <- glGetString' GL_SHADING_LANGUAGE_VERSION
  extensionsString <- glGetString' GL_EXTENSIONS
  traceIO $ "GL vendor: " <> vendor
  traceIO $ "GL renderer: " <> renderer
  traceIO $ "GL version: " <> version
  traceIO $ "GL shading language version: " <> shadingLanguageVersion
  traceIO $ "GL extensions: " <> extensionsString

glGetString' :: GLenum -> IO String
glGetString' name = peekCString . castPtr =<< glGetString name


renderToDmabuf :: IO ()
renderToDmabuf = do
  texture <- genTexture
  glBindTexture GL_TEXTURE_2D texture
  let
    width = 512
    height = 512
  glTexImage2D GL_TEXTURE_2D 0 GL_RGBA width height 0 GL_RGBA GL_UNSIGNED_BYTE nullPtr
  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST
  glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST

  framebuffer <- alloca \ptr -> do
    glGenFramebuffers 1 ptr
    peek ptr
  traceIO $ mconcat ["Generated framebuffer@", show framebuffer]

  glBindFramebuffer GL_FRAMEBUFFER framebuffer
  glFramebufferTexture2D GL_FRAMEBUFFER GL_COLOR_ATTACHMENT0 GL_TEXTURE_2D texture 0

  glClearColor 1 0 1 1
  glClear GL_COLOR_BUFFER_BIT

  logErrors


genTexture :: IO GLuint
genTexture = do
  texture <- alloca \ptr -> do
    glGenTextures 1 ptr
    peek ptr
  traceIO $ mconcat ["Generated texture@", show texture]
  pure texture

logErrors :: IO ()
logErrors = do
  err <- glGetError
  unless (err == GL_NO_ERROR) do
    traceIO $ errorMessage err
    logErrors

errorMessage :: GLenum -> String
errorMessage GL_NO_ERROR = "GL_NO_ERROR"
errorMessage GL_INVALID_ENUM = "GL_INVALID_ENUM"
errorMessage GL_INVALID_VALUE = "GL_INVALID_VALUE"
errorMessage GL_INVALID_OPERATION = "GL_INVALID_OPERATION"
errorMessage GL_INVALID_FRAMEBUFFER_OPERATION = "GL_INVALID_FRAMEBUFFER_OPERATION"
errorMessage GL_OUT_OF_MEMORY = "GL_OUT_OF_MEMORY"
errorMessage _ = "Invalid GL error number"