207 lines
6.1 KiB
Scheme
207 lines
6.1 KiB
Scheme
|
;; 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))
|