Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added win32 gl 3.x context support.

  • Loading branch information...
commit 8d67df1bf259fe2e630a5208845d9d0faec5ca0f 1 parent 61283a1
@patzy patzy authored
View
28 src/win32/glop-win32.lisp
@@ -18,19 +18,35 @@
(defstruct wgl-context
ctx)
+;; 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)
- (when (or major minor forward-compat debug profile)
- (warn "Specific context version is not implemented, MAJOR and MINOR arguments ignored."))
(let ((ctx (make-wgl-context)))
- (let ((wgl-ctx (glop-wgl:wgl-create-context (win32-window-dc win))))
- (unless wgl-ctx
- (format t "Error creating GL context: ~S~%" (glop-win32:get-last-error)))
- (setf (wgl-context-ctx ctx) wgl-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-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-glx:correct-context? major minor))
ctx))
(defmethod destroy-gl-context ((ctx wgl-context))
View
68 src/win32/wgl.lisp
@@ -53,6 +53,19 @@
(:pfd-type-rgba 0)
(:pfd-type-color-index 1))
+(defcenum (wgl-context-attributes :unsigned-int)
+ (:major-version #x2091)
+ (:minor-version #x2092)
+ (:layer-planes #x2093)
+ (:flags #x2094)
+ (:profile-mask #x9126)
+ (:core-profile-bit #x00000001)
+ (:compatibility-profile-bit #x00000002))
+
+(defbitfield (wgl-context-attribute-flags :unsigned-int)
+ (:debug-bit #x00000001)
+ (:forward-compatible-bit #x00000002))
+
(define-foreign-library opengl
(t (:default "opengl32")))
(use-foreign-library opengl)
@@ -62,6 +75,41 @@
(defcfun ("wglCreateContext" wgl-create-context) hglrc
(dc hdc))
+(defun wgl-create-specific-context (hdc context-attribs)
+ (with-foreign-object ( atts :int (1+ (length context-attribs)))
+ (loop
+ for i below (length context-attribs)
+ 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))
+ (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
+ ;; see http://www.opengl.org/wiki/Creating_an_OpenGL_Context#Proper_Context_Creation
+ ;; 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")))
+ ;; remove out temporary context
+ (wgl-make-current (cffi:null-pointer) (cffi:null-pointer))
+ (wgl-delete-context tmp-ctx)
+ (when (null-pointer-p ptr)
+ (error "wglCreateContextAttribsARB unavailable"))
+ (let ((ctx (cffi:foreign-funcall-pointer ptr ()
+ :pointer hdc
+ :int 0
+ (:pointer :int) atts
+ :pointer)))
+ (when (null-pointer-p ctx)
+ (error "Unable to create context"))
+ ctx)))))
+
+
+(defcfun ("glGetString" get-string) :pointer
+ (name :unsigned-int))
+
(defcfun ("wglMakeCurrent" wgl-make-current) bool
(dc hdc) (rc hglrc))
@@ -136,3 +184,23 @@
(defcfun ("SwapBuffers" swap-buffers) bool
(dc hdc))
+
+
+;; FIXME: this is copied from x11/glx.lisp, we should put this in some common file
+(defun parse-gl-version-string-values (string)
+ ;; major version is integer value up to first #\.
+ ;; minor version is integer from first #\. to a #\. or #\space
+ (let ((dot (position #\. string)))
+ (values
+ (values (parse-integer string :end dot :junk-allowed t)) ; major
+ (if dot ; minor
+ (values (parse-integer string :start (1+ dot) :junk-allowed t))
+ 0))))
+
+(defun correct-context? (major-desired minor-desired)
+ (multiple-value-bind (major minor)
+ (parse-gl-version-string-values
+ (foreign-string-to-lisp (get-string (foreign-enum-value 'gl-enum :version))))
+ (when (or (< major major-desired)
+ (and (= major major-desired) (< minor minor-desired)))
+ (error "unable to create requested context"))))
View
2  src/x11/glop-x11.lisp
@@ -42,6 +42,8 @@
display ;; X display ptr
)
+;; FIXME: we should use specific context creation if available regardless of
+;; :major and :minor being nil
(defmethod create-gl-context ((win x11-window) &key (make-current t) major minor
forward-compat debug
profile)
Please sign in to comment.
Something went wrong with that request. Please try again.