added/changed functions for regions.
This commit is contained in:
frese
parent
6a7e9007d7
commit
9e23478bfd
|
|
@ -38,7 +38,8 @@ OBJECTS = \
|
|||
c/xlib/pixmap.o \
|
||||
c/xlib/init.o \
|
||||
c/xlib/client.o \
|
||||
c/xlib/util.o
|
||||
c/xlib/util.o \
|
||||
c/xlib/region.o
|
||||
# c/libs/xpm.o
|
||||
|
||||
SCM_FILES = scheme/xlib/display.scm \
|
||||
|
|
@ -60,7 +61,8 @@ SCM_FILES = scheme/xlib/display.scm \
|
|||
scheme/xlib/visual.scm \
|
||||
scheme/xlib/client.scm \
|
||||
scheme/xlib/utility.scm \
|
||||
scheme/xlib/atom.scm
|
||||
scheme/xlib/atom.scm \
|
||||
scheme/xlib/region.scm
|
||||
# scheme/libs/xpm.scm
|
||||
|
||||
SCM_CONFIG_FILES = scheme/xlib/xlib-interfaces.scm \
|
||||
|
|
|
|||
|
|
@ -70,6 +70,7 @@ void scx_init_xlib(void) {
|
|||
scx_init_client();
|
||||
scx_init_util();
|
||||
scx_init_event_types();
|
||||
scx_init_region();
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
224
c/xlib/region.c
224
c/xlib/region.c
|
|
@ -1,158 +1,163 @@
|
|||
#include "xlib.h"
|
||||
|
||||
s48_value scx_Destroy_Region(s48_value Xregion) {
|
||||
XDestroyRegion(SCX_EXTRACT_REGION(Xregion));
|
||||
#define scx_extract_region(x) (Region)s48_extract_pointer(x)
|
||||
#define scx_enter_region(r) s48_enter_pointer(r)
|
||||
|
||||
/*** create or destroy regions *************************************/
|
||||
|
||||
s48_value scx_Create_Region() {
|
||||
return scx_enter_region(XCreateRegion());
|
||||
}
|
||||
|
||||
s48_value scx_Set_Region(s48_value display, s48_value gc, s48_value r) {
|
||||
XSetRegion(scx_extract_display(display), scx_extract_gc(gc),
|
||||
scx_extract_region(r));
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
s48_value scx_Create_Region () {
|
||||
return SCX_ENTER_REGION(XCreateRegion());
|
||||
s48_value scx_Destroy_Region(s48_value r) {
|
||||
XDestroyRegion(scx_extract_region(r));
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
|
||||
s48_value scx_Clip_Box(s48_value Xregion) {
|
||||
XRectangle r;
|
||||
s48_value v = s48_make_vector(4, S48_FALSE);
|
||||
S48_DECLARE_GC_PROTECT(1);
|
||||
/*** determine if regions are empty or equal ***********************/
|
||||
|
||||
XClipBox(SCX_EXTRACT_REGION(Xregion), &r);
|
||||
|
||||
S48_GC_PROTECT_1(v);
|
||||
S48_VECTOR_SET(v, 0, s48_enter_fixnum(r.x));
|
||||
S48_VECTOR_SET(v, 1, s48_enter_fixnum(r.y));
|
||||
S48_VECTOR_SET(v, 2, s48_enter_fixnum(r.width));
|
||||
S48_VECTOR_SET(v, 3, s48_enter_fixnum(r.height));
|
||||
|
||||
S48_GC_UNPROTECT();
|
||||
return v;
|
||||
s48_value scx_Empty_Region(s48_value r) {
|
||||
return S48_ENTER_BOOLEAN(XEmptyRegion(scx_extract_region(r)));
|
||||
}
|
||||
|
||||
s48_value scx_Region_Empty(s48_value Xregion) {
|
||||
return XEmptyRegion(SCX_EXTRACT_REGION(Xregion)) ? S48_TRUE : S48_FALSE;
|
||||
s48_value scx_Equal_Region(s48_value r1, s48_value r2) {
|
||||
S48_DECLARE_GC_PROTECT_2(r1, r2);
|
||||
Bool res = XEqualRegion(scx_extract_region(r1),
|
||||
scx_extract_region(r2));
|
||||
S48_GC_RETURN(S48_ENTER_BOOLEAN(res));
|
||||
}
|
||||
|
||||
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 r, s48_value x, s48_value y) {
|
||||
S48_DECLARE_GC_PROTECT_3(r, x, y);
|
||||
Bool res = XPointInRegion(scx_extract_region(r),
|
||||
s48_extract_integer(x),
|
||||
s48_extract_integer(y));
|
||||
S48_GC_RETURN(S48_ENTER_BOOLEAN(res));
|
||||
}
|
||||
|
||||
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;
|
||||
}
|
||||
extern s48_value scx_rect_in_region_type_binding;
|
||||
extern s48_value scx_rect_in_region_types_binding;
|
||||
#define scx_extract_rect_in_region_type(x) \
|
||||
S48_EXTRACT_ENUM(x, scx_rect_in_region_type_binding)
|
||||
#define scx_enter_rect_in_region_type(x) \
|
||||
S48_ENTER_ENUM(x, scx_rect_in_region_types_binding)
|
||||
|
||||
s48_value scx_Rect_In_Region(s48_value Xregion, s48_value x, s48_value y,
|
||||
s48_value scx_Rect_In_Region(s48_value r, 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_fixnum(res);
|
||||
int res;
|
||||
S48_DECLARE_GC_PROTECT_5(r, x, y, w, h);
|
||||
res = XRectInRegion(scx_extract_region(r),
|
||||
s48_extract_integer(x),
|
||||
s48_extract_integer(y),
|
||||
s48_extract_integer(w),
|
||||
s48_extract_integer(h));
|
||||
S48_GC_RETURN(scx_enter_rect_in_region_type(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);
|
||||
/*** region arithmetic *********************************************/
|
||||
|
||||
s48_value scx_Intersect_Region(s48_value sra, s48_value srb, s48_value dr) {
|
||||
S48_DECLARE_GC_PROTECT_3(sra, srb, dr);
|
||||
XIntersectRegion(scx_extract_region(sra), scx_extract_region(srb),
|
||||
scx_extract_region(dr));
|
||||
S48_GC_RETURN(S48_UNSPECIFIC);
|
||||
}
|
||||
|
||||
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_Region(s48_value sra, s48_value srb, s48_value dr) {
|
||||
S48_DECLARE_GC_PROTECT_3(sra, srb, dr);
|
||||
XUnionRegion(scx_extract_region(sra), scx_extract_region(srb),
|
||||
scx_extract_region(dr));
|
||||
S48_GC_RETURN(S48_UNSPECIFIC);
|
||||
}
|
||||
|
||||
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);
|
||||
s48_value scx_Union_Rect_With_Region(s48_value x, s48_value y, s48_value w,
|
||||
s48_value h, s48_value src,
|
||||
s48_value dest) {
|
||||
XRectangle r;
|
||||
S48_DECLARE_GC_PROTECT_6(x, y, w, h, src, dest);
|
||||
r.x = s48_extract_integer(x);
|
||||
r.y = s48_extract_integer(y);
|
||||
r.width = s48_extract_integer(w);
|
||||
r.height = s48_extract_integer(h);
|
||||
|
||||
XUnionRectWithRegion(&rect, SCX_EXTRACT_REGION(r), res);
|
||||
return SCX_ENTER_REGION(res);
|
||||
XUnionRectWithRegion(&r, scx_extract_region(src), scx_extract_region(dest));
|
||||
S48_GC_RETURN(S48_UNSPECIFIC);
|
||||
}
|
||||
|
||||
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_Subtract_Region(s48_value sra, s48_value srb, s48_value dr) {
|
||||
S48_DECLARE_GC_PROTECT_3(sra, srb, dr);
|
||||
XSubtractRegion(scx_extract_region(sra), scx_extract_region(srb),
|
||||
scx_extract_region(dr));
|
||||
S48_GC_RETURN(S48_UNSPECIFIC);
|
||||
}
|
||||
|
||||
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_Xor_Region(s48_value sra, s48_value srb, s48_value dr) {
|
||||
S48_DECLARE_GC_PROTECT_3(sra, srb, dr);
|
||||
XXorRegion(scx_extract_region(sra), scx_extract_region(srb),
|
||||
scx_extract_region(dr));
|
||||
S48_GC_RETURN(S48_UNSPECIFIC);
|
||||
}
|
||||
|
||||
s48_value scx_Offset_Region(s48_value Xregion, s48_value dx, s48_value dy) {
|
||||
XOffsetRegion(SCX_EXTRACT_REGION(Xregion),
|
||||
s48_extract_integer(dx),
|
||||
s48_value scx_Offset_Region(s48_value r, s48_value dx, s48_value dy) {
|
||||
S48_DECLARE_GC_PROTECT_3(r, dx, dy);
|
||||
XOffsetRegion(scx_extract_region(r), s48_extract_integer(dx),
|
||||
s48_extract_integer(dy));
|
||||
return S48_UNSPECIFIC;
|
||||
S48_GC_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_value scx_Shrink_Region(s48_value r, s48_value dx, s48_value dy) {
|
||||
S48_DECLARE_GC_PROTECT_3(r, dx, dy);
|
||||
XShrinkRegion(scx_extract_region(r), s48_extract_integer(dx),
|
||||
s48_extract_integer(dy));
|
||||
return S48_UNSPECIFIC;
|
||||
S48_GC_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);
|
||||
/*** generate regions **********************************************/
|
||||
|
||||
return S48_UNSPECIFIC;
|
||||
}
|
||||
extern s48_value scx_fill_rule_binding; /* from gcontext.c */
|
||||
#define scx_extract_fill_rule(x) S48_EXTRACT_ENUM(x, scx_fill_rule_binding)
|
||||
|
||||
s48_value scx_Polygon_Region(s48_value points, s48_value fillrule) {
|
||||
int n = S48_VECTOR_LENGTH(points);
|
||||
s48_value scx_Polygon_Region(s48_value points, s48_value fill_rule) {
|
||||
int i, n = s48_list_length(points);
|
||||
Region r;
|
||||
XPoint ps[n];
|
||||
int fill_rule = s48_extract_integer(fillrule);
|
||||
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);
|
||||
S48_DECLARE_GC_PROTECT_2(points, fill_rule);
|
||||
for (i = 0; i < n; i++) {
|
||||
ps[i].x = s48_extract_integer(S48_CAR(S48_CAR(points)));
|
||||
ps[i].y = s48_extract_integer(S48_CDR(S48_CAR(points)));
|
||||
points = S48_CDR(points);
|
||||
}
|
||||
res = XPolygonRegion(ps, n, fill_rule);
|
||||
|
||||
return SCX_ENTER_REGION(res);
|
||||
r = XPolygonRegion(ps, n, scx_extract_fill_rule(fill_rule));
|
||||
S48_RETURN(scx_enter_region(r));
|
||||
}
|
||||
|
||||
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;
|
||||
|
||||
s48_value scx_Clip_Box(s48_value r) {
|
||||
XRectangle rect;
|
||||
s48_value l = S48_NULL;
|
||||
S48_DECLARE_GC_PROTECT_2(r, l);
|
||||
XClipBox(scx_extract_region(r), &rect);
|
||||
l = s48_cons(s48_enter_integer(rect.height), l);
|
||||
l = s48_cons(s48_enter_integer(rect.width), l);
|
||||
l = s48_cons(s48_enter_integer(rect.y), l);
|
||||
l = s48_cons(s48_enter_integer(rect.x), l);
|
||||
S48_GC_RETURN(l);
|
||||
}
|
||||
|
||||
void scx_init_region(void) {
|
||||
SCX_PRO_IMP(scx_rect_in_region_type_binding, "scx-rect-in-region-type");
|
||||
SCX_PRO_IMP(scx_rect_in_region_types_binding, "scx-rect-in-region-types");
|
||||
|
||||
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_Empty_Region);
|
||||
S48_EXPORT_FUNCTION(scx_Equal_Region);
|
||||
S48_EXPORT_FUNCTION(scx_Point_In_Region);
|
||||
S48_EXPORT_FUNCTION(scx_Rect_In_Region);
|
||||
S48_EXPORT_FUNCTION(scx_Intersect_Region);
|
||||
|
|
@ -164,6 +169,5 @@ void scx_init_region(void) {
|
|||
S48_EXPORT_FUNCTION(scx_Shrink_Region);
|
||||
S48_EXPORT_FUNCTION(scx_Polygon_Region);
|
||||
S48_EXPORT_FUNCTION(scx_Set_Region);
|
||||
S48_EXPORT_FUNCTION(scx_Copy_Region);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,42 +0,0 @@
|
|||
(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))
|
||||
|
|
@ -1,206 +1,89 @@
|
|||
;; create-region creates a new empty region. See XCreateRegion.
|
||||
;; *** create or destroy regions *************************************
|
||||
|
||||
(define (create-region)
|
||||
(make-region (%create-region) #t))
|
||||
(import-lambda-definition create-region () "scx_Create_Region")
|
||||
|
||||
(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 (%rectangle-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->integer 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)
|
||||
(import-xlib-function set-region (display gc r)
|
||||
"scx_Set_Region")
|
||||
|
||||
;;** Additional functions to support the more "scheme-like" functions
|
||||
;;** above
|
||||
(import-lambda-definition destroy-region (r) "scx_Destroy_Region")
|
||||
|
||||
;; 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".
|
||||
;; *** determine if regions are empty or equal ***********************
|
||||
|
||||
(define (copy-region! from-region to-region)
|
||||
(%copy-region (region-Xregion from-region)
|
||||
(region-Xregion to-region)))
|
||||
(import-lambda-definition empty-region? (r) "scx_Empty_Region")
|
||||
|
||||
(import-lambda-definition %copy-region (Xfrom Xto)
|
||||
"scx_Copy_Region")
|
||||
(import-lambda-definition equal-region? (r1 r2) "scx_Equal_Region")
|
||||
|
||||
;; duplicate-region returns a new region that is identical to the
|
||||
;; specified one.
|
||||
(import-lambda-definition point-in-region? (r x y) "scx_Point_In_Region")
|
||||
|
||||
(define (duplicate-region region)
|
||||
(let ((r (create-region)))
|
||||
(copy-region! region r)
|
||||
r))
|
||||
(define-enumerated-type rect-in-region-type :rect-in-region-type
|
||||
rect-in-region-type? rect-in-region-types rect-in-region-type-name
|
||||
rect-in-region-type-index
|
||||
(rectangle-in rectangle-out rectangle-part))
|
||||
|
||||
;; 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-exported-binding "scx-rect-in-region-type" :rect-in-region-type)
|
||||
(define-exported-binding "scx-rect-in-region-types" rect-in-region-types)
|
||||
|
||||
(define (offset-region region dx dy)
|
||||
(let ((r (duplicate-region region)))
|
||||
(offset-region! r dx dy)
|
||||
r))
|
||||
(import-lambda-definition rect-in-region? (r x y w h) "scx_Rect_In_Region")
|
||||
|
||||
;; 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!.
|
||||
;; *** region arithmetic *********************************************
|
||||
|
||||
(define (shrink-region region dx dy)
|
||||
(let ((r (duplicate-region region)))
|
||||
(shrink-region! r dx dy)
|
||||
r))
|
||||
;; intersect-region! computes the intersection of SRA and SRB and
|
||||
;; stores the result in the region DR.
|
||||
|
||||
(import-lambda-definition intersect-region! (sra srb dr)
|
||||
"scx_Intersect_Region")
|
||||
|
||||
(define (intersect-region sra srb)
|
||||
(let ((dr (create-region)))
|
||||
(intersect-region! sra srb dr)
|
||||
dr))
|
||||
|
||||
(import-lambda-definition union-region! (sra srb dr)
|
||||
"scx_Union_Region")
|
||||
|
||||
(define (union-region sra srb)
|
||||
(let ((dr (create-region)))
|
||||
(union-region! sra srb dr)
|
||||
dr))
|
||||
|
||||
(import-lambda-definition union-rect-with-region! (x y w h src dest)
|
||||
"scx_Union_Rect_With_Region")
|
||||
|
||||
(define (union-rect-with-region x y w h src)
|
||||
(let ((dr (create-region)))
|
||||
(union-rect-with-region! x y w h src dr)
|
||||
dr))
|
||||
|
||||
(import-lambda-definition subtract-region! (sra srb dr)
|
||||
"scx_Subtract_Region")
|
||||
|
||||
(define (subtract-region sra srb)
|
||||
(let ((dr (create-region)))
|
||||
(subtract-region! sra srb dr)
|
||||
dr))
|
||||
|
||||
(import-lambda-definition xor-region! (sra srb dr)
|
||||
"scx_Xor_Region")
|
||||
|
||||
(define (xor-region sra srb)
|
||||
(let ((dr (create-region)))
|
||||
(xor-region! sra srb dr)
|
||||
dr))
|
||||
|
||||
(import-lambda-definition offset-region! (r dx dy)
|
||||
"scx_Offset_Region")
|
||||
|
||||
(import-lambda-definition shrink-region! (r dx dy)
|
||||
"scx_Shrink_Region")
|
||||
|
||||
;; *** generate regions **********************************************
|
||||
|
||||
;; points has to be a list of pairs (x . y).
|
||||
|
||||
(import-lambda-definition polygon-region (points fill-rule)
|
||||
"scx_Polygon_Region")
|
||||
|
||||
;; clip-box returns a list (x y width height)
|
||||
|
||||
(import-lambda-definition clip-box (r)
|
||||
"scx_Clip_Box")
|
||||
|
|
|
|||
|
|
@ -796,6 +796,16 @@
|
|||
parse-geometry
|
||||
store-buffer store-bytes fetch-buffer fetch-bytes rotate-buffers
|
||||
|
||||
;; region.scm *****************************************************
|
||||
create-region set-region destroy-region
|
||||
empty-region? equal-region? point-in-region?
|
||||
((rectangle-in rectangle-out rectangle-part) :enumeration)
|
||||
rect-in-region? intersect-region! intersect-region
|
||||
union-region! union-region union-rect-with-region! union-rect-with-region
|
||||
subtract-region! subtract-region xor-region! xor-region
|
||||
offset-region! shrink-region
|
||||
polygon-region clip-box
|
||||
|
||||
;; atom.scm *******************************************************
|
||||
((XA_PRIMARY XA_SECONDARY XA_ARC XA_ATOM XA_BITMAP XA_CARDINAL
|
||||
XA_COLORMAP XA_CURSOR XA_CUT_BUFFER0 XA_CUT_BUFFER1 XA_CUT_BUFFER2
|
||||
|
|
|
|||
|
|
@ -51,4 +51,5 @@
|
|||
wm
|
||||
client
|
||||
utility
|
||||
atom))
|
||||
atom
|
||||
region))
|
||||
|
|
|
|||
Loading…
Reference in New Issue