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

OpenGL context sharing

Browse Source
This commit is contained in:
Jay Kominek 2013-04-11 12:09:59 -06:00 committed by Matthew Flatt
parent 6642c114f7
commit 0562755be9
10 changed files with 155 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/mred/private/wx/cocoa/agl.rkt
View File

@ -70,6 +70,9 @@
(class orig-gl-context%
(init-field agl)
(define/override (get-handle)
agl)
(define/override (do-call-as-current t)
(dynamic-wind
(lambda ()
@ -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)))])

25
collects/mred/private/wx/cocoa/canvas.rkt
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)
(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)
(tellv pf release)))))))
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))

1
collects/mred/private/wx/cocoa/dc.rkt
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))

15
collects/mred/private/wx/gtk/gl-context.rkt
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%

49
collects/mred/private/wx/win32/gl-context.rkt
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,6 +200,30 @@
(call-with-context
(get-field hdc c)
(get-field hglrc c)
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")])
@ -206,8 +236,7 @@
(num-formats : (_ptr o _UINT))
-> (r : _BOOL)
-> (and r formats))))))
(set! tried-multisample? #t)))))
(ReleaseDC hwnd hdc)))))
(set! tried-multisample? #t))))
(define GL_TRUE 1)
(define GL_FALSE 0)

3
collects/racket/draw/private/contract.rkt
View File

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

7
collects/racket/draw/private/gl-config.rkt
View File

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

6
collects/racket/draw/private/gl-context.rkt
View File

@ -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%
@ -63,6 +64,9 @@
(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
(lambda ()

33
collects/scribblings/draw/gl-config-class.scrbl
View File

@ -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?]{

19
collects/scribblings/draw/gl-context-intf.scrbl
View File

@ -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?]{