OpenGL context sharing
original commit: 0562755be9714940d0e88fe7f1bc53dc3e7e9aa8
This commit is contained in:
parent
8a7dcf0638
commit
04c0da4c30
|
@ -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))
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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%
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user