diff --git a/collects/sgl/gl.rkt b/collects/sgl/gl.rkt index 802dcca43c..6a2b014909 100644 --- a/collects/sgl/gl.rkt +++ b/collects/sgl/gl.rkt @@ -1,7 +1,8 @@ #lang mzscheme (require mzlib/foreign "gl-types.rkt" - "gl-vectors.rkt") + "gl-vectors.rkt" + "init.rkt") (unsafe!) diff --git a/collects/sgl/init.rkt b/collects/sgl/init.rkt new file mode 100644 index 0000000000..b1e59487ad --- /dev/null +++ b/collects/sgl/init.rkt @@ -0,0 +1,45 @@ +#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)))))))) + diff --git a/collects/sgl/scribblings/init.scrbl b/collects/sgl/scribblings/init.scrbl new file mode 100644 index 0000000000..d09ecbf290 --- /dev/null +++ b/collects/sgl/scribblings/init.scrbl @@ -0,0 +1,17 @@ +#lang scribble/doc +@(require "common.rkt" (for-label racket/class)) + +@title[#:tag "init"]{Initialization} + +@defmodule[sgl/init] + +Requiring the @racketmodname[sgl/init] library initializes +platform-specific OpenGL state to help avoid crashes when OpenGL +commands are incorrectly used without a current context. This library +is @racket[require]d by @racketmodname[sgl] and +@racketmodname[sgl/gl], so it normally does not need to be +@racket[require]d explicitly. + +On Mac OS X, @racketmodname[sgl/init] checks whether any GL context is +current, and if not, it creates a dummy context and sets it as the +current context. diff --git a/collects/sgl/scribblings/sgl.scrbl b/collects/sgl/scribblings/sgl.scrbl index 0985463311..03771b43f5 100644 --- a/collects/sgl/scribblings/sgl.scrbl +++ b/collects/sgl/scribblings/sgl.scrbl @@ -23,5 +23,6 @@ method. @include-section["main.scrbl"] @include-section["gl-vectors.scrbl"] @include-section["bitmap.scrbl"] +@include-section["init.scrbl"] @index-section[]