Add GdkRegion

diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd
index 77242c5..336b05f 100644 (file)
--- a/gdk/cl-gtk2-gdk.asd
+++ b/gdk/cl-gtk2-gdk.asd
@@ -9,5 +9,6 @@
                (:file "gdk.functions")
                (:file "gdk.general")
                (:file "gdk.display")
-               (:file "gdk.screen"))
+               (:file "gdk.screen")
+               (:file "gdk.region"))
   :depends-on (:cl-gtk2-glib :cffi :cl-gtk2-pango))
\ No newline at end of file

diff --git a/gdk/gdk.objects.lisp b/gdk/gdk.objects.lisp
index a2a3273..7dbcb75 100644 (file)
--- a/gdk/gdk.objects.lisp
+++ b/gdk/gdk.objects.lisp
@@ -8,6 +8,19 @@
 (defcenum notify-type (:ancestor 0) :virtual :inferior :nonlinear :nonlinear-virtual :unknown)
 (export 'notify-type)
 
+(gobject:define-g-enum "GdkFillRule"
+    gdk-fill-rule
+    (:export t :type-initializer "gdk_fill_rule_get_type")
+  (:even-odd-rule 0)
+  (:winding-rule 1))
+
+(define-g-enum "GdkOverlapType"
+    overlap-type
+    (:export t :type-initializer "gdk_overlap_type_get_type")
+  (:in 0)
+  (:out 1)
+  (:part 2))
+
 (define-g-object-class "GdkDisplay" display ()
   ((:cffi name display-name (glib:g-string :free-from-foreign nil)
           "gdk_display_get_name" nil)
@@ -99,17 +112,24 @@
    (:cffi window-stack screen-window-stack (glib:glist (g-object gdk-window) :free-from-foreign t)
           "gdk_screen_get_window_stack" nil)))
 
-;gdk_screen_get_monitor_geometry
-;gdk_screen_get_monitor_at_point
-;gdk_screen_get_monitor_at_window
-;gdk_screen_get_monitor_height_mm
-;gdk_screen_get_monitor_width_mm
-;gdk_screen_get_monitor_plug_name
-;gdk_screen_broadcast_client_message
-;gdk_screen_get_setting
-;gdk_spawn_on_screen
-;gdk_spawn_on_screen_with_pipes
-;gdk_spawn_command_line_on_screen
+(defcfun gdk-region-new :pointer)
+
+(define-g-boxed-opaque region nil :alloc (gdk-region-new))
+
+(export (boxed-related-symbols 'region))
+
+(define-g-boxed-cstruct point nil
+  (x :int)
+  (y :int))
+
+(export (boxed-related-symbols 'point))
+
+(define-g-boxed-cstruct span nil
+  (x :int)
+  (y :int)
+  (width :int))
+
+(export (boxed-related-symbols 'span))
 
 (define-g-object-class "GdkGC" graphics-context () ())
 

diff --git a/gdk/gdk.package.lisp b/gdk/gdk.package.lisp
index e4330e0..607d5ee 100755 (executable)
--- a/gdk/gdk.package.lisp
+++ b/gdk/gdk.package.lisp
@@ -1,5 +1,5 @@
 (defpackage :gdk
-  (:use :cl :gobject :cffi :pango)
+  (:use :cl :gobject :cffi :pango :iter)
   (:export #:gdk-window-events
            #:gdk-gc-set-rgb-fg-color
            #:gdk-drawable-get-size

diff --git a/gdk/gdk.region.lisp b/gdk/gdk.region.lisp
new file mode 100644 (file)
index 0000000..b6f7e4e
--- /dev/null
+++ b/gdk/gdk.region.lisp
@@ -0,0 +1,178 @@
+(in-package :gdk)
+
+(defcfun gdk-rectangle-intersect :boolean
+  (src-1 (g-boxed-foreign rectangle))
+  (src-2 (g-boxed-foreign rectangle))
+  (dest (g-boxed-foreign rectangle)))
+
+(defun rectangle-intersect (rectangle-1 rectangle-2)
+  (let ((dest (make-rectangle)))
+    (when (gdk-rectangle-intersect rectangle-1 rectangle-2 dest)
+      dest)))
+
+(export 'rectangle-intersect)
+
+(defcfun gdk-rectangle-union :boolean
+  (src-1 (g-boxed-foreign rectangle))
+  (src-2 (g-boxed-foreign rectangle))
+  (dest (g-boxed-foreign rectangle)))
+
+(defun rectangle-union (rectangle-1 rectangle-2)
+  (let ((dest (make-rectangle)))
+    (when (gdk-rectangle-union rectangle-1 rectangle-2 dest)
+      dest)))
+
+(export 'rectangle-union)
+
+(defcfun gdk-region-polygon (g-boxed-foreign region :return)
+  (points :pointer)
+  (n-points :int)
+  (fill-rule gdk-fill-rule))
+
+(defun region-from-polygon (points fill-rule)
+  (let ((n (length points)))
+    (with-foreign-object (pts 'point-cstruct n)
+      (let ((i 0))
+        (map nil (lambda (pt)
+                   (gobject::copy-slots-to-native
+                    pt
+                    (inc-pointer pts (* i (foreign-type-size 'point-cstruct)))
+                    (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'point)))
+                   (incf i))
+             points))
+      (gdk-region-polygon pts n fill-rule))))
+
+(export 'region-from-polygon)
+
+(defcfun (region-from-rectangle "gdk_region_rectangle") (g-boxed-foreign region :return)
+  (rectangle (g-boxed-foreign rectangle)))
+
+(export 'region-from-rectangle)
+
+(defcfun gdk-region-get-clipbox :void
+  (region (g-boxed-foreign region))
+  (rectangle (g-boxed-foreign rectangle)))
+
+(defun region-get-clipbox (region)
+  (let ((clipbox (make-rectangle)))
+    (gdk-region-get-clipbox region clipbox)
+    clipbox))
+
+(export 'region-get-clipbox)
+
+(defcfun gdk-region-get-rectangles :void
+  (region (g-boxed-foreign region))
+  (rectangles :pointer)
+  (n-rectangles :pointer))
+
+(defun region-get-rectangles (region)
+  (with-foreign-objects ((rectangles-ptr :pointer) (n-rectangles-ptr :int))
+    (gdk-region-get-rectangles region rectangles-ptr n-rectangles-ptr)
+    (let ((n (mem-ref n-rectangles-ptr :int))
+          (rectangles (mem-ref rectangles-ptr :pointer)))
+      (prog1
+          (iter (for i from 0 below n)
+                (for rect = (convert-from-foreign (inc-pointer rectangles (* i (foreign-type-size 'rectangle-cstruct)))
+                                                  '(g-boxed-foreign rectangle)))
+                (collect rect))
+        (glib:g-free rectangles)))))
+
+(export 'region-get-rectangles)
+
+(defcfun (region-is-empty "gdk_region_is_empty") :boolean
+  (region (g-boxed-foreign region)))
+
+(export 'region-is-empty)
+
+(defcfun (region= "gdk_region_equal") :boolean
+  (region-1 (g-boxed-foreign region))
+  (region-2 (g-boxed-foreign region)))
+
+(export 'region=)
+
+(defcfun (region-point-in "gdk_region_point_in") :boolean
+  (region (g-boxed-foreign region))
+  (x :int)
+  (y :int))
+
+(export 'region-point-in)
+
+(defcfun (region-rect-in "gdk_region_rect_in") overlap-type
+  (region (g-boxed-foreign region))
+  (rectangle (g-boxed-foreign rectangle)))
+
+(export 'region-rect-in)
+
+(defcfun (region-offset "gdk_region_offset") :void
+  (region (g-boxed-foreign region))
+  (dx :int)
+  (dy :int))
+
+(export 'region-offset)
+
+(defcfun (region-shrink "gdk_region_shrink") :void
+  (region (g-boxed-foreign region))
+  (dx :int)
+  (dy :int))
+
+(export 'region-shrink)
+
+(defcfun (region-union-with-rect "gdk_region_union_with_rect") :void
+  (region (g-boxed-foreign region))
+  (rect (g-boxed-foreign rectangle)))
+
+(export 'region-union-with-rect)
+
+(defcfun (region-intersect "gdk_region_intersect") :void
+  (target (g-boxed-foreign region))
+  (source (g-boxed-foreign region)))
+
+(export 'region-intersect)
+
+(defcfun (region-union "gdk_region_union") :void
+  (target (g-boxed-foreign region))
+  (source (g-boxed-foreign region)))
+
+(export 'region-union)
+
+(defcfun (region-subtract "gdk_region_subtract") :void
+  (target (g-boxed-foreign region))
+  (source (g-boxed-foreign region)))
+
+(export 'region-subtract)
+
+(defcfun (region-xor "gdk_region_xor") :void
+  (target (g-boxed-foreign region))
+  (source (g-boxed-foreign region)))
+
+(export 'region-xor)
+
+(defcallback gdk-span-func-callback :void
+    ((span (g-boxed-foreign span)) (data :pointer))
+  (let ((fn (stable-pointer-value data)))
+    (funcall fn span)))
+
+(defcfun gdk-region-spans-intersect-foreach :void
+  (region (g-boxed-foreign region))
+  (spans :pointer)
+  (n-spans :int)
+  (sorted :boolean)
+  (function :pointer)
+  (data :pointer))
+
+(defun region-spans-intersect-foreach (region spans sorted fn)
+  (let ((n (length spans)))
+    (with-stable-pointer (ptr fn)
+      (with-foreign-object (spans-ptr 'span-cstruct n)
+        (let ((i 0))
+          (map nil
+               (lambda (span)
+                 (gobject::copy-slots-to-native
+                  span
+                  (inc-pointer spans-ptr (* i (foreign-type-size 'span-cstruct)))
+                  (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'span)))
+                 (incf i))
+               spans))
+        (gdk-region-spans-intersect-foreach region spans-ptr n sorted (callback gdk-region-spans-intersect-foreach) ptr)))))
+
+(export 'region-spans-intersect-foreach)