diff --git a/c/xlib/region.c b/c/xlib/region.c new file mode 100644 index 0000000..dc5974e --- /dev/null +++ b/c/xlib/region.c @@ -0,0 +1,168 @@ +#include "xlib.h" + +s48_value scx_Destroy_Region(s48_value Xregion) { + XDestroyRegion(SCX_EXTRACT_REGION(Xregion)); + return S48_UNSPECIFIC; +} + +s48_value scx_Create_Region () { + return SCX_ENTER_REGION(XCreateRegion()); +} + +s48_value scx_Clip_Box(s48_value Xregion) { + XRectangle r; + s48_value v = s48_make_vector(4, S48_FALSE); + S48_DECLARE_GC_PROTECT(1); + + XClipBox(SCX_EXTRACT_REGION(Xregion), &r); + + S48_GC_PROTECT_1(v); + S48_VECTOR_SET(v, 0, s48_enter_integer(r.x)); + S48_VECTOR_SET(v, 1, s48_enter_integer(r.y)); + S48_VECTOR_SET(v, 2, s48_enter_integer(r.width)); + S48_VECTOR_SET(v, 3, s48_enter_integer(r.height)); + + S48_GC_UNPROTECT(); + return v; +} + +s48_value scx_Region_Empty(s48_value Xregion) { + return XEmptyRegion(SCX_EXTRACT_REGION(Xregion)) ? S48_TRUE : S48_FALSE; +} + +s48_value scx_Region_Equal(s48_value Xr1, s48_value Xr2) { + return XEqualRegion(SCX_EXTRACT_REGION(Xr1), + SCX_EXTRACT_REGION(Xr2)) ? S48_TRUE : S48_FALSE; +} + +s48_value scx_Point_In_Region(s48_value Xregion, s48_value x, s48_value y) { + return XPointInRegion(SCX_EXTRACT_REGION(Xregion), + s48_extract_integer(x), + s48_extract_integer(y)) ? S48_TRUE : S48_FALSE; +} + +s48_value scx_Rect_In_Region(s48_value Xregion, s48_value x, s48_value y, + s48_value w, s48_value h) { + int res = XRectInRegion(SCX_EXTRACT_REGION(Xregion), + s48_extract_integer(x), + s48_extract_integer(y), + s48_extract_integer(w), + s48_extract_integer(h)); + if (res == RectangleIn) res = 1; + else if (res == RectangleOut) res = 0; + else if (res == RectanglePart) res = 2; + return s48_enter_integer(res); +} + +s48_value scx_Intersect_Region(s48_value Xr1, s48_value Xr2) { + Region res = XCreateRegion(); + XIntersectRegion(SCX_EXTRACT_REGION(Xr1), + SCX_EXTRACT_REGION(Xr2), + res); + return SCX_ENTER_REGION(res); +} + +s48_value scx_Union_Region(s48_value Xr1, s48_value Xr2) { + Region res = XCreateRegion(); + XUnionRegion(SCX_EXTRACT_REGION(Xr1), + SCX_EXTRACT_REGION(Xr2), + res); + return SCX_ENTER_REGION(res); +} + +s48_value scx_Union_Rect_With_Region(s48_value x, s48_value y, s48_value w, + s48_value h, s48_value r) { + Region res = XCreateRegion(); + XRectangle rect; + rect.x = s48_extract_integer(x); + rect.y = s48_extract_integer(y); + rect.width = s48_extract_integer(w); + rect.height = s48_extract_integer(h); + + XUnionRectWithRegion(&rect, SCX_EXTRACT_REGION(r), res); + return SCX_ENTER_REGION(res); +} + +s48_value scx_Subtract_Region(s48_value Xr1, s48_value Xr2) { + Region res = XCreateRegion(); + XSubtractRegion( SCX_EXTRACT_REGION(Xr1), + SCX_EXTRACT_REGION(Xr2), + res ); + return SCX_ENTER_REGION( res ); +} + +s48_value scx_Xor_Region(s48_value Xr1, s48_value Xr2) { + Region res = XCreateRegion(); + XXorRegion( SCX_EXTRACT_REGION(Xr1), + SCX_EXTRACT_REGION(Xr2), + res ); + return SCX_ENTER_REGION( res ); +} + +s48_value scx_Offset_Region(s48_value Xregion, s48_value dx, s48_value dy) { + XOffsetRegion(SCX_EXTRACT_REGION(Xregion), + s48_extract_integer(dx), + s48_extract_integer(dy)); + return S48_UNSPECIFIC; +} + +s48_value scx_Shrink_Region(s48_value Xregion, s48_value dx, s48_value dy) { + XShrinkRegion(SCX_EXTRACT_REGION(Xregion), + s48_extract_integer(dx), + s48_extract_integer(dy)); + return S48_UNSPECIFIC; +} + +s48_value scx_Copy_Region(s48_value Xfrom, s48_value Xto) { + Region from = SCX_EXTRACT_REGION(Xfrom); + Region to = SCX_EXTRACT_REGION(Xto); + + // I don't know a better solution then this: + XUnionRegion(from, from, to); + + return S48_UNSPECIFIC; +} + +s48_value scx_Polygon_Region(s48_value points, s48_value fillrule) { + int n = S48_VECTOR_LENGTH(points); + XPoint ps[n]; + int fill_rule = Symbols_To_Bits(fillrule, Fill_Rule_Syms); + int i; + Region res; + for (i=0; i < n; i++) { + s48_value p = S48_VECTOR_REF(points, i); + ps[i].x = S48_CAR(p); + ps[i].y = S48_CDR(p); + } + res = XPolygonRegion(ps, n, fill_rule); + + return SCX_ENTER_REGION(res); +} + +s48_value scx_Set_Region(s48_value Xdisplay, s48_value Xgcontext, + s48_value Xregion) { + XSetRegion(SCX_EXTRACT_DISPLAY(Xdisplay), + SCX_EXTRACT_GCONTEXT(Xgcontext), + SCX_EXTRACT_REGION(Xregion)); + return S48_UNSPECIFIC; +} + +void scx_init_region(void) { + S48_EXPORT_FUNCTION(scx_Destroy_Region); + S48_EXPORT_FUNCTION(scx_Create_Region); + S48_EXPORT_FUNCTION(scx_Clip_Box); + S48_EXPORT_FUNCTION(scx_Region_Empty); + S48_EXPORT_FUNCTION(scx_Region_Equal); + S48_EXPORT_FUNCTION(scx_Point_In_Region); + S48_EXPORT_FUNCTION(scx_Rect_In_Region); + S48_EXPORT_FUNCTION(scx_Intersect_Region); + S48_EXPORT_FUNCTION(scx_Union_Region); + S48_EXPORT_FUNCTION(scx_Union_Rect_With_Region); + S48_EXPORT_FUNCTION(scx_Subtract_Region); + S48_EXPORT_FUNCTION(scx_Xor_Region); + S48_EXPORT_FUNCTION(scx_Offset_Region); + S48_EXPORT_FUNCTION(scx_Shrink_Region); + S48_EXPORT_FUNCTION(scx_Polygon_Region); + S48_EXPORT_FUNCTION(scx_Set_Region); +} + diff --git a/scheme/xlib/region-type.scm b/scheme/xlib/region-type.scm new file mode 100644 index 0000000..a563ae8 --- /dev/null +++ b/scheme/xlib/region-type.scm @@ -0,0 +1,42 @@ +(define-record-type region :region + (really-make-region tag Xregion) + region? + (tag region-tag region-set-tag!) + (Xregion region-Xregion region-set-Xregion!)) + +(define (make-region Xregion finalize?) + (let ((maybe-region (region-list-find Xregion))) + (if maybe-region + maybe-region + (let ((region (really-make-region #f Xregion))) + (if finalize? + (add-finalizer! region destroy-region) + (add-finalizer! region region-list-delete!)) + (region-list-set! Xregion region) + region)))) + +(define (destroy-region region) + (%destroy-region (region-Xregion region)) + (region-list-delete! region)) + +(import-lambda-definition %destroy-region (Xregion) + "scx_Destroy_Region") + +;; All region records need to be saved in a weak-list, to have only one record +;; for the same XLib region + +(define *weak-region-list* (make-integer-table)) + +(define (region-list-find Xregion) + (let ((r (table-ref *weak-region-list* Xregion))) + (if r + (weak-pointer-ref r) + r))) + +(define (region-list-set! Xregion region) + (let ((p (make-weak-pointer region))) + (table-set! *weak-region-list* Xregion p))) + +(define (region-list-delete! region) + (table-set! *weak-region-list* + (region-Xregion region) #f)) diff --git a/scheme/xlib/region.scm b/scheme/xlib/region.scm new file mode 100644 index 0000000..0a6f0b6 --- /dev/null +++ b/scheme/xlib/region.scm @@ -0,0 +1,206 @@ +;; create-region creates a new empty region. See XCreateRegion. + +(define (create-region) + (make-region (%create-region) #t)) + +(import-lambda-definition %create-region () + "scx_Create_Region") + +;; clip-box returns the smalles rectangle enclosing the specified +;; region. The resulting rectangle is a list of four elements: x, y, +;; width and height. See XClipBox. + +(define (clip-box region) + (vector->list (%clip-box (region-Xregion region)))) + +(import-lambda-definition %clip-box (Xregion) + "scx_Clip_Box") + +;; region-empty? returns true if the region is empty. See XEmptyRegion + +(define (region-empty? region) + (%region-empty? (region-Xregion region))) + +(import-lambda-definition %region-empty? (Xregion) + "scx_Region_Empty") + +;; region-equal? returns true if the two regions have the same offset, +;; size, and shape. See XEqualRegion. + +(define (region-equal? r1 r2) + (%region-equal? (region-Xregion r1) + (region-Xregion r2))) + +(import-lambda-definition %region-equal? (Xr1 Xr2) + "scx_Region_Equal") + +;; point-in-region? function returns true if the point (x, y) is +;; contained in the region r. See XPointInRegion. + +(define (point-in-region? region x y) + (%point-in-region? (region-Xregion region) + x y)) + +(import-lambda-definition %point-in-region? (Xregion x y) + "scx_Point_In_Region") + +;; rectangle-in-region? returns 'in if the rectangle is entirely in +;; the specified region, #f if the rectangle is entirely out of the +;; specified region, and 'part if the rectangle is partially in the +;; specified region. rectangle is a list '(x y width height). See +;; XRectInRegion. + +(define (rectangle-in-region? region rectangle) + (case (%rectanlge-in-region? (region-Xregion region) + (car rectangle) (cadr rectangle) + (caddr rectangle) (cadddr rectangle)) + ((0) #f) + ((1) 'in) + ((2) 'part))) + +(import-lambda-definition %rectangle-in-region? (Xregion x y w h) + "scx_Rect_In_Region") + +;; intersect-region returns the intersection of two regions. See +;; XIntersectRegion. + +(define (intersect-region r1 r2) + (make-region (%intersect-region (region-Xregion r1) + (region-Xregion r1)) + #t)) + +(import-lambda-definition %intersect-region (Xr1 Xr2) + "scx_Intersect_Region") + +;; union-region returns the union of two regions. See XUnionRegion. + +(define (union-region r1 r2) + (make-region (%union-region (region-Xregion r1) + (region-Xregion r1)) + #t)) + +(import-lambda-definition %union-region (Xr1 Xr2) + "scx_Union_Region") + +;; union-rectangle-with-region returns the union of the specified +;; rectangle and the specified region. The rectangle is a list (x y +;; width height) See XUnionRectWithRegion. + +(define (union-rectangle-with-region rectangle region) + (make-region (%union-rectangle-with-region + (car rectangle) (cadr rectangle) + (caddr rectangle) (cadddr rectangle) + (region-Xregion region)) + #t)) + +(import-lambda-definition %union-rectangle-with-region (x y w h Xregion) + "scx_Union_Rect_With_Region") + +;; subtract-region subtracts r2 from r1 and returns the resulting +;; region. See XSubtractRegion. + +(define (subtract-region r1 r2) + (make-region (%subtract-region (region-Xregion r1) + (region-Xregion r2)) + #t)) + +(import-lambda-definition %subtract-region (Xr1 Xr2) + "scx_Subtract_Region") + +;; xor-region calculates the difference between the union and +;; intersection of two regions and returns the resulting region. See +;; XXorRegion. + +(define (xor-region r1 r2) + (make-region (%xor-region (region-Xregion r1) + (region-Xregion r2)) + #t)) + +(import-lambda-definition %xor-region (Xr1 Xr2) + "scx_Xor_Region") + +;; offset-region! moves the specified region by a dx and dy. See +;; XOffsetRegion. + +(define (offset-region! region dx dy) + (%offset-region! (region-Xregion region) + dx dy)) + +(import-lambda-definition %offset-region (Xregion dx dy) + "scx_Offset_Region") + +;; shrink-region! reduces the specified region by specified +;; amount. Positive values shrink the size of the region, and negative +;; values expand the region. + +(define (shrink-region! region dx dy) + (%shrink-region! (region-Xregion region) + dx dy)) + +(import-lambda-definition %shrink-region! (Xregion dx dy) + "scx_Shrink_Region") + +;; polygon-region returns a region for the polygon defines by +;; points. points has to a list of pairs (x . y). For an explanation +;; of fill-rule see create-gcontext. See XPolygonRegion. + +(define (polygon-region points fill-rule) + (make-region (%polygon-region (list->vector points) + fill-rule) + #t)) + +(import-lambda-definition %polygon-region (points fillrule) + "scx_Polygon_Region") + +;; set-region sets the clip-mask in the GC to the specified region. +;; The region is specified relative to the drawable's origin. The +;; resulting GC clip origin is implementation-dependent. Once it is +;; set in the GC, the region can be destroyed. See XSetRegion. + +(define (set-region gcontext region) + (%set-region (display-Xdisplay (gcontext-display gcontext)) + (gcontext-Xgcontext gcontext) + (region-Xregion region))) + +(import-lambda-definition %set-region (Xdisplay Xgontext Xregion) + "scx_Set_Region") + +;;** Additional functions to support the more "scheme-like" functions +;;** above + +;; copy-region! mutates to-region so that it is identical to +;; from-region. In fact this function uses XUnionRegion to create an +;; identical region. See "region.c". + +(define (copy-region! from-region to-region) + (%copy-region (region-Xregion from-region) + (region-Xregion to-region))) + +(import-lambda-definition %copy-region (Xfrom Xto) + "scx_Copy_Region") + +;; duplicate-region returns a new region that is identical to the +;; specified one. + +(define (duplicate-region region) + (let ((r (create-region))) + (copy-region! region r) + r)) + +;; offset-region returns a new region that is identical to the +;; specified one except that it is moved by dx and dy. See +;; offset-region!. + +(define (offset-region region dx dy) + (let ((r (duplicate-region region))) + (offset-region! r dx dy) + r)) + +;; shrink-region returns a new region that is identical to the +;; specified one except that it is shrunk by dx and dy. See +;; shrink-region!. + +(define (shrink-region region dx dy) + (let ((r (duplicate-region region))) + (shrink-region! r dx dy) + r))