Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Creating specific context appears to work again.

  • Loading branch information...
commit 51fe11f7d42af32edcc0f5b3cdcf608aca4c2720 1 parent 81adadf
@johnfredcee johnfredcee authored
Showing with 93 additions and 87 deletions.
  1. +87 −84 src/win32/glop-win32.lisp
  2. +6 −3 src/win32/wgl.lisp
View
171 src/win32/glop-win32.lisp
@@ -21,33 +21,33 @@
;; FIXME: we should use specific context creation if available regardless of
;; :major and :minor being nil
(defmethod create-gl-context ((win win32-window) &key (make-current t) major minor
- forward-compat debug
- profile)
+ forward-compat debug
+ profile)
(let ((ctx (make-wgl-context)))
- (setf (wgl-context-ctx ctx)
- (if (and major minor)
- (let ((attrs (list :major-version major :minor-version minor)))
- (when profile
- (case profile
- (:core (push :core-profile-bit attrs))
- (:compat (push :compatibility-profile-bit attrs)))
- (push :profile-mask attrs))
- (when (or forward-compat debug)
- (let ((flags '()))
- (when forward-compat (push :forward-compatible-bit flags))
- (when debug (push :debug-bit flags))
- (push flags attrs)
- (push :flags attrs)))
- (glop-wgl:wgl-create-specific-context (win32-window-dc win) attrs))
- (glop-wgl:wgl-create-context (win32-window-dc win))))
- (unless (wgl-context-ctx ctx)
- (format t "Error creating GL context: ~S~%" (glop-win32:get-last-error)))
- (when make-current
- (attach-gl-context win ctx))
- (when (and major minor)
- (glop-wgl:correct-context? major minor))
- ctx))
+ (setf (wgl-context-ctx ctx)
+ (if (and major minor)
+ (let ((attrs (list :major-version major :minor-version minor)))
+ (when profile
+ (case profile
+ (:core (push :core-profile-bit attrs))
+ (:compat (push :compatibility-profile-bit attrs)))
+ (push :profile-mask attrs))
+ (when (or forward-compat debug)
+ (let ((flags '()))
+ (when forward-compat (push :forward-compatible-bit flags))
+ (when debug (push :debug-bit flags))
+ (push flags attrs)
+ (push :flags attrs)))
+ (glop-wgl:wgl-create-specific-context (win32-window-dc win) attrs))
+ (glop-wgl:wgl-create-context (win32-window-dc win))))
+ (unless (wgl-context-ctx ctx)
+ (format t "Error creating GL context: ~S~%" (glop-win32:get-last-error)))
+ (when make-current
+ (attach-gl-context win ctx))
+ (when (and major minor)
+ (glop-wgl:correct-context? major minor))
+ ctx))
(defmethod destroy-gl-context ((ctx wgl-context))
(detach-gl-context ctx)
@@ -61,74 +61,77 @@
(glop-wgl::wgl-make-current (cffi:null-pointer) (cffi:null-pointer)))
(defmethod open-window ((win win32-window) title width height &key (x 0) (y 0)
- (rgba t)
- (double-buffer t)
- stereo
- (red-size 4)
- (green-size 4)
- (blue-size 4)
- (alpha-size 4)
- (depth-size 16)
- accum-buffer
- (accum-red-size 0)
- (accum-green-size 0)
- (accum-blue-size 0)
- stencil-buffer
- (stencil-size 0))
- (setf (win32-window-module-handle win)(glop-win32:get-module-handle (cffi:null-pointer)))
+ (rgba t)
+ (double-buffer t)
+ stereo
+ (red-size 4)
+ (green-size 4)
+ (blue-size 4)
+ (alpha-size 4)
+ (depth-size 16)
+ accum-buffer
+ (accum-red-size 0)
+ (accum-green-size 0)
+ (accum-blue-size 0)
+ stencil-buffer
+ (stencil-size 0))
+ (setf (win32-window-module-handle win)
+ (glop-win32:get-module-handle (cffi:null-pointer)))
;; register window class
(glop-win32:create-and-register-class (win32-window-module-handle win) "GLOP-OpenGL")
(setf (win32-window-class-name win) "GLOP-OpenGL")
+ ;; create the window
(let ((wnd (glop-win32:create-window-ex '(:ws-ex-app-window :ws-ex-window-edge)
- "GLOP-OpenGL"
- title
- '(:ws-overlapped-window :ws-clip-siblings :ws-clip-children)
- x y width height (cffi:null-pointer) (cffi:null-pointer)
- (win32-window-module-handle win) (cffi:null-pointer))))
- (unless wnd
- (error "Can't create window (error ~S)~%" (glop-win32:get-last-error)))
- (setf (win32-window-id win) wnd))
- (%update-geometry win x y width height)
- (setf (win32-window-dc win) (glop-win32:get-dc (win32-window-id win)))
- ;; FIXME: we need something easier to pass all attributes here
- ;; FIXME: use pixel format extensions if available
- (setf (win32-window-pixel-format win) (glop-win32:choose-pixel-format
- (win32-window-dc win)
- :rgba rgba
- :double-buffer double-buffer
- :stereo stereo
- :red-size red-size
- :green-size green-size
- :blue-size blue-size
- :alpha-size alpha-size
- :depth-size depth-size
- :accum-buffer accum-buffer
- :accum-red-size accum-red-size
- :accum-green-size accum-green-size
- :accum-blue-size accum-blue-size
- :stencil-buffer stencil-buffer
- :stencil-size stencil-size))
- (glop-win32:set-foreground-window (win32-window-id win))
- (glop-win32:update-window (win32-window-id win))
- win)
+ "GLOP-OpenGL"
+ title
+ '(:ws-overlapped-window :ws-clip-siblings :ws-clip-children)
+ x y width height (cffi:null-pointer) (cffi:null-pointer)
+ (win32-window-module-handle win) (cffi:null-pointer))))
+ (unless wnd
+ (error "Can't create window (error ~S)~%" (glop-win32:get-last-error)))
+ (setf (win32-window-id win) wnd))
+ (%update-geometry win x y width height)
+ (setf (win32-window-dc win)
+ (glop-win32:get-dc (win32-window-id win)))
+ ;; FIXME: we need something easier to pass all attributes here
+ ;; FIXME: use pixel format extensions if available
+ (setf (win32-window-pixel-format win) (glop-win32:choose-pixel-format
+ (win32-window-dc win)
+ :rgba rgba
+ :double-buffer double-buffer
+ :stereo stereo
+ :red-size red-size
+ :green-size green-size
+ :blue-size blue-size
+ :alpha-size alpha-size
+ :depth-size depth-size
+ :accum-buffer accum-buffer
+ :accum-red-size accum-red-size
+ :accum-green-size accum-green-size
+ :accum-blue-size accum-blue-size
+ :stencil-buffer stencil-buffer
+ :stencil-size stencil-size))
+ (glop-win32:set-foreground-window (win32-window-id win))
+ (glop-win32:update-window (win32-window-id win))
+ win)
(defmethod close-window ((win win32-window))
(glop-win32:destroy-window (win32-window-id win))
(glop-win32:unregister-class (win32-window-class-name win)
- (win32-window-module-handle win)))
+ (win32-window-module-handle win)))
(defmethod set-fullscreen ((win win32-window) &optional (state (not (window-fullscreen win))))
(with-accessors ((id win32-window-id)
- (fullscreen window-fullscreen))
- win
- (unless (eq state fullscreen)
- (if state
- (progn (glop-win32::%set-fullscreen (win32-window-id win) t)
- (setf fullscreen t))
- (progn (glop-win32::%set-fullscreen (win32-window-id win) nil)
- (setf fullscreen nil))))
- (glop-win32:update-window (win32-window-id win))
- (show-window win)))
+ (fullscreen window-fullscreen))
+ win
+ (unless (eq state fullscreen)
+ (if state
+ (progn (glop-win32::%set-fullscreen (win32-window-id win) t)
+ (setf fullscreen t))
+ (progn (glop-win32::%set-fullscreen (win32-window-id win) nil)
+ (setf fullscreen nil))))
+ (glop-win32:update-window (win32-window-id win))
+ (show-window win)))
(defmethod set-geometry ((win win32-window) x y width height)
@@ -157,5 +160,5 @@
(defun %next-event (win &key blocking)
(let ((evt (glop-win32:next-event win (win32-window-id win) blocking)))
- (setf glop-win32:%event% nil)
- evt))
+ (setf glop-win32:%event% nil)
+ evt))
View
9 src/win32/wgl.lisp
@@ -66,6 +66,9 @@
(:debug-bit #x00000001)
(:forward-compatible-bit #x00000002))
+(defcenum (gl-enum :unsigned-int)
+ (:version #x1F02))
+
(define-foreign-library opengl
(t (:default "opengl32")))
(use-foreign-library opengl)
@@ -82,8 +85,8 @@
for attr in context-attribs do
(setf (mem-aref atts :int i)
(typecase attr
- (keyword (foreign-enum-value 'glx-context-attributes attr))
- (list (foreign-bitfield-value 'glx-context-attribute-flags attr))
+ (keyword (foreign-enum-value 'wgl-context-attributes attr))
+ (list (foreign-bitfield-value 'wgl-context-attribute-flags attr))
(t attr))))
(setf (mem-aref atts :int (length context-attribs)) 0)
;; we need a fake gl context to be able to use wgl-get-proc-address
@@ -91,7 +94,7 @@
;; FIXME: need some more error checking here
(let ((tmp-ctx (wgl-create-context hdc)))
(wgl-make-current hdc tmp-ctx)
- (let ((ptr (glx-get-proc-address "wglCreateContextAttribsARB")))
+ (let ((ptr (wgl-get-proc-address "wglCreateContextAttribsARB")))
;; remove out temporary context
(wgl-make-current (cffi:null-pointer) (cffi:null-pointer))
(wgl-delete-context tmp-ctx)
Please sign in to comment.
Something went wrong with that request. Please try again.