From 1a2ffacbbe811113db305d3cb269fdcb5e6ad024 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 13 Oct 2010 10:49:54 -0600 Subject: [PATCH] gtk: first cut at gl support --- collects/mred/private/kernel.rkt | 5 - collects/mred/private/wx/cocoa/platform.rkt | 1 - collects/mred/private/wx/common/gl-config.rkt | 20 --- collects/mred/private/wx/gtk/canvas.rkt | 5 +- collects/mred/private/wx/gtk/dc.rkt | 8 + collects/mred/private/wx/gtk/gl-context.rkt | 139 ++++++++++++++++-- collects/mred/private/wx/gtk/platform.rkt | 2 - collects/mred/private/wx/gtk/procs.rkt | 2 - collects/mred/private/wx/gtk/types.rkt | 2 + collects/mred/private/wx/gtk/utils.rkt | 4 + collects/mred/private/wx/platform.rkt | 1 - collects/mred/private/wx/win32/platform.rkt | 1 - collects/racket/draw.rkt | 8 +- collects/racket/draw/dc.rkt | 8 +- collects/racket/draw/gl-config.rkt | 36 +++++ collects/racket/draw/gl-context.rkt | 52 +++++++ 16 files changed, 248 insertions(+), 46 deletions(-) delete mode 100644 collects/mred/private/wx/common/gl-config.rkt create mode 100644 collects/racket/draw/gl-config.rkt create mode 100644 collects/racket/draw/gl-context.rkt diff --git a/collects/mred/private/kernel.rkt b/collects/mred/private/kernel.rkt index 61b01afc5a..5680a68440 100644 --- a/collects/mred/private/kernel.rkt +++ b/collects/mred/private/kernel.rkt @@ -5,25 +5,20 @@ "wx/common/queue.rkt" "wx/common/clipboard.rkt" "wx/common/cursor.rkt" - "wx/common/gl-config.rkt" "wx/common/procs.rkt" "wx/common/handlers.rkt" racket/class racket/draw) -(define gl-context<%> (class->interface gl-context%)) - (define (key-symbol-to-integer k) (error 'key-symbol-to-integer "not yet implemented")) (provide (all-from-out "wx/platform.rkt") clipboard<%> - gl-context<%> (all-from-out "wx/common/event.rkt" "wx/common/timer.rkt" "wx/common/clipboard.rkt" "wx/common/cursor.rkt" - "wx/common/gl-config.rkt" "wx/common/procs.rkt") (all-from-out racket/draw) diff --git a/collects/mred/private/wx/cocoa/platform.rkt b/collects/mred/private/wx/cocoa/platform.rkt index 24805c7e45..60e8507e2f 100644 --- a/collects/mred/private/wx/cocoa/platform.rkt +++ b/collects/mred/private/wx/cocoa/platform.rkt @@ -37,7 +37,6 @@ dialog% frame% gauge% - gl-context% group-panel% item% list-box% diff --git a/collects/mred/private/wx/common/gl-config.rkt b/collects/mred/private/wx/common/gl-config.rkt deleted file mode 100644 index d6064277bd..0000000000 --- a/collects/mred/private/wx/common/gl-config.rkt +++ /dev/null @@ -1,20 +0,0 @@ -#lang scheme/base -(require scheme/class - "../../syntax.rkt") - -(provide gl-config%) - -(defclass gl-config% object% - (def/public-unimplemented get-double-buffered) - (def/public-unimplemented set-double-buffered) - (def/public-unimplemented get-stereo) - (def/public-unimplemented set-stereo) - (def/public-unimplemented get-stencil-size) - (def/public-unimplemented set-stencil-size) - (def/public-unimplemented get-accum-size) - (def/public-unimplemented set-accum-size) - (def/public-unimplemented get-depth-size) - (def/public-unimplemented set-depth-size) - (def/public-unimplemented get-multisample-size) - (def/public-unimplemented set-multisample-size) - (super-new)) diff --git a/collects/mred/private/wx/gtk/canvas.rkt b/collects/mred/private/wx/gtk/canvas.rkt index 8393b6de98..0f84f0ade3 100644 --- a/collects/mred/private/wx/gtk/canvas.rkt +++ b/collects/mred/private/wx/gtk/canvas.rkt @@ -186,7 +186,7 @@ x y w h style [ignored-name #f] - [gl-config #f]) + [gl-conf #f]) (inherit get-gtk set-size get-size get-client-size on-size get-top-win @@ -337,6 +337,9 @@ (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)) diff --git a/collects/mred/private/wx/gtk/dc.rkt b/collects/mred/private/wx/gtk/dc.rkt index 8265735ce2..e6421f3b47 100644 --- a/collects/mred/private/wx/gtk/dc.rkt +++ b/collects/mred/private/wx/gtk/dc.rkt @@ -6,6 +6,7 @@ "window.rkt" "x11.rkt" "win32.rkt" + "gl-context.rkt" "../../lock.rkt" "../common/backing-dc.rkt" racket/draw/cairo @@ -82,6 +83,13 @@ (super-new) + (define gl #f) + (define/override (get-gl-context) + (or gl + (create-widget-gl-context + (send canvas get-client-gtk) + (send canvas get-gl-config)))) + (define/override (make-backing-bitmap w h) (cond [(and (eq? 'unix (system-type)) diff --git a/collects/mred/private/wx/gtk/gl-context.rkt b/collects/mred/private/wx/gtk/gl-context.rkt index ba5d78e00f..0ef54f59f3 100644 --- a/collects/mred/private/wx/gtk/gl-context.rkt +++ b/collects/mred/private/wx/gtk/gl-context.rkt @@ -1,11 +1,132 @@ -#lang scheme/base -(require scheme/class - "../../syntax.rkt") +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/define + (prefix-in draw: racket/draw/gl-context) + racket/draw/gl-config + "types.rkt" + "utils.rkt") -(provide gl-context%) +(provide create-widget-gl-context) -(defclass gl-context% object% - (def/public-unimplemented call-as-current) - (def/public-unimplemented swap-buffers) - (def/public-unimplemented ok?) - (super-new)) +(define gdkglext-lib + (ffi-lib "libgdkglext-x11-1.0" '("0"))) +(define gtkglext-lib + (ffi-lib "libgtkglext-x11-1.0" '("0"))) + +(define-ffi-definer define-gdkglext gdkglext-lib + #:default-make-fail make-not-available) +(define-ffi-definer define-gtkglext gtkglext-lib + #:default-make-fail make-not-available) + +(define _GdkGLContext (_cpointer/null 'GdkGLContext)) +(define _GdkGLDrawable (_cpointer 'GdkGLDrawable)) +(define _GdkGLConfig (_cpointer 'GdkGLConfig)) + +(define-gdkglext gdk_gl_init (_fun (_ptr i _int) + (_ptr i _pointer) + -> _void) + #:fail void) + +(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 + _GdkGLConfig + _GdkGLContext + _gboolean + _int + -> _gboolean) + #:fail (lambda args #f)) + +(define-gtkglext gtk_widget_get_gl_context (_fun _GtkWidget -> _GdkGLContext)) +(define-gtkglext gtk_widget_get_gl_window (_fun _GtkWidget -> _GdkGLDrawable)) + +(define-gdkglext gdk_gl_drawable_gl_begin (_fun _GdkGLDrawable + _GdkGLContext + -> _gboolean)) +(define-gdkglext gdk_gl_drawable_gl_end (_fun _GdkGLDrawable -> _void)) +(define-gdkglext gdk_gl_drawable_swap_buffers (_fun _GdkGLDrawable -> _void)) + +(define GDK_GL_USE_GL 1) +(define GDK_GL_BUFFER_SIZE 2) +(define GDK_GL_LEVEL 3) +(define GDK_GL_RGBA 4) +(define GDK_GL_DOUBLEBUFFER 5) +(define GDK_GL_STEREO 6) +(define GDK_GL_AUX_BUFFERS 7) +(define GDK_GL_RED_SIZE 8) +(define GDK_GL_GREEN_SIZE 9) +(define GDK_GL_BLUE_SIZE 10) +(define GDK_GL_ALPHA_SIZE 11) +(define GDK_GL_DEPTH_SIZE 12) +(define GDK_GL_STENCIL_SIZE 13) +(define GDK_GL_ACCUM_RED_SIZE 14) +(define GDK_GL_ACCUM_GREEN_SIZE 15) +(define GDK_GL_ACCUM_BLUE_SIZE 16) +(define GDK_GL_ACCUM_ALPHA_SIZE 17) +(define GDK_GL_SAMPLE_BUFFERS 100000) +(define GDK_GL_SAMPLES 100001) +(define GDK_GL_ATTRIB_LIST_NONE 0) + +;; ---------------------------------------- + +(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))) + +;; ---------------------------------------- + +(define gl-context% + (class draw:gl-context% + (init-field [gl gl] + [drawable drawable]) + + (define/override (draw:do-call-as-current t) + (dynamic-wind + (lambda () + (gdk_gl_drawable_gl_begin gl drawable)) + t + (lambda () + (gdk_gl_drawable_gl_end drawable)))) + + (define/override (draw:do-swap-buffers) + (gdk_gl_drawable_swap_buffers drawable)) + + (super-new))) + +;; ---------------------------------------- + +(define inited? #f) +(define (init!) + (unless inited? + (set! inited? #t) + (gdk_gl_init 0 #f))) + +(define (create-widget-gl-context gtk config) + (init!) + (let ([config (config->GdkGLConfig (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)])))))) diff --git a/collects/mred/private/wx/gtk/platform.rkt b/collects/mred/private/wx/gtk/platform.rkt index 19a1bec572..df851f8acb 100644 --- a/collects/mred/private/wx/gtk/platform.rkt +++ b/collects/mred/private/wx/gtk/platform.rkt @@ -9,7 +9,6 @@ "dialog.rkt" "frame.rkt" "gauge.rkt" - "gl-context.rkt" "group-panel.rkt" "item.rkt" "list-box.rkt" @@ -37,7 +36,6 @@ dialog% frame% gauge% - gl-context% group-panel% item% list-box% diff --git a/collects/mred/private/wx/gtk/procs.rkt b/collects/mred/private/wx/gtk/procs.rkt index 7c5dcfd9d1..95eaacfae8 100644 --- a/collects/mred/private/wx/gtk/procs.rkt +++ b/collects/mred/private/wx/gtk/procs.rkt @@ -81,8 +81,6 @@ (define-unimplemented write-resource) (define-unimplemented get-resource) -(define _GdkScreen (_cpointer 'GdkScreen)) -(define-gdk gdk_screen_get_default (_fun -> _GdkScreen)) (define-gdk gdk_screen_get_width (_fun _GdkScreen -> _int)) (define-gdk gdk_screen_get_height (_fun _GdkScreen -> _int)) diff --git a/collects/mred/private/wx/gtk/types.rkt b/collects/mred/private/wx/gtk/types.rkt index 2f51e5e229..7ba1ab7bf0 100644 --- a/collects/mred/private/wx/gtk/types.rkt +++ b/collects/mred/private/wx/gtk/types.rkt @@ -5,6 +5,7 @@ (provide _GdkWindow _GtkWidget _GtkWindow _GdkDisplay + _GdkScreen _gpointer _GType @@ -36,6 +37,7 @@ (define _GtkWindow _GtkWidget) (define _GdkDisplay (_cpointer 'GdkDisplay)) +(define _GdkScreen (_cpointer 'GdkScreen)) (define _gpointer _GtkWidget) diff --git a/collects/mred/private/wx/gtk/utils.rkt b/collects/mred/private/wx/gtk/utils.rkt index 6a1007c869..7b87911967 100644 --- a/collects/mred/private/wx/gtk/utils.rkt +++ b/collects/mred/private/wx/gtk/utils.rkt @@ -41,6 +41,8 @@ define-signal-handler + gdk_screen_get_default + ;; for declaring derived structures: _GtkObject) @@ -203,3 +205,5 @@ (cons ((ctype-c->scheme elem) (g-slist-data gl)) (L (g-slist-next gl))))) (g_slist_free gl))))) + +(define-gdk gdk_screen_get_default (_fun -> _GdkScreen)) diff --git a/collects/mred/private/wx/platform.rkt b/collects/mred/private/wx/platform.rkt index a3b1555a9e..10e6e4e044 100644 --- a/collects/mred/private/wx/platform.rkt +++ b/collects/mred/private/wx/platform.rkt @@ -21,7 +21,6 @@ dialog% frame% gauge% - gl-context% group-panel% item% list-box% diff --git a/collects/mred/private/wx/win32/platform.rkt b/collects/mred/private/wx/win32/platform.rkt index 96878af41a..a1903094b5 100644 --- a/collects/mred/private/wx/win32/platform.rkt +++ b/collects/mred/private/wx/win32/platform.rkt @@ -37,7 +37,6 @@ dialog% frame% gauge% - gl-context% group-panel% item% list-box% diff --git a/collects/racket/draw.rkt b/collects/racket/draw.rkt index 89fa58e3fe..ed8df57b3d 100644 --- a/collects/racket/draw.rkt +++ b/collects/racket/draw.rkt @@ -11,7 +11,9 @@ "draw/dc-intf.rkt" "draw/bitmap-dc.rkt" "draw/post-script-dc.rkt" - "draw/ps-setup.rkt") + "draw/ps-setup.rkt" + "draw/gl-config.rkt" + "draw/gl-context.rkt") (provide color% color-database<%> the-color-database @@ -27,4 +29,6 @@ bitmap-dc% post-script-dc% ps-setup% current-ps-setup - get-face-list) + get-face-list + gl-config% + gl-context<%>) diff --git a/collects/racket/draw/dc.rkt b/collects/racket/draw/dc.rkt index e840353ff1..306f88009a 100644 --- a/collects/racket/draw/dc.rkt +++ b/collects/racket/draw/dc.rkt @@ -210,6 +210,9 @@ (define/public (erase) (void)) + (define/public (get-gl-context) + #f) + (super-new))) (define hilite-color (send the-color-database find-color "black")) @@ -1609,6 +1612,7 @@ (install-alternate-face c layout font desc attrs context) (zero? (pango_layout_get_unknown_glyphs_count layout)))) (g_object_unref layout)))))) - - ) + + (void)) + dc%) diff --git a/collects/racket/draw/gl-config.rkt b/collects/racket/draw/gl-config.rkt new file mode 100644 index 0000000000..ec79cfbe27 --- /dev/null +++ b/collects/racket/draw/gl-config.rkt @@ -0,0 +1,36 @@ +#lang scheme/base +(require scheme/class + "syntax.rkt") + +(provide gl-config%) + +(defclass gl-config% object% + (super-new) + + (define double-buffered? #t) + (define/public (get-double-buffered) double-buffered?) + (define/public (set-double-buffered v) (set! double-buffered? (and v #t))) + + (define stereo? #t) + (define/public (get-stereo) stereo?) + (define/public (set-stereo v) (set! stereo? (and v #t))) + + (define stencil-size 0) + (define/public (get-stencil-size) stencil-size) + (def/public (set-stencil-size [(integer-in 0 256) s]) + (set! stencil-size s)) + + (define accum-size 0) + (define/public (get-accum-size) accum-size) + (def/public (set-accum-size [(integer-in 0 256) s]) + (set! accum-size s)) + + (define depth-size 0) + (define/public (get-depth-size) depth-size) + (def/public (set-depth-size [(integer-in 0 256) s]) + (set! depth-size s)) + + (define multisample-size 0) + (define/public (get-multisample-size) multisample-size) + (def/public (set-multisample-size [(integer-in 0 256) s]) + (set! multisample-size s))) diff --git a/collects/racket/draw/gl-context.rkt b/collects/racket/draw/gl-context.rkt new file mode 100644 index 0000000000..cb9da20e6f --- /dev/null +++ b/collects/racket/draw/gl-context.rkt @@ -0,0 +1,52 @@ +#lang racket/base +(require racket/class + "syntax.rkt") + +(provide gl-context% + gl-context<%> + + do-call-as-current + do-swap-buffers) + +(define-local-member-name + do-call-as-current + do-swap-buffers) + +(define (procedure-arity-0? v) + (and (procedure? v) + (procedure-arity-includes? v 0))) + +;; Implemented by subclasses: +(defclass gl-context% object% + (define lock-thread #f) + (define lock (make-semaphore)) + + (define/private (with-gl-lock t) + (if (eq? lock-thread (current-thread)) + (t) + (call-with-semaphore + lock + (lambda () + (set! lock-thread (current-thread)) + (begin0 + (t) + (set! lock-thread #f)))))) + + (def/public (call-as-current [procedure-arity-0? t]) + (with-gl-lock + (lambda () + (do-call-as-current t)))) + + (define/public (swap-buffers) + (with-gl-lock + (lambda () + (do-swap-buffers)))) + + (define/public (ok?) #t) + + (define/public (do-call-as-current t) (t)) + (define/public (do-swap-buffers t) (void)) + + (super-new)) + +(define gl-context<%> (class->interface gl-context%))