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