From 5d32c53a9b28cf514deef28e69583301bc378287 Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sat, 31 Oct 2009 22:59:19 +0300 Subject: [PATCH] Add GdkRegion --- gdk/cl-gtk2-gdk.asd | 3 +- gdk/gdk.objects.lisp | 42 ++++++++---- gdk/gdk.package.lisp | 2 +- gdk/gdk.region.lisp | 178 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 212 insertions(+), 13 deletions(-) create mode 100644 gdk/gdk.region.lisp diff --git a/gdk/cl-gtk2-gdk.asd b/gdk/cl-gtk2-gdk.asd index 77242c5..336b05f 100644 --- 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 --- 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 --- 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 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) -- 1.7.10.4