win32: support gl multisampling

original commit: 640fa15d32e5b16640355fc84e4366a3c181d142

collects/mred/private/wx/win32/gl-context.rkt

@@ -5,6 +5,9 @@
          ffi/unsafe/alloc
          racket/draw/private/gl-config
          (prefix-in draw: racket/draw/private/gl-context)
+	 "../../lock.rkt"
+	 "wndclass.rkt"
+	 "const.rkt"
          "types.rkt"
          "utils.rkt")
 
@@ -60,6 +63,13 @@
   #:wrap (allocator wglDeleteContext))
 
 (define-opengl32 wglMakeCurrent (_wfun _HDC _HGLRC -> _BOOL))
+(define-opengl32 wglGetCurrentContext (_wfun -> _HGLRC))
+(define-opengl32 wglGetCurrentDC (_wfun -> _HDC))
+
+(define-opengl32 wglGetProcAddress (_wfun _string -> _fpointer))
+
+(define tried-multisample? #f)
+(define wglChoosePixelFormatARB #f)
 
 ;; ----------------------------------------
 
@@ -81,6 +91,17 @@
     
     (super-new)))
 
+(define (call-with-context hdc hglrc f)
+  (atomically
+   (let ([old-hdc (wglGetCurrentDC)]
+	 [old-hglrc (wglGetCurrentContext)])
+     (dynamic-wind
+	 (lambda ()
+	   (wglMakeCurrent hdc hglrc))
+	 f
+	 (lambda ()
+	   (wglMakeCurrent old-hdc old-hglrc))))))
+
 ;; ----------------------------------------
 
 (define PFD_DOUBLEBUFFER            #x00000001)
@@ -95,7 +116,9 @@
 (define PFD_TYPE_RGBA    0)
 (define PFD_MAIN_PLANE   0)
 
-(define (create-gl-context hdc config offscreen?)
+(define (create-gl-context hdc config offscreen? 
+                           #:try-ms? [try-ms? #t])
+  (when try-ms? (unless tried-multisample? (init-multisample! config)))
   (let* ([config (or config (new gl-config%))]
          [accum (send config get-accum-size)]
          [pfd
@@ -127,14 +150,110 @@
            0 ; reserved 
            0 0 0 ; no layer, visible, damage masks
            )]
-         [pixelFormat (ChoosePixelFormat hdc pfd)])
+         [ms (send config get-multisample-size)]
+         [pixelFormat (or
+		       (and wglChoosePixelFormatARB 
+			    (or (choose-multisample hdc config offscreen? ms)
+				(choose-multisample hdc config offscreen? 2)))
+		       (ChoosePixelFormat hdc pfd))])
     (and (not (zero? pixelFormat))
-         (SetPixelFormat hdc pixelFormat pfd)
+	 (and (SetPixelFormat hdc pixelFormat pfd)
-         (begin
+	      (begin
-           (DescribePixelFormat hdc pixelFormat (ctype-sizeof _PIXELFORMATDESCRIPTOR) pfd)
+		(DescribePixelFormat hdc pixelFormat (ctype-sizeof _PIXELFORMATDESCRIPTOR) pfd)
-           (when (not (zero? (bitwise-and (PIXELFORMATDESCRIPTOR-dwFlags pfd)
+		(when (not (zero? (bitwise-and (PIXELFORMATDESCRIPTOR-dwFlags pfd)
-                                          PFD_NEED_PALETTE)))
+					       PFD_NEED_PALETTE)))
-             (log-error "don't know how to create a GL palette, yet"))
+		      (log-error "don't know how to create a GL palette, yet"))
-           (let ([hglrc (wglCreateContext hdc)])
+		(let ([hglrc (wglCreateContext hdc)])
-             (and hglrc
+		  (and hglrc
-                  (new gl-context% [hglrc hglrc] [hdc hdc])))))))
+		       (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.
+  ;; 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().
+  (let ([hwnd (CreateWindowExW 0
+			       "PLTFrame"
+			       ""
+			       WS_POPUP
+			       0 0 1 1
+			       #f
+			       #f
+			       hInstance
+			       #f)])
+    (when hwnd
+      (let ([hdc (GetDC hwnd)])
+	(let ([c (create-gl-context hdc config #f #:try-ms? #f)])
+	  (when c
+	    (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)))))
+
+(define GL_TRUE 1)
+(define GL_FALSE 0)
+(define WGL_DRAW_TO_WINDOW_ARB    #x2001)
+(define WGL_DRAW_TO_BITMAP_ARB    #x2002)
+(define WGL_SUPPORT_OPENGL_ARB    #x2010)
+(define WGL_ACCELERATION_ARB      #x2003)
+(define WGL_FULL_ACCELERATION_ARB #x2027)
+(define WGL_COLOR_BITS_ARB        #x2014)
+(define WGL_ALPHA_BITS_ARB        #x201B)
+(define WGL_DEPTH_BITS_ARB        #x2022)
+(define WGL_STENCIL_BITS_ARB      #x2023)
+(define WGL_DOUBLE_BUFFER_ARB     #x2011)
+(define WGL_SAMPLE_BUFFERS_ARB    #x2041)
+(define WGL_SAMPLES_ARB           #x2042)
+
+;; The multisampling substitute for ChoosePixelFormat:
+(define (choose-multisample hdc config offscreen? ms)
+  (and 
+   wglChoosePixelFormatARB 
+   (wglChoosePixelFormatARB 
+    hdc
+    (vector (if offscreen?
+		WGL_DRAW_TO_BITMAP_ARB
+		WGL_DRAW_TO_WINDOW_ARB)
+	    GL_TRUE
+	    WGL_SUPPORT_OPENGL_ARB
+	    GL_TRUE
+	    WGL_ACCELERATION_ARB
+	    WGL_FULL_ACCELERATION_ARB
+	    WGL_COLOR_BITS_ARB
+	    24
+	    WGL_ALPHA_BITS_ARB
+	    8
+	    WGL_DEPTH_BITS_ARB
+	    (send config get-depth-size) ; 32 for offscreen?
+	    WGL_STENCIL_BITS_ARB
+	    (send config get-stencil-size)
+	    WGL_DOUBLE_BUFFER_ARB
+	    (if (and (not offscreen?)
+		     (send config get-double-buffered))
+		GL_TRUE
+		GL_FALSE)
+	    WGL_SAMPLE_BUFFERS_ARB
+	    GL_TRUE
+	    WGL_SAMPLES_ARB
+	    ms
+	    0
+	    0)
+    (vector 0.0 0.0))))