+(defbinding (display-connection-number "clg_gdk_connection_number")
+ (&optional (display (display-get-default))) int
+ (display display))
+
+(defun find-display (name &optional (error-p t))
+ (or
+ (find name (list-displays) :key #'display-name :test #'string=)
+ (cdr (assoc name *display-aliases* :test #'string=))
+ (when error-p
+ (error "No such display: ~A" name))))
+
+;; This will not detect connections to the same server that use
+;; different hostnames
+(defun %find-similar-display (display)
+ (find (display-name display) (delete display (list-displays))
+ :key #'display-name :test #'string=))
+
+(defun ensure-display (display &optional existing-only-p)
+ (etypecase display
+ (null (display-get-default))
+ (display display)
+ (string (or
+ (find-display display existing-only-p)
+ (let* ((new (display-open display))
+ (existing (%find-similar-display new)))
+ (if existing
+ (progn
+ (display-add-alias existing display)
+ (display-close new)
+ existing)
+ new))))))
+
+
+;;; Display manager
+
+(defbinding display-get-default () display)
+
+(defbinding (display-set-default "gdk_display_manager_set_default_display")
+ (display) nil
+ ((display-manager) display-manager)
+ (display display))
+
+(defbinding (list-displays "gdk_display_manager_list_displays") ()
+ (gslist (static display))
+ ((display-manager) display-manager))
+
+;; The only purpose of exporting this is to make it possible for
+;; applications to connect to the display-opened signal
+(defbinding (display-manager "gdk_display_manager_get") () display-manager)
+
+(defbinding display-get-core-pointer
+ (&optional (display (display-get-default))) device
+ (display display))
+
+(defmacro with-default-display ((display) &body body)
+ (let ((saved-display (make-symbol "SAVED-DISPLAY"))
+ (current-display (make-symbol "CURRENT-DISPLAY")))
+ `(let* ((,current-display ,display)
+ (,saved-display (when ,current-display
+ (prog1
+ (display-get-default)
+ (display-set-default (ensure-display ,current-display))))))
+ (unwind-protect
+ (progn ,@body)
+ (when ,saved-display
+ (display-set-default ,saved-display))))))
+
+
+;;; Primitive graphics structures (points, rectangles and regions)
+
+(defbinding %rectangle-intersect () boolean
+ (src1 rectangle)
+ (src2 rectangle)
+ (dest rectangle))
+
+(defun rectangle-intersect (src1 src2 &optional (dest (make-instance 'rectangle)))
+ "Calculates the intersection of two rectangles. It is allowed for DEST to be the same as either SRC1 or SRC2. DEST is returned if the to rectangles intersect, otherwise NIL"
+ (when (%rectangle-intersect src1 src2 dest)
+ dest))
+
+(defbinding rectangle-union (src1 src2 &optional (dest (make-instance 'rectangle))) nil
+ "Calculates the union of two rectangles. The union of rectangles SRC1 and SRC2 is the smallest rectangle which includes both SRC1 and SRC2 within it. It is allowed for DEST to be the same as either SRC1 or SRC2."
+ (src1 rectangle)
+ (src2 rectangle)
+ (dest rectangle :in/return))
+
+(defun ensure-rectangle (rectangle)
+ (etypecase rectangle
+ (rectangle rectangle)
+ (vector (make-instance 'rectangle
+ :x (aref rectangle 0) :y (aref rectangle 1)
+ :width (aref rectangle 2) :height (aref rectangle 3)))))
+
+
+(defbinding %region-new () pointer)
+
+(defbinding %region-polygon () pointer
+ (points (vector (inlined point)))
+ (n-points int)
+ (fill-rule fill-rule))
+
+(defbinding %region-rectangle () pointer
+ (rectangle rectangle))
+
+(defbinding %region-copy () pointer
+ (location pointer))
+
+(defbinding %region-destroy () nil
+ (location pointer))
+
+(defmethod allocate-foreign ((region region) &key rectangle polygon fill-rule)
+ (cond
+ ((and rectangle polygon)
+ (error "Only one of the keyword arguments :RECTANGLE and :POLYGON can be specified"))
+ (rectangle (%region-rectangle (ensure-rectangle rectangle)))
+ (polygon (%region-polygon polygon (length polygon) fill-rule))
+ ((%region-new))))
+
+(defun ensure-region (region)
+ (etypecase region
+ (region region)
+ ((or rectangle vector)
+ (make-instance 'region :rectangle (ensure-rectangle region)))
+ (list
+ (make-instance 'region :polygon region))))
+
+(defbinding region-get-clipbox (region &optional (rectangle (make-instance 'rectangle))) nil
+ (region region)
+ (rectangle rectangle :in/return))
+
+(defbinding %region-get-rectangles () nil
+ (region region)
+ (rectangles pointer :out)
+ (n-rectangles int :out))
+
+(defun region-get-rectangles (region)
+ "Obtains the area covered by the region as a list of rectangles."
+ (multiple-value-bind (location length) (%region-get-rectangles region)
+ (prog1
+ (map-c-vector 'list #'identity location '(inlined rectangle) length :get)
+ (deallocate-memory location))))
+
+(defbinding region-empty-p () boolean
+ (region region))
+
+(defbinding region-equal-p () boolean
+ (region1 region)
+ (region2 region))
+
+(defbinding region-point-in-p () boolean
+ (region region)
+ (x int)
+ (y int))