gdk/gdk.region.lisp

   1 (in-package :gdk)
   2
   3 (defcfun gdk-rectangle-intersect :boolean
   4   (src-1 (g-boxed-foreign rectangle))
   5   (src-2 (g-boxed-foreign rectangle))
   6   (dest (g-boxed-foreign rectangle)))
   7
   8 (defun rectangle-intersect (rectangle-1 rectangle-2)
   9   (let ((dest (make-rectangle)))
  10     (when (gdk-rectangle-intersect rectangle-1 rectangle-2 dest)
  11       dest)))
  12
  13 (export 'rectangle-intersect)
  14
  15 (defcfun gdk-rectangle-union :boolean
  16   (src-1 (g-boxed-foreign rectangle))
  17   (src-2 (g-boxed-foreign rectangle))
  18   (dest (g-boxed-foreign rectangle)))
  19
  20 (defun rectangle-union (rectangle-1 rectangle-2)
  21   (let ((dest (make-rectangle)))
  22     (when (gdk-rectangle-union rectangle-1 rectangle-2 dest)
  23       dest)))
  24
  25 (export 'rectangle-union)
  26
  27 (defcfun gdk-region-polygon (g-boxed-foreign region :return)
  28   (points :pointer)
  29   (n-points :int)
  30   (fill-rule gdk-fill-rule))
  31
  32 (defun region-from-polygon (points fill-rule)
  33   (let ((n (length points)))
  34     (with-foreign-object (pts 'point-cstruct n)
  35       (let ((i 0))
  36         (map nil (lambda (pt)
  37                    (gobject::copy-slots-to-native
  38                     pt
  39                     (inc-pointer pts (* i (foreign-type-size 'point-cstruct)))
  40                     (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'point)))
  41                    (incf i))
  42              points))
  43       (gdk-region-polygon pts n fill-rule))))
  44
  45 (export 'region-from-polygon)
  46
  47 (defcfun (region-from-rectangle "gdk_region_rectangle") (g-boxed-foreign region :return)
  48   (rectangle (g-boxed-foreign rectangle)))
  49
  50 (export 'region-from-rectangle)
  51
  52 (defcfun gdk-region-get-clipbox :void
  53   (region (g-boxed-foreign region))
  54   (rectangle (g-boxed-foreign rectangle)))
  55
  56 (defun region-get-clipbox (region)
  57   (let ((clipbox (make-rectangle)))
  58     (gdk-region-get-clipbox region clipbox)
  59     clipbox))
  60
  61 (export 'region-get-clipbox)
  62
  63 (defcfun gdk-region-get-rectangles :void
  64   (region (g-boxed-foreign region))
  65   (rectangles :pointer)
  66   (n-rectangles :pointer))
  67
  68 (defun region-get-rectangles (region)
  69   (with-foreign-objects ((rectangles-ptr :pointer) (n-rectangles-ptr :int))
  70     (gdk-region-get-rectangles region rectangles-ptr n-rectangles-ptr)
  71     (let ((n (mem-ref n-rectangles-ptr :int))
  72           (rectangles (mem-ref rectangles-ptr :pointer)))
  73       (prog1
  74           (iter (for i from 0 below n)
  75                 (for rect = (convert-from-foreign (inc-pointer rectangles (* i (foreign-type-size 'rectangle-cstruct)))
  76                                                   '(g-boxed-foreign rectangle)))
  77                 (collect rect))
  78         (glib:g-free rectangles)))))
  79
  80 (export 'region-get-rectangles)
  81
  82 (defcfun (region-is-empty "gdk_region_empty") :boolean
  83   (region (g-boxed-foreign region)))
  84
  85 (export 'region-is-empty)
  86
  87 (defcfun (region= "gdk_region_equal") :boolean
  88   (region-1 (g-boxed-foreign region))
  89   (region-2 (g-boxed-foreign region)))
  90
  91 (export 'region=)
  92
  93 (defcfun (region-point-in "gdk_region_point_in") :boolean
  94   (region (g-boxed-foreign region))
  95   (x :int)
  96   (y :int))
  97
  98 (export 'region-point-in)
  99
 100 (defcfun (region-rect-in "gdk_region_rect_in") overlap-type
 101   (region (g-boxed-foreign region))
 102   (rectangle (g-boxed-foreign rectangle)))
 103
 104 (export 'region-rect-in)
 105
 106 (defcfun (region-offset "gdk_region_offset") :void
 107   (region (g-boxed-foreign region))
 108   (dx :int)
 109   (dy :int))
 110
 111 (export 'region-offset)
 112
 113 (defcfun (region-shrink "gdk_region_shrink") :void
 114   (region (g-boxed-foreign region))
 115   (dx :int)
 116   (dy :int))
 117
 118 (export 'region-shrink)
 119
 120 (defcfun (region-union-with-rect "gdk_region_union_with_rect") :void
 121   (region (g-boxed-foreign region))
 122   (rect (g-boxed-foreign rectangle)))
 123
 124 (export 'region-union-with-rect)
 125
 126 (defcfun (region-intersect "gdk_region_intersect") :void
 127   (target (g-boxed-foreign region))
 128   (source (g-boxed-foreign region)))
 129
 130 (export 'region-intersect)
 131
 132 (defcfun (region-union "gdk_region_union") :void
 133   (target (g-boxed-foreign region))
 134   (source (g-boxed-foreign region)))
 135
 136 (export 'region-union)
 137
 138 (defcfun (region-subtract "gdk_region_subtract") :void
 139   (target (g-boxed-foreign region))
 140   (source (g-boxed-foreign region)))
 141
 142 (export 'region-subtract)
 143
 144 (defcfun (region-xor "gdk_region_xor") :void
 145   (target (g-boxed-foreign region))
 146   (source (g-boxed-foreign region)))
 147
 148 (export 'region-xor)
 149
 150 (defcallback gdk-span-func-callback :void
 151     ((span (g-boxed-foreign span)) (data :pointer))
 152   (let ((fn (stable-pointer-value data)))
 153     (funcall fn span)))
 154
 155 (defcfun gdk-region-spans-intersect-foreach :void
 156   (region (g-boxed-foreign region))
 157   (spans :pointer)
 158   (n-spans :int)
 159   (sorted :boolean)
 160   (function :pointer)
 161   (data :pointer))
 162
 163 (defun region-spans-intersect-foreach (region spans sorted fn)
 164   (let ((n (length spans)))
 165     (with-stable-pointer (ptr fn)
 166       (with-foreign-object (spans-ptr 'span-cstruct n)
 167         (let ((i 0))
 168           (map nil
 169                (lambda (span)
 170                  (gobject::copy-slots-to-native
 171                   span
 172                   (inc-pointer spans-ptr (* i (foreign-type-size 'span-cstruct)))
 173                   (gobject::g-boxed-cstruct-wrapper-info-cstruct-description (gobject::get-g-boxed-foreign-info 'span)))
 174                  (incf i))
 175                spans))
 176         (gdk-region-spans-intersect-foreach region spans-ptr n sorted (callback gdk-region-spans-intersect-foreach) ptr)))))
 177
 178 (export 'region-spans-intersect-foreach)