OpenGL context sharing

original commit: 0562755be9714940d0e88fe7f1bc53dc3e7e9aa8
This commit is contained in:
Jay Kominek 2013-04-11 12:09:59 -06:00 committed by Matthew Flatt
parent 8a7dcf0638
commit 04c0da4c30
4 changed files with 83 additions and 33 deletions

View File

@ -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))

View File

@ -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))

View File

@ -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%

View File

@ -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)