+ added support for regions.
This commit is contained in:
frese
parent
e7cce49d13
commit
5bd0685662
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
@ -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))
|
||||
|
|
@ -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))
|
||||
Loading…
Reference in New Issue