sgl: avoid crashes on Mac OS X when no GL context is current

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!)
 

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))))))))
+

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.

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[]