suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

make OpenGL gears example report a good error on failure

Browse Source
This commit is contained in:
Matthew Flatt 2011-11-03 16:33:50 -06:00 committed by Matthew Flatt
parent 0f6c267798
commit 4314b2ac28
1 changed files with 13 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/sgl/examples/gears.rkt
View File

@ -45,7 +45,8 @@
(define gears-canvas% (define gears-canvas%
(class* canvas% () (class* canvas% ()
(inherit refresh with-gl-context swap-gl-buffers get-parent) (inherit refresh with-gl-context swap-gl-buffers get-parent
get-top-level-window)
(define rotation 0.0) (define rotation 0.0)
@ -231,8 +232,18 @@
(gl-vertex (* r0 cos-angle) (* r0 sin-angle) half-width))) (gl-vertex (* r0 cos-angle) (* r0 sin-angle) half-width)))
(gl-end))) (gl-end)))
(define/private (report-no-gl)
(message-box "Gears"
(string-append
"There was an error initializing OpenGL. "
"Maybe OpenGL is not supported on the current platform.")
(get-top-level-window)
'(ok stop))
(exit 1))
(define/override (on-size width height) (define/override (on-size width height)
(with-gl-context (with-gl-context
#:fail (lambda () (report-no-gl))
(lambda () (lambda ()
(unless gear1 (unless gear1
@ -301,6 +312,7 @@
;; TODO: Don't increment this infinitely. ;; TODO: Don't increment this infinitely.
(set! rotation (+ 2.0 rotation))) (set! rotation (+ 2.0 rotation)))
(with-gl-context (with-gl-context
#:fail (lambda () (report-no-gl))
(lambda () (lambda ()
(gl-clear-color 0.0 0.0 0.0 0.0) (gl-clear-color 0.0 0.0 0.0 0.0)