Merge branch '3b-master' into devel

glop.asd

@@ -5,7 +5,7 @@
   :version "0.1.0"
   :description "Direct FFI bindings for OpenGL window and context management"
   :author "Morgan Veyret <patzy at oxyde dot org>"
-  :depends-on (:cffi)
+  :depends-on (:cffi :trivial-garbage :split-sequence)
   :components
   ((:module "src"
             :serial t
@@ -19,6 +19,7 @@
                                    (:file "keysymdef")
                                    (:file "xlib")
                                    (:file "xkb")
+                                   (:file "xcomposite")
                                    (:file "glx")
                                    (:file "display-ctrl")
                                    (:file "glop-x11")))
@@ -40,6 +41,7 @@
                       :components ((:file "package")
                                    (:file "win32")
                                    (:file "wgl")
+                                   (:file "dwm")
                                    (:file "glop-win32")))
              (:file "glop")))))
 

src/glop.lisp

@@ -93,6 +93,10 @@ Returns NIL if no match is found."
   (:documentation
    "Closes the provided window *without* releasing any attached GL context."))
 
+(defgeneric %init-swap-interval (window)
+  (:method (w)
+    (setf (swap-interval-function w) :unsupported)))
+
 (defun create-window (title width height &key (x 0) (y 0) major minor fullscreen
                                               (win-class 'window)
                                               (double-buffer t)
@@ -107,10 +111,18 @@ Returns NIL if no match is found."
                                               (accum-green-size 0)
                                               (accum-blue-size 0)
                                               stencil-buffer
-                                              (stencil-size 0))
-  "Creates a new window with an attached GL context using the provided visual attributes.
-   Major and minor arguments specify the context version to use, when NIL
-   (default value) old style gl context creation is used.
+                                              (stencil-size 0)
+                                           profile
+                                           (gl t))
+  "Creates a new window with an attached GL context using the provided
+   visual attributes.
+
+   Major and minor arguments specify the context version to use. When
+   NIL (default value) old style gl context creation is used. Some
+   combinations of platforms and drivers may require :PROFILE :CORE to
+   use versions newer than 2.1, while others will use newest version
+   even if version is not specified.
+
    The created window will be of the WINDOW class, you can override this by
    specifying your own class using :WIN-CLASS."
   (let ((win (make-instance win-class)))
@@ -129,8 +141,11 @@ Returns NIL if no match is found."
                  :accum-blue-size accum-blue-size
                  :stencil-buffer stencil-buffer
                  :stencil-size stencil-size)
-    (create-gl-context win :major major :minor minor
-                           :make-current t)
+    (if gl
+        (create-gl-context win :major major :minor minor
+                               :make-current t
+                               :profile profile)
+        (setf (window-gl-context win) nil))
     (show-window win)
     (set-fullscreen win fullscreen)
     win))
