Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Some cleaning.

commit d5dfa7909d63594c428db496632ad132bd8db919 1 parent 61842c8
@patzy authored
View
2  src/glop.lisp
@@ -21,8 +21,6 @@
"Returns the current video mode."))
;; XXX: stupid distance match is maybe not the best option here...
-;; FIXME: consider video modes with different refresh rate and depth?
-;; FIXME: return current-mode as a default if no match found?
(defun closest-video-mode (current-mode modes-list dwidth dheight &optional ddepth drate)
"Try to find the closest video mode matching desired parameters within modes-list.
Returns NIL if no match is found."
View
160 src/win32/glop-win32.lisp
@@ -18,36 +18,34 @@
(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)
+ 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,56 +59,54 @@
(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))
+ (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)))
+ (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))
+ "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-dc win)
+ (glop-win32:get-dc (win32-window-id win)))
(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))
+ (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)
@@ -118,20 +114,20 @@
(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)
@@ -160,5 +156,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
2  src/win32/wgl.lisp
@@ -91,7 +91,6 @@
(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 (wgl-get-proc-address "wglCreateContextAttribsARB")))
@@ -189,7 +188,6 @@
(dc hdc))
-
(defun correct-context? (major-desired minor-desired)
(multiple-value-bind (major minor)
(parse-gl-version-string-values
View
2  src/win32/win32.lisp
@@ -346,7 +346,7 @@
(size word)
(driver-extra word)
(fields dword)
- (union-1 :short :count 8) ;; FIXME: orientation data is here
+ (union-1 :short :count 8) ;; XXX: orientation data is here
(color :short)
(duplex :short)
(y-resolution :short)
View
2  src/x11/glop-x11.lisp
@@ -42,8 +42,6 @@
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.