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

implement GL screen sync for Windows canvases

Browse Source
This commit is contained in:
Matthew Flatt 2015-10-18 18:00:20 -06:00
parent 5a1d5557c4
commit 172b7d5a56
1 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gui-lib/mred/private/wx/win32/gl-context.rkt
View File

@ -74,6 +74,9 @@
(define looked-for-createcontextattribs? #f) (define looked-for-createcontextattribs? #f)
(define wglCreateContextAttribsARB #f) (define wglCreateContextAttribsARB #f)
(define looked-for-wglswapinternalext? #f)
(define wglSwapIntervalEXT #f)
;; ---------------------------------------- ;; ----------------------------------------
(define gl-context% (define gl-context%
@ -176,7 +179,21 @@
(wglCreateContextAttribsARB hdc context-handle (vector 0)) (wglCreateContextAttribsARB hdc context-handle (vector 0))
(wglCreateContext hdc))]) (wglCreateContext hdc))])
(and hglrc (and hglrc
(new gl-context% [hglrc hglrc] [hdc hdc])))))))) (begin
(when (send config get-sync-swap)
(call-with-context
hdc
hglrc
(lambda ()
(unless looked-for-wglswapinternalext?
(set! wglSwapIntervalEXT
(let ([f (wglGetProcAddress "wglSwapIntervalEXT")])
(and f
(function-ptr f (_wfun _int -> _void)))))
(set! looked-for-wglswapinternalext? #t))
(when wglSwapIntervalEXT
(wglSwapIntervalEXT 1)))))
(new gl-context% [hglrc hglrc] [hdc hdc])))))))))
(define (with-dummy-context config thunk) (define (with-dummy-context config thunk)
;; To create a gl context, we need a separate window ;; To create a gl context, we need a separate window