@@ -185,7 +200,8 @@ set window fullscreen state."
 
 (defgeneric show-window (window)
   (:documentation
-   "Make WINDOW visible."))
+   "Make WINDOW visible. (may need to be called twice when window is
+   shown for the first time on Windows.)"))
 
 (defgeneric hide-window (window)
   (:documentation
@@ -199,6 +215,29 @@ set window fullscreen state."
   (:documentation
    "Swaps GL buffers."))
 
+(defgeneric swap-interval (window interval)
+  (:documentation
+   "Specify number of vsync intervals to wait before swap-buffers takes effect.
+
+Use 0 for no vsync, 1 for normal vsync, 2 for 1/2 monitor refresh rate, etc.
+
+If INTERVAL is negativem the absolute value is used, and when
+supported swap won't wait for vsync if specified interval has already
+elapsed.
+
+May be ignored or only partially supported depending on platform and
+user settings.")
+  ;; windows: only supports 0/1 when dwm is enabled (always on win8+ i think?)
+  ;; (possibly could support > 1 with dwm, but hard to detect if some vsync
+  ;;  already passed so would always wait N frames. Possibly could combine
+  ;;  a normal SwapInterval call with N-1 and a dwmFlush?)
+  ;; linux: todo (depends on GLX_EXT_swap_control, GLX_EXT_swap_control_tear
+  ;; osx: todo
+  ;; todo: some way to query supported options
+  (:method (w i)
+    ;; just do nothing by default for now
+    (declare (ignore w i))))
+
 (defgeneric show-cursor (window)
   (:documentation
    "Enable cursor display for WINDOW"))
@@ -207,6 +246,24 @@ set window fullscreen state."
   (:documentation
    "Disable cursor display for WINDOW"))
 
+;; slightly lower-level API for things related to fullscreen
+(defgeneric maximize-window (window)
+  (:documentation
+   "'Maximize' a window to fill screen, without changing screen mode
+   or window decoractions."))
+
+(defgeneric restore-window (window)
+  (:documentation
+   "Undo the effects of MAXIMIZE-WINDOW"))
+
+(defgeneric remove-window-decorations (window)
+  (:documentation
+   "Remove window border, title, etc. if possible."))
+
+(defgeneric restore-window-decorations (window)
+  (:documentation
+   "Restore window border, title, etc."))
+
 ;;; Events handling
 (defmacro define-simple-print-object (type &rest attribs)
   `(defmethod print-object ((event ,type) stream)
@@ -305,6 +362,61 @@ set window fullscreen state."
   (:default-initargs :focused nil)
   (:documentation "Window lost focus."))
 
+(defclass child-event (event)
+  ;; 'child' is platform specific id of child window for now.
+  ;; might be nicer to wrap it in some class, but then we would have
+  ;; to maintain a mapping of IDs to instances, and would probably
+  ;; want some way for applications to specify which class as well
+  ((child :initarg :child :reader child))
+  (:documentation "Status of child window changed."))
+
+(defclass child-created-event (child-event)
+  ;; 'parent' is a platform specific ID, for similar reasons to
+  ;; 'child' above...
+  ((parent :initarg :parent :reader parent)
+   (x :initarg :x :reader x)
+   (y :initarg :y :reader y)
+   (width :initarg :width :reader width)
+   (height :initarg :height :reader height)))
+(define-simple-print-object child-created-event x y width height)
+
+(defclass child-destroyed-event (child-event)
+  ;; 'parent' is a platform specific ID, for similar reasons to
+  ;; 'child' above...
+  ((parent :initarg :parent :reader parent)))
+(define-simple-print-object child-destroyed-event parent child)
+
+(defclass child-reparent-event (child-event)
+  ;; 'parent' is a platform specific ID, for similar reasons to
+  ;; 'child' above...
+  ((parent :initarg :parent :reader parent)
+   (x :initarg :x :reader x)
+   (y :initarg :y :reader y)))
+(define-simple-print-object child-reparent-event x y)
+
+(defclass child-visibility-event (child-event)
+  ((visible :initarg :visible :reader visible))
+  (:documentation "Child window visibility changed."))
+(define-simple-print-object child-visibility-event visible)
+
+(defclass child-visibility-obscured-event (child-visibility-event)
+  ()
+  (:default-initargs :visible nil)
+  (:documentation "Child window was fully obscured."))
+
+(defclass child-visibility-unobscured-event (child-visibility-event)
+  ()
+  (:default-initargs :visible t)
+  (:documentation "Child window was unobscured."))
+
+(defclass child-resize-event (child-event)
+  ;; possibly should store position too unless we figure out how to map
+  ;; child IDs to actual window instances?
+  ((width :initarg :width :reader width)
+   (height :initarg :height :reader height))
+  (:documentation "Child window resized."))
+(define-simple-print-object child-resize-event width height)
+
 (defun push-event (window evt)
   "Push an artificial event into the event processing system.
 Note that this has no effect on the underlying window system."
@@ -399,8 +511,8 @@ Returns NIL on :CLOSE event, T otherwise."
 
 (defmacro with-window ((win-sym title width height &rest attribs) &body body)
   "Creates a window and binds it to WIN-SYM.  The window is detroyed when body exits."
-  `(let ((,win-sym (apply #'create-window ,title ,width ,height
-                          (list ,@attribs))))
+  `(let ((,win-sym (create-window ,title ,width ,height
+                                  ,@attribs)))
      (when ,win-sym
        (unwind-protect (progn ,@body)
          (destroy-window ,win-sym)))))

src/package.lisp

@@ -40,6 +40,10 @@
    #+(and unix (not darwin))#:x11-window-id
    #+(and unix (not darwin))#:x11-window-display
    #+(or win32 windows)#:win32-window-id
-   ))
+   #:maximize-window
+   #:restore-window
+   #:remove-window-decorations
+   #:restore-window-decorations
+   #:swap-interval))
 
 

src/utils.lisp

@@ -21,16 +21,29 @@
   (height 0 :type integer)
   (depth 0 :type integer))
 
+(defclass swap-interval-mixin ()
+  ((swap-interval-function :initform :uninitialized
+                           :accessor swap-interval-function)
+   (swap-interval-tear :accessor swap-interval-tear)))
+
 ;; platform specific windows
 ;; XXX: this may move to platform specific directories
 
 #+(or win32 windows)
-(defclass win32-window ()
+(defclass win32-window (swap-interval-mixin)
   ((module-handle :initarg :module-handle :accessor win32-window-module-handle)
    (class-name :accessor win32-window-class-name)
    (pixel-format :accessor win32-window-pixel-format)
    (dc :accessor win32-window-dc)
-   (id :accessor win32-window-id)))
+   (id :accessor win32-window-id)
+   (in-size-move :accessor win32-window-in-size-move :initform nil
+                 :accessor in-size-move)
+   (size-event :initform nil
+               :accessor win32-window-pushed-size-event)
+   ;; store desired swap interval in case we are using dwm instead
+   (swap-interval :accessor win32-window-swap-interval)
+   (win32-window-dwm-active :initform :uninitialized
+                            :reader win32-window-dwm-active)))
 
 #+(and unix (not darwin))
 (defclass x11-window ()

src/win32/dwm.lisp

@@ -0,0 +1,21 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; indent-tabs-mode: nil -*-
+
+(in-package #:glop-win32)
+
+
+(cffi:define-foreign-library dwm
+  (:windows "Dwmapi.dll"))
+
+(cffi:use-foreign-library dwm)
+
+(cffi:defcfun ("DwmFlush" dwm-flush) :int)
+
+(cffi:defcfun ("DwmIsCompositionEnabled" %dwm-is-composition-enabled) :int32
+  (enabled (:pointer bool)))
+
+(defun dwm-is-composition-enabled ()
+  (with-foreign-object (p 'bool)
+    (let ((hr (%dwm-is-composition-enabled p)))
+      (if (zerop hr)
+          (not (zerop (mem-ref p 'bool)))
+          (error "dwm-is-composition-enabled failed 0x~x~%" hr)))))