File: Extensions.hs

package info (click to toggle)
haskell-glut 2.1.2.1-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 1,936 kB
  • ctags: 25
  • sloc: haskell: 10,092; sh: 2,811; ansic: 53; makefile: 2
file content (46 lines) | stat: -rw-r--r-- 1,528 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
-- #hide
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.GLUT.Extensions
-- Copyright   :  (c) Sven Panne 2002-2005
-- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
--
-- Maintainer  :  sven.panne@aedion.de
-- Stability   :  provisional
-- Portability :  portable
--
-- This is a purely internal module for handling an OpenGL-like extension
-- mechanism for GLUT.
--
--------------------------------------------------------------------------------

module Graphics.UI.GLUT.Extensions (
   FunPtr, unsafePerformIO,
   Invoker, getProcAddress, getProcAddressInternal   -- used only internally
) where

import Foreign.C.String ( CString, withCString )
import Foreign.Ptr ( FunPtr, nullFunPtr )
import System.IO.Unsafe ( unsafePerformIO )

--------------------------------------------------------------------------------

type Invoker a = FunPtr a -> a

getProcAddress :: String -> String -> IO (FunPtr a)
getProcAddress ext call =
   throwIfNull ("unknown GLUT call " ++ call ++ ", check for " ++ ext) $
      getProcAddressInternal call

throwIfNull :: String -> IO (FunPtr a) -> IO (FunPtr a)
throwIfNull msg act = do
   res <- act
   if res == nullFunPtr
      then ioError (userError msg)
      else return res

getProcAddressInternal :: String -> IO (FunPtr a)
getProcAddressInternal call = withCString call hs_GLUT_getProcAddress

foreign import ccall unsafe "hs_GLUT_getProcAddress" hs_GLUT_getProcAddress
   :: CString -> IO (FunPtr a)