1#lang racket/base
2(require ffi/unsafe)
3
4;; Apple's GL implementation seg faults when GL commands are used
5;; without a context --- which is fair according to the GL spec, but
6;; not nice for Racket users. To avoid crashes, install a dummy
7;; context if none is already current. On other platforms, this
8;; module ends up doing nothing.
9
10(when (eq? (system-type) 'macosx)
11  (define agl-lib (ffi-lib "/System/Library/Frameworks/AGL.framework/AGL"))
12
13  (define _GLint _int)
14  (define _GLboolean _bool)
15  (define _AGLPixelFormat (_cpointer/null 'AGLPixelFormat))
16  (define _AGLContext (_cpointer/null 'AGLContext))
17
18  (define-syntax-rule (define-agl name type)
19    (define name (get-ffi-obj 'name agl-lib type (lambda () void))))
20
21  (define-agl aglSetCurrentContext (_fun _AGLContext -> _GLboolean))
22  (define-agl aglGetCurrentContext (_fun -> _AGLContext))
23
24  (define-agl aglChoosePixelFormat (_fun _pointer _GLint (_list i _GLint) -> _AGLPixelFormat))
25
26  (define-agl aglCreateContext (_fun _AGLPixelFormat _AGLContext -> _AGLContext))
27
28  (define AGL_NONE                   0)
29  (define AGL_RGBA                   4)
30  (define AGL_PIXEL_SIZE            50)
31  (define AGL_OFFSCREEN             53)
32
33  (unless (aglGetCurrentContext)
34    (let ([fmt (aglChoosePixelFormat
35                #f
36                0
37                (list AGL_RGBA
38                      AGL_PIXEL_SIZE 32
39                      AGL_OFFSCREEN
40                      AGL_NONE))])
41      (when fmt
42           (let ([d (aglCreateContext fmt #f)])
43             (when d
44               (void (aglSetCurrentContext d))))))))
45
46