diff --git a/collects/mred/mred-sig.rkt b/collects/mred/mred-sig.rkt index 72d97f8b..53b52e26 100644 --- a/collects/mred/mred-sig.rkt +++ b/collects/mred/mred-sig.rkt @@ -123,6 +123,7 @@ make-eventspace make-gui-empty-namespace make-gui-namespace make-screen-bitmap +make-gl-bitmap map-command-as-meta-key menu% menu-bar% diff --git a/collects/mred/mred.rkt b/collects/mred/mred.rkt index d4113ebf..59f6dcbf 100644 --- a/collects/mred/mred.rkt +++ b/collects/mred/mred.rkt @@ -191,7 +191,8 @@ the-brush-list the-style-list the-editor-wordbreak-map - make-screen-bitmap) + make-screen-bitmap + make-gl-bitmap) (define the-clipboard (wx:get-the-clipboard)) (define the-x-selection-clipboard (wx:get-the-x-selection)) diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 3c9f42d6..dabf6444 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -206,12 +206,11 @@ NSOpenGLPFADepthSize (send conf get-depth-size) NSOpenGLPFAStencilSize (send conf get-stencil-size) NSOpenGLPFAAccumSize (send conf get-accum-size)) - #; (let ([ms (send conf get-multisample-size)]) (if (zero? ms) null (list NSOpenGLPFAMultisample - NSOpenGLPFASampleBuffers + NSOpenGLPFASampleBuffers 1 NSOpenGLPFASamples ms))) (list 0))))) diff --git a/collects/mred/private/wx/cocoa/platform.rkt b/collects/mred/private/wx/cocoa/platform.rkt index b51b20f6..5dcb42bf 100644 --- a/collects/mred/private/wx/cocoa/platform.rkt +++ b/collects/mred/private/wx/cocoa/platform.rkt @@ -85,4 +85,5 @@ get-highlight-background-color get-highlight-text-color make-screen-bitmap + make-gl-bitmap check-for-break)) diff --git a/collects/mred/private/wx/cocoa/procs.rkt b/collects/mred/private/wx/cocoa/procs.rkt index 9734d1d4..cf31e6e0 100644 --- a/collects/mred/private/wx/cocoa/procs.rkt +++ b/collects/mred/private/wx/cocoa/procs.rkt @@ -12,6 +12,7 @@ "filedialog.rkt" "dc.rkt" "menu-bar.rkt" + "agl.rkt" "../../lock.rkt" "../common/handlers.rkt") @@ -52,6 +53,7 @@ get-highlight-background-color get-highlight-text-color make-screen-bitmap + make-gl-bitmap check-for-break) (import-class NSScreen NSCursor) @@ -113,6 +115,11 @@ [exact-positive-integer? h]) (make-object quartz-bitmap% w h)) +(define/top (make-gl-bitmap [exact-positive-integer? w] + [exact-positive-integer? h] + [gl-config% c]) + (create-gl-bitmap w h c)) + ;; ------------------------------------------------------------ ;; Text & highlight color diff --git a/collects/mred/private/wx/gtk/dc.rkt b/collects/mred/private/wx/gtk/dc.rkt index a3c410c9..331f7f3a 100644 --- a/collects/mred/private/wx/gtk/dc.rkt +++ b/collects/mred/private/wx/gtk/dc.rkt @@ -37,6 +37,14 @@ w h)) + ;; `get-gdk-pixmap' and `install-gl-context' are + ;; localized in "gl-context.rkt" + (define/public (get-gdk-pixmap) pixmap) + (define/public (install-gl-context new-gl) (set! gl new-gl)) + + (define gl #f) + (define/override (get-bitmap-gl-context) gl) + (define/override (ok?) #t) (define/override (is-color?) #t) (define/override (has-alpha-channel?) #f) diff --git a/collects/mred/private/wx/gtk/gl-context.rkt b/collects/mred/private/wx/gtk/gl-context.rkt index e310c687..0db687bb 100644 --- a/collects/mred/private/wx/gtk/gl-context.rkt +++ b/collects/mred/private/wx/gtk/gl-context.rkt @@ -2,13 +2,18 @@ (require racket/class ffi/unsafe ffi/unsafe/define + ffi/unsafe/alloc (prefix-in draw: racket/draw/gl-context) racket/draw/gl-config "types.rkt" "utils.rkt") (provide prepare-widget-gl-context - create-widget-gl-context) + create-widget-gl-context + + create-and-install-gl-context + get-gdk-pixmap + install-gl-context) (define gdkglext-lib (ffi-lib "libgdkglext-x11-1.0" '("0"))) @@ -23,6 +28,8 @@ (define _GdkGLContext (_cpointer/null 'GdkGLContext)) (define _GdkGLDrawable (_cpointer 'GdkGLDrawable)) (define _GdkGLConfig (_cpointer 'GdkGLConfig)) +(define _GdkGLPixmap _GdkGLDrawable) +(define _GdkPixmap _pointer) (define-gdkglext gdk_gl_init (_fun (_ptr i _int) (_ptr i _pointer) @@ -45,12 +52,26 @@ (define-gtkglext gtk_widget_get_gl_context (_fun _GtkWidget -> _GdkGLContext)) (define-gtkglext gtk_widget_get_gl_window (_fun _GtkWidget -> _GdkGLDrawable)) +(define-gdkglext gdk_gl_context_destroy (_fun _GdkGLContext -> _void) + #:wrap (deallocator)) + +(define-gdkglext gdk_gl_context_new (_fun _GdkGLDrawable _GdkGLContext _gboolean _int + -> _GdkGLContext) + #:wrap (allocator gdk_gl_context_destroy)) + (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-gdkglext gdk_gl_pixmap_destroy (_fun _GdkGLPixmap -> _void) + #:wrap (deallocator)) +(define-gdkglext gdk_gl_pixmap_new (_fun _GdkGLConfig _GdkPixmap _pointer -> _GdkGLPixmap) + #:wrap (allocator gdk_gl_pixmap_destroy)) + +(define GDK_GL_RGBA_TYPE 0) + (define GDK_GL_USE_GL 1) (define GDK_GL_BUFFER_SIZE 2) (define GDK_GL_LEVEL 3) @@ -74,10 +95,12 @@ ;; ---------------------------------------- -(define (config->GdkGLConfig d conf) +(define (config->GdkGLConfig d conf can-double?) (gdk_gl_config_new (append (list GDK_GL_RGBA) - (if (send conf get-double-buffered) (list GDK_GL_DOUBLEBUFFER) null) + (if can-double? + (if (send conf get-double-buffered) (list GDK_GL_DOUBLEBUFFER) null) + null) (if (send conf get-stereo) (list GDK_GL_STEREO) null) (list GDK_GL_DEPTH_SIZE (send conf get-depth-size) @@ -122,7 +145,8 @@ (init!) (let ([config (config->GdkGLConfig #f ; (gtk_widget_get_screen gtk) (or config - (new gl-config%)))]) + (new gl-config%)) + #t)]) (when config (gtk_widget_set_gl_capability gtk config @@ -138,3 +162,21 @@ [gl gl] [drawable (gtk_widget_get_gl_window gtk)])))) + +(define-local-member-name + get-gdk-pixmap + install-gl-context) + +(define (create-and-install-gl-context bm config) + (init!) + (let ([config (config->GdkGLConfig #f config #f)]) + (when config + (let ([gdkpx (send bm get-gdk-pixmap)]) + (let ([glpx (gdk_gl_pixmap_new config gdkpx #f)]) + (and glpx + (let ([gl (gdk_gl_context_new glpx #f #t GDK_GL_RGBA_TYPE)]) + (and gl + (new gl-context% + [gl gl] + [drawable glpx]))))))))) + diff --git a/collects/mred/private/wx/gtk/platform.rkt b/collects/mred/private/wx/gtk/platform.rkt index df851f8a..d71e484a 100644 --- a/collects/mred/private/wx/gtk/platform.rkt +++ b/collects/mred/private/wx/gtk/platform.rkt @@ -85,4 +85,5 @@ get-highlight-background-color get-highlight-text-color make-screen-bitmap + make-gl-bitmap check-for-break)) diff --git a/collects/mred/private/wx/gtk/procs.rkt b/collects/mred/private/wx/gtk/procs.rkt index 95eaacfa..6b77bd50 100644 --- a/collects/mred/private/wx/gtk/procs.rkt +++ b/collects/mred/private/wx/gtk/procs.rkt @@ -11,6 +11,7 @@ "widget.rkt" "window.rkt" "dc.rkt" + "gl-context.rkt" "../common/handlers.rkt") (provide @@ -50,6 +51,7 @@ get-highlight-background-color get-highlight-text-color make-screen-bitmap + make-gl-bitmap check-for-break) (define-unimplemented special-control-key) @@ -118,4 +120,11 @@ (make-object x11-bitmap% w h #f) (make-object bitmap% w h #f #t))) +(define/top (make-gl-bitmap [exact-positive-integer? w] + [exact-positive-integer? h] + [gl-config% c]) + (let ([bm (make-object x11-bitmap% w h #f)]) + (create-and-install-gl-context bm c) + bm)) + (define (check-for-break) #f) diff --git a/collects/mred/private/wx/platform.rkt b/collects/mred/private/wx/platform.rkt index 10e6e4e0..6375991f 100644 --- a/collects/mred/private/wx/platform.rkt +++ b/collects/mred/private/wx/platform.rkt @@ -70,5 +70,6 @@ get-highlight-background-color get-highlight-text-color make-screen-bitmap + make-gl-bitmap check-for-break) ((dynamic-require platform-lib 'platform-values))) diff --git a/collects/mred/private/wx/win32/platform.rkt b/collects/mred/private/wx/win32/platform.rkt index a1903094..2a71e0e2 100644 --- a/collects/mred/private/wx/win32/platform.rkt +++ b/collects/mred/private/wx/win32/platform.rkt @@ -86,4 +86,5 @@ get-highlight-background-color get-highlight-text-color make-screen-bitmap + make-gl-bitmap check-for-break)) diff --git a/collects/mred/private/wx/win32/procs.rkt b/collects/mred/private/wx/win32/procs.rkt index 2efb432e..9659eb6f 100644 --- a/collects/mred/private/wx/win32/procs.rkt +++ b/collects/mred/private/wx/win32/procs.rkt @@ -48,6 +48,7 @@ get-highlight-background-color get-highlight-text-color make-screen-bitmap + make-gl-bitmap check-for-break) (define-unimplemented special-control-key) @@ -102,4 +103,9 @@ [exact-positive-integer? h]) (make-object win32-bitmap% w h #f)) +(define/top (make-gl-bitmap [exact-positive-integer? w] + [exact-positive-integer? h] + [gl-config% c]) + (make-object win32-bitmap% w h #f)) + (define (check-for-break) #f) diff --git a/collects/scribblings/gui/canvas-class.scrbl b/collects/scribblings/gui/canvas-class.scrbl index 3159774a..161333d8 100644 --- a/collects/scribblings/gui/canvas-class.scrbl +++ b/collects/scribblings/gui/canvas-class.scrbl @@ -45,10 +45,11 @@ The @scheme[style] argument indicates one or more of the following styles: @item{@scheme['resize-corner] --- leaves room for a resize control at the canvas's bottom right when only one scrollbar is visible} - @item{@scheme['gl] --- enables OpenGL drawing to the canvas, and usually - combined with @racket['no-autoclear]; call the @method[dc<%> - get-gl-context] method of the canvas's drawing context as - produced by @method[canvas<%> get-dc]} + @item{@scheme['gl] --- creates a canvas for OpenGL drawing instead of + normal @racket[dc<%>] drawing; call the @method[dc<%> + get-gl-context] method on the result of @method[canvas<%> + get-dc]; this style is usually combined with + @racket['no-autoclear]} @item{@scheme['no-autoclear] --- prevents automatic erasing of the canvas before calls to @method[canvas% on-paint]} diff --git a/collects/scribblings/gui/miscwin-funcs.scrbl b/collects/scribblings/gui/miscwin-funcs.scrbl index bcd3e71d..7771bf77 100644 --- a/collects/scribblings/gui/miscwin-funcs.scrbl +++ b/collects/scribblings/gui/miscwin-funcs.scrbl @@ -276,6 +276,20 @@ Strips shortcut ampersands from @racket[label], removes parenthesized } +@defproc[(make-gl-bitmap [width exact-positive-integer?] + [height exact-positive-integer?] + [config (is-a?/c gl-config%)]) + (is-a/c? bitmap%)]{ + +Creates a bitmap that supports both normal @racket[dc<%>] drawing an +OpenGL drawing through a context returned by @xmethod[dc<%> get-gl-context]. + +For @racket[dc<%>] drawing, an OpenGL-supporting bitmap draws like a +bitmap frmo @racket[make-screen-bitmap] on some platforms, while it +draws like a bitmap instantiated directly from @racket[bitmap%] on +other platforms.} + + @defproc[(make-gui-empty-namespace) namespace?]{ Like @racket[make-base-empty-namespace], but with diff --git a/doc/release-notes/racket/Draw_and_GUI_5_5.txt b/doc/release-notes/racket/Draw_and_GUI_5_5.txt index 6c50f8a4..6be461a7 100644 --- a/doc/release-notes/racket/Draw_and_GUI_5_5.txt +++ b/doc/release-notes/racket/Draw_and_GUI_5_5.txt @@ -1,4 +1,4 @@ -Changes to the drawing toolbox: +Changes: * The drawing portion of the old GUI toolbox is now available as a separate layer: `racket/draw'. This layer can be used from plain @@ -15,7 +15,7 @@ Changes to the drawing toolbox: Drawing to a canvas always draws into a bitmap that is kept offscreen and periodically flushed onto the screen. The new - `suspend-flush' and `resume-fluah' methods of `canvas%' provide + `suspend-flush' and `resume-flush' methods of `canvas%' provide some control over the timing of the flushes, which in many cases avoids the need for (additional) double buffering of canvas content. @@ -85,8 +85,9 @@ Changes to the drawing toolbox: `get-highlight-text-color', if any. * OpenGL drawing in a canvas requires supplying 'gl as a style when - creating the `canvas%' instance. + creating the `canvas%' instance. OpenGL and normal dc<%> drawing no + longer mix reliably in a canvas. -Changes to the GUI toolbox: + OpenG drawing to a bitmap requires a bitmap created with + `make-gl-bitmap'. - [Nothing to report, yet.]