Main.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Main ( main ) where

import Foreign.C.String
import Data.Bits
import Control.Concurrent
import Control.Exception
import Graphics.Caramia
import Graphics.Caramia.Prelude hiding ( init )
import Graphics.UI.SDL
import System.IO.Unsafe ( unsafePerformIO )
import Test.Framework
import Test.Framework.Providers.HUnit

sdlLock :: MVar ()
sdlLock = unsafePerformIO $ newMVar ()
{-# NOINLINE sdlLock #-}

setup :: IO a -> IO a
setup action = runInBoundThread $ withMVar sdlLock $ \_ -> withCString "shader" $ \cstr -> do
    _ <- init SDL_INIT_VIDEO
    _ <- glSetAttribute SDL_GL_CONTEXT_MAJOR_VERSION 3
    _ <- glSetAttribute SDL_GL_CONTEXT_MINOR_VERSION 3
    _ <- glSetAttribute SDL_GL_CONTEXT_PROFILE_MASK SDL_GL_CONTEXT_PROFILE_CORE
    _ <- glSetAttribute SDL_GL_CONTEXT_FLAGS SDL_GL_CONTEXT_DEBUG_FLAG
    w <- createWindow cstr SDL_WINDOWPOS_UNDEFINED SDL_WINDOWPOS_UNDEFINED
                           1500 1000
                           (SDL_WINDOW_OPENGL .|.
                            SDL_WINDOW_SHOWN)
    ctx <- glCreateContext w
    finally (giveContext action) $ do
        glDeleteContext ctx
        destroyWindow w
        quit

main :: IO ()
main = defaultMain tests

tests :: [Test]
tests = [
    testCase "I can create the nop shader pipeline" nopPipelineTest
    ]

nopPipelineTest :: IO ()
nopPipelineTest = setup $ do
    x <- nopPipeline
    x `seq` return ()