glfw_test.c

#include <stdio.h>

int glfwInit();
void glfwOpenWindowHint(int, int);
int glfwOpenWindow(int, int, int, int, int, int, int, int, int);
const unsigned char * glGetString(unsigned int);
void glfwTerminate();

int main()
{
  glfwInit();
  glfwOpenWindowHint(0x00020014, 3);
  glfwOpenWindowHint(0x00020015, 2);
  glfwOpenWindowHint(0x00020018, 0x00050001);
  glfwOpenWindow(640, 640, 0, 0, 0, 0, 24, 8, 0x00010001);

  printf("%s\n", glGetString(0x1F01));

  glfwTerminate();

  return 0;
}

glfw_test.hs

{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr

foreign import ccall unsafe glfwInit :: IO CInt
foreign import ccall unsafe glfwOpenWindowHint :: CInt -> CInt -> IO ()
foreign import ccall unsafe glfwOpenWindow :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
foreign import ccall unsafe glGetString :: CUInt -> IO (Ptr CUChar)
foreign import ccall unsafe glfwTerminate :: IO ()

main :: IO ()
main = do
  glfwInit
  glfwOpenWindowHint 0x00020014 3
  glfwOpenWindowHint 0x00020015 2
  glfwOpenWindowHint 0x00020018 0x00050001
  glfwOpenWindow 640 640 0 0 0 0 24 8 0x00010001

  glGetString 0x1F01 >>= (peekCString . castPtr) >>= putStrLn

  glfwTerminate

glfw_test_threaded.hs

{-# LANGUAGE ForeignFunctionInterface #-}

import Control.Concurrent
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr

foreign import ccall unsafe glfwInit :: IO CInt
foreign import ccall unsafe glfwOpenWindowHint :: CInt -> CInt -> IO ()
foreign import ccall unsafe glfwOpenWindow :: CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
foreign import ccall unsafe glGetString :: CUInt -> IO (Ptr CUChar)
foreign import ccall unsafe glfwTerminate :: IO ()

thread :: MVar () -> IO ()
thread v = do
  glfwInit
  glfwOpenWindowHint 0x00020014 3
  glfwOpenWindowHint 0x00020015 2
  glfwOpenWindowHint 0x00020018 0x00050001
  glfwOpenWindow 640 640 0 0 0 0 24 8 0x00010001

  glGetString 0x1F01 >>= (peekCString . castPtr) >>= putStrLn

  glfwTerminate
  
  putMVar v ()

main :: IO ()
main = do
  v <- newEmptyMVar
  forkOS (thread v)
  takeMVar v