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

gtk: more gl

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-13 12:01:45 -06:00
parent 1a2ffacbbe
commit b2981f05b2
7 changed files with 51 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/games/gl-board-game/gl-board.rkt
View File

@ -427,15 +427,14 @@
(let ([cfg (new gl-config%)])
(send cfg set-multisample-size 4)
(send cfg set-stencil-size 1)
(super-new (style '(no-autoclear)) (gl-config cfg)))
(super-new (style '(gl no-autoclear)) (gl-config cfg)))
(unless (send (get-dc) get-gl-context)
(message-box "Error"
(format (string-append
"~a requires OpenGL, but there was an error initializing"
" the OpenGL context. Probably OpenGL is not supported by"
" the current display, or it was disabled when PLT Scheme was"
" configured and compiled.")
" the OpenGL context. Maybe OpenGL is not supported by"
" the current display.")
who)
#f
'(ok stop))

7
collects/games/jewel/jewel.scm
View File

@ -310,15 +310,14 @@
(let ([cfg (new gl-config%)])
(send cfg set-multisample-size 4)
(send cfg set-stencil-size 1)
(super-new (style '(no-autoclear)) (gl-config cfg)))
(super-new (style '(gl no-autoclear)) (gl-config cfg)))
(inherit get-dc)
(unless (send (get-dc) get-gl-context)
(message-box "Error"
(string-append "Jewel requires OpenGL, but there was an error initializing"
" the OpenGL context. Probably OpenGL is not supported by"
" the current display, or it was disabled when PLT Scheme was"
" configured and compiled.")
" the OpenGL context. Maybe OpenGL is not supported by"
" the current display.")
#f
'(ok stop))
(exit))

9
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -17,6 +17,7 @@
"client-window.rkt"
"widget.rkt"
"dc.rkt"
"gl-context.rkt"
"combo.rkt"
"pixbuf.rkt"
"gcwin.rkt")
@ -186,7 +187,7 @@
x y w h
style
[ignored-name #f]
[gl-conf #f])
[gl-config #f])
(inherit get-gtk set-size get-size get-client-size
on-size get-top-win
@ -286,6 +287,9 @@
(define dc (new dc% [canvas this]))
(when (memq 'gl style)
(prepare-widget-gl-context client-gtk gl-config))
(gtk_widget_realize gtk)
(gtk_widget_realize client-gtk)
@ -337,9 +341,6 @@
(define/override (get-client-gtk) client-gtk)
(define/override (handles-events? gtk) (not (ptr-equal? gtk combo-button-gtk)))
(define gl-config gl-conf)
(define/public (get-gl-config) gl-config)
(define/override (get-client-delta)
(values margin margin))

6
collects/mred/private/wx/gtk/dc.rkt
View File

@ -86,9 +86,9 @@
(define gl #f)
(define/override (get-gl-context)
(or gl
(create-widget-gl-context
(send canvas get-client-gtk)
(send canvas get-gl-config))))
(let ([v (create-widget-gl-context (send canvas get-client-gtk))])
(when v (set! gl v))
v)))
(define/override (make-backing-bitmap w h)
(cond

62
collects/mred/private/wx/gtk/gl-context.rkt
View File

@ -7,7 +7,8 @@
"types.rkt"
"utils.rkt")
(provide create-widget-gl-context)
(provide prepare-widget-gl-context
create-widget-gl-context)
(define gdkglext-lib
(ffi-lib "libgdkglext-x11-1.0" '("0")))
@ -30,6 +31,7 @@
(define-gtkglext gdk_gl_config_new (_fun (_list i _int) -> (_or-null _GdkGLConfig)))
(define-gtkglext gdk_gl_config_new_for_screen (_fun _GdkScreen (_list i _int) -> (_or-null _GdkGLConfig)))
(define-gtk gtk_widget_get_screen (_fun _GtkWidget -> _GdkScreen))
(define-gtkglext gtk_widget_set_gl_capability (_fun _GtkWidget
@ -73,18 +75,20 @@
;; ----------------------------------------
(define (config->GdkGLConfig d conf)
(gdk_gl_config_new_for_screen d
(list GDK_GL_USE_GL 1
GDK_GL_DOUBLEBUFFER (if (send conf get-double-buffered) 1 0)
GDK_GL_STEREO (if (send conf get-stereo) 1 0)
GDK_GL_DEPTH_SIZE (send conf get-depth-size)
GDK_GL_STENCIL_SIZE (send conf get-stencil-size)
GDK_GL_ACCUM_RED_SIZE (send conf get-accum-size)
GDK_GL_ACCUM_GREEN_SIZE (send conf get-accum-size)
GDK_GL_ACCUM_BLUE_SIZE (send conf get-accum-size)
GDK_GL_ACCUM_ALPHA_SIZE (send conf get-accum-size)
GDK_GL_SAMPLES (send conf get-multisample-size)
GDK_GL_ATTRIB_LIST_NONE 0)))
(gdk_gl_config_new (append
(list GDK_GL_RGBA)
(if (send conf get-double-buffered) (list GDK_GL_DOUBLEBUFFER) null)
(if (send conf get-stereo) (list GDK_GL_STEREO) null)
(list
GDK_GL_DEPTH_SIZE (send conf get-depth-size)
GDK_GL_STENCIL_SIZE (send conf get-stencil-size)
GDK_GL_ACCUM_RED_SIZE (send conf get-accum-size)
GDK_GL_ACCUM_GREEN_SIZE (send conf get-accum-size)
GDK_GL_ACCUM_BLUE_SIZE (send conf get-accum-size)
GDK_GL_ACCUM_ALPHA_SIZE (send conf get-accum-size))
#;
(list GDK_GL_SAMPLES (send conf get-multisample-size))
(list GDK_GL_ATTRIB_LIST_NONE))))
;; ----------------------------------------
@ -96,7 +100,7 @@
(define/override (draw:do-call-as-current t)
(dynamic-wind
(lambda ()
(gdk_gl_drawable_gl_begin gl drawable))
(gdk_gl_drawable_gl_begin drawable gl))
t
(lambda ()
(gdk_gl_drawable_gl_end drawable))))
@ -114,19 +118,23 @@
(set! inited? #t)
(gdk_gl_init 0 #f)))
(define (create-widget-gl-context gtk config)
(define (prepare-widget-gl-context gtk config)
(init!)
(let ([config (config->GdkGLConfig (gtk_widget_get_screen gtk)
(let ([config (config->GdkGLConfig #f ; (gtk_widget_get_screen gtk)
(or config
(new gl-config%)))])
(and config
(gtk_widget_set_gl_capability gtk
config
#f
#t
#f)
(let ([gl (gtk_widget_get_gl_context gtk)])
(and gl
(new gl-context%
[gl gl]
[drawable (gtk_widget_get_gl_window gtk)]))))))
(when config
(gtk_widget_set_gl_capability gtk
config
#f
#t
0))))
(define (create-widget-gl-context gtk)
(init!)
(let ([gl (gtk_widget_get_gl_context gtk)])
(and gl
(new gl-context%
[gl gl]
[drawable (gtk_widget_get_gl_window gtk)]))))

2
collects/racket/draw/gl-config.rkt
View File

@ -11,7 +11,7 @@
(define/public (get-double-buffered) double-buffered?)
(define/public (set-double-buffered v) (set! double-buffered? (and v #t)))
(define stereo? #t)
(define stereo? #f)
(define/public (get-stereo) stereo?)
(define/public (set-stereo v) (set! stereo? (and v #t)))

2
collects/racket/draw/gl-context.rkt
View File

@ -19,7 +19,7 @@
;; Implemented by subclasses:
(defclass gl-context% object%
(define lock-thread #f)
(define lock (make-semaphore))
(define lock (make-semaphore 1))
(define/private (with-gl-lock t)
(if (eq? lock-thread (current-thread))