From 0562755be9714940d0e88fe7f1bc53dc3e7e9aa8 Mon Sep 17 00:00:00 2001 From: Jay Kominek Date: Thu, 11 Apr 2013 12:09:59 -0600 Subject: [PATCH] OpenGL context sharing --- collects/mred/private/wx/cocoa/agl.rkt | 11 ++- collects/mred/private/wx/cocoa/canvas.rkt | 27 +++++-- collects/mred/private/wx/cocoa/dc.rkt | 1 + collects/mred/private/wx/gtk/gl-context.rkt | 15 +++- collects/mred/private/wx/win32/gl-context.rkt | 73 +++++++++++++------ collects/racket/draw/private/contract.rkt | 3 +- collects/racket/draw/private/gl-config.rkt | 7 +- collects/racket/draw/private/gl-context.rkt | 6 +- .../scribblings/draw/gl-config-class.scrbl | 33 +++++++++ .../scribblings/draw/gl-context-intf.scrbl | 19 ++++- 10 files changed, 155 insertions(+), 40 deletions(-) diff --git a/collects/mred/private/wx/cocoa/agl.rkt b/collects/mred/private/wx/cocoa/agl.rkt index aca1f8e50d..3a7fea351e 100644 --- a/collects/mred/private/wx/cocoa/agl.rkt +++ b/collects/mred/private/wx/cocoa/agl.rkt @@ -69,6 +69,9 @@ (define gl-context% (class orig-gl-context% (init-field agl) + + (define/override (get-handle) + agl) (define/override (do-call-as-current t) (dynamic-wind @@ -107,7 +110,9 @@ bitmap%)) (define (create-gl-bitmap w h conf) - (let ([fmt (aglChoosePixelFormat + (let* ([share-context (send conf get-share-context)] + [context-handle (if share-context (send share-context get-handle) #f)] + [fmt (aglChoosePixelFormat #f 0 (append @@ -132,9 +137,9 @@ AGL_SAMPLES_ARB ms))) (list AGL_NONE)))]) (and fmt - (let ([agl (aglCreateContext fmt #f)] + (let ([agl (aglCreateContext fmt context-handle)] [d-agl (or dummy-agl - (let ([d (aglCreateContext fmt #f)]) + (let ([d (aglCreateContext fmt context-handle)]) (when d (set! dummy-agl d) d)))]) diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index 6a550291fd..94667f13e1 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -35,7 +35,7 @@ (import-class NSView NSGraphicsContext NSScroller NSComboBox NSWindow NSImageView NSTextFieldCell - NSOpenGLView NSOpenGLPixelFormat) + NSOpenGLView NSOpenGLContext NSOpenGLPixelFormat) (import-protocol NSComboBoxDelegate) @@ -354,12 +354,25 @@ (tell (tell (if is-combo? RacketComboBox RacketView) alloc) initWithFrame: #:type _NSRect r) - (let ([pf (gl-config->pixel-format gl-config)]) - (begin0 - (tell (tell RacketGLView alloc) - initWithFrame: #:type _NSRect r - pixelFormat: pf) - (tellv pf release))))))) + (let* ([share-context (send gl-config get-share-context)] + [context-handle (and share-context (send share-context get-handle))] + [pf (gl-config->pixel-format gl-config)] + [new-context (and + context-handle + (tell (tell NSOpenGLContext alloc) + initWithFormat: pf + shareContext: context-handle))] + [gl-view (tell (tell RacketGLView alloc) + initWithFrame: #:type _NSRect r + pixelFormat: pf)]) + (when new-context + (tellv gl-view setOpenGLContext: new-context) + ;; We're supposed to sync via `setView:' but it fails, + ;; perhaps because the view isn't yet visible: + ;; (tellv new-context setView: gl-view) + (tellv new-context release)) + (tellv pf release) + gl-view))))) (tell #:type _void cocoa addSubview: content-cocoa) (set-ivar! content-cocoa wxb (->wxb this)) diff --git a/collects/mred/private/wx/cocoa/dc.rkt b/collects/mred/private/wx/cocoa/dc.rkt index e0d076d02e..94c463235d 100644 --- a/collects/mred/private/wx/cocoa/dc.rkt +++ b/collects/mred/private/wx/cocoa/dc.rkt @@ -36,6 +36,7 @@ (let ([gl-ctx (tell (send canvas get-cocoa-content) openGLContext)]) (or gl (let ([g (new (class gl-context% + (define/override (get-handle) gl-ctx) (define/override (do-call-as-current t) (dynamic-wind (lambda () (tellv gl-ctx makeCurrentContext)) diff --git a/collects/mred/private/wx/gtk/gl-context.rkt b/collects/mred/private/wx/gtk/gl-context.rkt index 40769f4472..32d222a901 100644 --- a/collects/mred/private/wx/gtk/gl-context.rkt +++ b/collects/mred/private/wx/gtk/gl-context.rkt @@ -123,6 +123,8 @@ (init-field [gl gl] [drawable drawable]) + (define/override (get-handle) gl) + (define/override (draw:do-call-as-current t) (dynamic-wind (lambda () @@ -146,14 +148,17 @@ (define (prepare-widget-gl-context gtk config) (init!) - (let ([config (config->GdkGLConfig #f ; (gtk_widget_get_screen gtk) + (let ([share-context (send config get-share-context)] + [config (config->GdkGLConfig #f ; (gtk_widget_get_screen gtk) (or config (new gl-config%)) #t)]) (when config (gtk_widget_set_gl_capability gtk config - #f + (if share-context + (send share-context get-handle) + #f) #t 0)))) @@ -172,7 +177,9 @@ (define (create-and-install-gl-context bm config) (init!) - (let ([config (config->GdkGLConfig #f config #f)]) + (let* ([share-context (send config get-share-context)] + [context-handle (if share-context (send share-context get-handle) #f)] + [config (config->GdkGLConfig #f config #f)]) (when config (let ([gdkpx (send bm get-gdk-pixmap)]) (let ([glpx (gdk_pixmap_set_gl_capability gdkpx config #f)]) @@ -180,7 +187,7 @@ (let ([gl ;; currently uses "indirect" mode --- can we ;; reliably use direct in some environments? - (gdk_gl_context_new glpx #f #f GDK_GL_RGBA_TYPE)]) + (gdk_gl_context_new glpx context-handle #f GDK_GL_RGBA_TYPE)]) (and gl (send bm install-gl-context (new gl-context% diff --git a/collects/mred/private/wx/win32/gl-context.rkt b/collects/mred/private/wx/win32/gl-context.rkt index f7b8f0ce08..b79981677f 100644 --- a/collects/mred/private/wx/win32/gl-context.rkt +++ b/collects/mred/private/wx/win32/gl-context.rkt @@ -71,6 +71,9 @@ (define tried-multisample? #f) (define wglChoosePixelFormatARB #f) +(define looked-for-createcontextattribs? #f) +(define wglCreateContextAttribsARB #f) + ;; ---------------------------------------- (define gl-context% @@ -78,6 +81,8 @@ (init-field [hglrc hglrc] [hdc hdc]) + (define/override (get-handle) hglrc) + (define/override (draw:do-call-as-current t) (dynamic-wind (lambda () @@ -119,6 +124,7 @@ (define (create-gl-context hdc config offscreen? #:try-ms? [try-ms? (not offscreen?)]) (when try-ms? (unless tried-multisample? (init-multisample! config))) + (unless looked-for-createcontextattribs? (init-createcontextattribs! config)) (let* ([config (or config (new gl-config%))] [accum (send config get-accum-size)] [pfd @@ -156,7 +162,9 @@ wglChoosePixelFormatARB (or (choose-multisample hdc config offscreen? ms) (choose-multisample hdc config offscreen? 2))) - (ChoosePixelFormat hdc pfd))]) + (ChoosePixelFormat hdc pfd))] + [share-context (send config get-share-context)] + [context-handle (if share-context (send share-context get-handle) #f)]) (and (not (zero? pixelFormat)) (and (SetPixelFormat hdc pixelFormat pfd) (begin @@ -164,20 +172,18 @@ (when (not (zero? (bitwise-and (PIXELFORMATDESCRIPTOR-dwFlags pfd) PFD_NEED_PALETTE))) (log-error "don't know how to create a GL palette, yet")) - (let ([hglrc (wglCreateContext hdc)]) + (let ([hglrc (if wglCreateContextAttribsARB + (wglCreateContextAttribsARB hdc context-handle (vector 0)) + (wglCreateContext hdc))]) (and hglrc (new gl-context% [hglrc hglrc] [hdc hdc])))))))) -(define (init-multisample! config) - ;; To create a multisampled context, we need - ;; wglChoosePixelFormatARB(). - ;; To look up wglChoosePixelFormatARB(), we need - ;; an existing gl context. +(define (with-dummy-context config thunk) ;; To create a gl context, we need a separate window ;; (because you can't change a window's pixel format ;; after it is set). ;; So, create a dummy window to make a context to - ;; try to get wglChoosePixelFormatARB(). + ;; try to do whatever needs doing. (let ([hwnd (CreateWindowExW 0 "PLTFrame" "" @@ -194,20 +200,43 @@ (call-with-context (get-field hdc c) (get-field hglrc c) - (lambda () - (set! wglChoosePixelFormatARB - (let ([f (wglGetProcAddress "wglChoosePixelFormatARB")]) - (and f - (function-ptr f (_wfun _HDC - (_vector i _int) - (_vector i _float) - (_UINT = 1) - (formats : (_ptr o _int)) - (num-formats : (_ptr o _UINT)) - -> (r : _BOOL) - -> (and r formats)))))) - (set! tried-multisample? #t))))) - (ReleaseDC hwnd hdc))))) + thunk))) + (ReleaseDC hwnd hdc))))) + +(define (init-createcontextattribs! config) + ;; look for wglCreateContextAttribsARB which is a beefed + ;; up version of wglCreateContext + (set! looked-for-createcontextattribs? #t) + (with-dummy-context config + (lambda () + (set! wglCreateContextAttribsARB + (let ([f (wglGetProcAddress "wglCreateContextAttribsARB")]) + (and f + ((allocator wglDeleteContext) + (function-ptr f (_wfun _HDC + _HGLRC + (_vector i _int) + -> _HGLRC))))))))) + +(define (init-multisample! config) + ;; To create a multisampled context, we need + ;; wglChoosePixelFormatARB(). + ;; To look up wglChoosePixelFormatARB(), we need + ;; an existing gl context. + (with-dummy-context config + (lambda () + (set! wglChoosePixelFormatARB + (let ([f (wglGetProcAddress "wglChoosePixelFormatARB")]) + (and f + (function-ptr f (_wfun _HDC + (_vector i _int) + (_vector i _float) + (_UINT = 1) + (formats : (_ptr o _int)) + (num-formats : (_ptr o _UINT)) + -> (r : _BOOL) + -> (and r formats)))))) + (set! tried-multisample? #t)))) (define GL_TRUE 1) (define GL_FALSE 0) diff --git a/collects/racket/draw/private/contract.rkt b/collects/racket/draw/private/contract.rkt index 0175e72233..a6936c4f36 100644 --- a/collects/racket/draw/private/contract.rkt +++ b/collects/racket/draw/private/contract.rkt @@ -392,7 +392,8 @@ (set-double-buffered (->m any/c void?)) (set-multisample-size (->m (integer-in 0 256) void?)) (set-stencil-size (->m (integer-in 0 256) void?)) - (set-stereo (->m any/c void?)))) + (set-stereo (->m any/c void?)) + (set-share-context (->m (or/c (is-a?/c gl-context%) #f) void?)))) (define bitmap%/c (class/c diff --git a/collects/racket/draw/private/gl-config.rkt b/collects/racket/draw/private/gl-config.rkt index 85e7a8055b..748ec9e1ab 100644 --- a/collects/racket/draw/private/gl-config.rkt +++ b/collects/racket/draw/private/gl-config.rkt @@ -33,4 +33,9 @@ (define multisample-size 0) (define/public (get-multisample-size) multisample-size) (define/public (set-multisample-size s) - (set! multisample-size s))) + (set! multisample-size s)) + + (define share-context #f) + (define/public (get-share-context) share-context) + (define/public (set-share-context s) + (set! share-context s))) diff --git a/collects/racket/draw/private/gl-context.rkt b/collects/racket/draw/private/gl-context.rkt index 1e3c504061..f71ebfe794 100644 --- a/collects/racket/draw/private/gl-context.rkt +++ b/collects/racket/draw/private/gl-context.rkt @@ -41,7 +41,8 @@ (interface () [call-as-current (->*m [(-> any)] [evt? any/c] any)] [ok? (->m boolean?)] - [swap-buffers (->m any)])) + [swap-buffers (->m any)] + [get-handle (->m any)])) ;; Implemented by subclasses: (define gl-context% @@ -62,6 +63,9 @@ (lambda () (channel-put ch #t)))))) alternate-evt))) + + (define/public (get-handle) + #f) (define/public (call-as-current t [alternate-evt never-evt] [enable-breaks? #f]) (with-gl-lock diff --git a/collects/scribblings/draw/gl-config-class.scrbl b/collects/scribblings/draw/gl-config-class.scrbl index 3ada521871..c28bc6a7c2 100644 --- a/collects/scribblings/draw/gl-config-class.scrbl +++ b/collects/scribblings/draw/gl-config-class.scrbl @@ -49,6 +49,18 @@ Reports the multisampling size that the configuration requests, where } +@defmethod[(get-share-context) + (or/c #f (is-a?/c gl-context<%>))]{ + +Returns a @racket[gl-context<%>] object that shares certain objects +(textures, display lists, etc.) with newly created OpenGL drawing +contexts, or @racket[#f] is none is set. + +See also @method[gl-config% set-share-context]. + +} + + @defmethod[(get-stencil-size) (integer-in 0 256)]{ @@ -97,6 +109,27 @@ Adjusts the configuration to request a particular multisample size, } +@defmethod[(set-share-context [context (or/c #f (is-a?/c gl-context<%>))]) + void?]{ + +Determines a @racket[gl-context<%>] object that shares certain objects +(textures, display lists, etc.) with newly created OpenGL drawing +contexts, where @racket[#f] indicates +that no sharing should occur. + +When a context @racket[_B] shares objects with context @racket[_A], it +is also shares objects with every other context sharing with +@racket[_A], and vice versa. + +If an OpenGL implementation does not support sharing, @racket[context] +is effectively ignored when a new context is created. +Sharing should be supported in all versions of Mac OS X. +On Windows and Linux, sharing is provided by the presence of the +@tt{WGL_ARB_create_context} and @tt{GLX_ARB_create_context} extensions, +respectively (and OpenGL 3.2 requires both). + +} + @defmethod[(set-stencil-size [on? (integer-in 0 256)]) void?]{ diff --git a/collects/scribblings/draw/gl-context-intf.scrbl b/collects/scribblings/draw/gl-context-intf.scrbl index 9b4741199e..a27ae7c59b 100644 --- a/collects/scribblings/draw/gl-context-intf.scrbl +++ b/collects/scribblings/draw/gl-context-intf.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc -@(require "common.rkt") +@(require "common.rkt" + (for-label (only-in ffi/unsafe cpointer?))) @definterface/title[gl-context<%> ()]{ @@ -76,6 +77,22 @@ If @racket[enable-breaks?] is true, then the method uses } +@defmethod[(get-handle) cpointer?]{ + +Returns a handle to the platform's underlying context. The value that the +pointer represents depends on the platform: + +@itemize[ +@item{Windows: @tt{HGLRC}} +@item{Mac OS X: @tt{NSOpenGLContext}} +@item{Unix: @tt{GdkGLContext}} +] + +Note that these values are not necessary the most ``low-level'' context objects, +but are instead the ones useful to Racket. A @tt{NSOpenGLContext} wraps a +@tt{CGLContextObj}, and a @tt{GdkGLContext} contains a @tt{GLXcontext}. +} + @defmethod[(ok?) boolean?]{