46 lines
1.5 KiB
Racket
46 lines
1.5 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe)
|
|
|
|
;; Apple's GL implementation seg faults when GL commands are used
|
|
;; without a context --- which is fair according to the GL spec, but
|
|
;; not nice for Racket users. To avoid crashes, install a dummy
|
|
;; context if none is already current. On other platforms, this
|
|
;; module ends up doing nothing.
|
|
|
|
(when (eq? (system-type) 'macosx)
|
|
(define agl-lib (ffi-lib "/System/Library/Frameworks/AGL.framework/AGL"))
|
|
|
|
(define _GLint _int)
|
|
(define _GLboolean _bool)
|
|
(define _AGLPixelFormat (_cpointer/null 'AGLPixelFormat))
|
|
(define _AGLContext (_cpointer/null 'AGLContext))
|
|
|
|
(define-syntax-rule (define-agl name type)
|
|
(define name (get-ffi-obj 'name agl-lib type (lambda () void))))
|
|
|
|
(define-agl aglSetCurrentContext (_fun _AGLContext -> _GLboolean))
|
|
(define-agl aglGetCurrentContext (_fun -> _AGLContext))
|
|
|
|
(define-agl aglChoosePixelFormat (_fun _pointer _GLint (_list i _GLint) -> _AGLPixelFormat))
|
|
|
|
(define-agl aglCreateContext (_fun _AGLPixelFormat _AGLContext -> _AGLContext))
|
|
|
|
(define AGL_NONE 0)
|
|
(define AGL_RGBA 4)
|
|
(define AGL_PIXEL_SIZE 50)
|
|
(define AGL_OFFSCREEN 53)
|
|
|
|
(unless (aglGetCurrentContext)
|
|
(let ([fmt (aglChoosePixelFormat
|
|
#f
|
|
0
|
|
(list AGL_RGBA
|
|
AGL_PIXEL_SIZE 32
|
|
AGL_OFFSCREEN
|
|
AGL_NONE))])
|
|
(and fmt
|
|
(let ([d (aglCreateContext fmt #f)])
|
|
(when d
|
|
(void (aglSetCurrentContext d))))))))
|
|
|