diff --git a/c/xlib/graphics.c b/c/xlib/graphics.c index 4a2c24c..da7623a 100644 --- a/c/xlib/graphics.c +++ b/c/xlib/graphics.c @@ -243,13 +243,14 @@ s48_value scx_Fill_Arc (s48_value Xdisplay, s48_value Xdrawable, void Vector_To_XArc(s48_value vec, XArc* p, int n){ int i; for (i = 0; i < n; i++){ - s48_value arc; - arc = S48_VECTOR_REF(vec, i); - p[i].x = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc); - p[i].y = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc); - p[i].width = (int)s48_extract_integer (S48_CAR (arc)); - arc = S48_CDR (arc); - p[i].height = (int)s48_extract_integer (S48_CAR (arc)); + s48_value arc = S48_VECTOR_REF(vec, i); + s48_value rect = S48_CAR(arc); + + p[i].x = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect); + p[i].y = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect); + p[i].width = (int)s48_extract_integer (S48_CAR (rect)); + rect = S48_CDR (rect); + p[i].height = (int)s48_extract_integer (S48_CAR (rect)); arc = S48_CDR (arc); p[i].angle1 = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc); diff --git a/scheme/xlib/graphics.scm b/scheme/xlib/graphics.scm index b402304..8005c85 100644 --- a/scheme/xlib/graphics.scm +++ b/scheme/xlib/graphics.scm @@ -5,12 +5,14 @@ ;; clear-area paints a rectangular area in the specified window ;; according to the specified dimensions with the window's background ;; pixel or pixmap. If width/height is zero it is replaced by the -;; window's width/height - 1. See XClearArea. +;; window's width/height - x/y. See XClearArea. -(define (clear-area window x y width height exposures?) +(define (clear-area window rect exposures?) (%clear-area (window-Xwindow window) (display-Xdisplay (window-display window)) - x y width height exposures?)) + (rect-x rect) (rect-y rect) + (rect-width rect) (rect-height rect) + exposures?)) (import-lambda-definition %clear-area (Xwindow Xdisplay x y width height exposures?) @@ -19,14 +21,14 @@ ;; copy-area combines the specified rectangle of src with the ;; specified rectangle of dest. See XCopyArea. -(define (copy-area src-drawable gcontext src-x src-y width height dst-drawable - dst-x dst-y) +(define (copy-area src-drawable gcontext src-x.y width height dst-drawable + dst-x.y) (%copy-area (display-Xdisplay (drawable-display src-drawable)) (drawable-Xobject src-drawable) (gcontext-Xgcontext gcontext) - src-x src-y width height + (car src-x.y) (cdr src-x.y) width height (drawable-Xobject dst-drawable) - dst-x dst-y)) + (car dst-x.y) (cdr dst-x.y))) (import-lambda-definition %copy-area (Xdisplay srcXdrawable Xgcontext srcx srcy width height destXdrawable destx desty) @@ -36,15 +38,15 @@ ;; rectangle combined with the specified GC to modify the specified ;; rectangle of dest. See XCopyPlane. -(define (copy-plane src-drawable gcontext plane src-x src-y width height - dst-drawable dst-x dst-y) +(define (copy-plane src-drawable gcontext plane src-x.y width height + dst-drawable dst-x.y) (%copy-plane (display-Xdisplay (drawable-display src-drawable)) (drawable-Xobject src-drawable) (gcontext-Xgcontext gcontext) plane - src-x src-y width height + (car src-x.y) (cdr src-x.y) width height (drawable-Xobject dst-drawable) - dst-x dst-y)) + (car dst-x.y) (cdr dst-x.y))) (import-lambda-definition %copy-plane (Xdisplay srcXdrawable Xgcontext plane srcx srcy width height destXdrawable @@ -55,11 +57,11 @@ ;; GC to draw a single point into the specified drawable. A point is ;; specified as a pair (x . y). See XDrawPoint. -(define (draw-point drawable gcontext x-y) +(define (draw-point drawable gcontext x.y) (%draw-point (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - (car x-y) (cdr x-y))) + (car x.y) (cdr x.y))) (import-lambda-definition %draw-point (Xdisplay Xdrawable Xgcontext x y) "scx_Draw_Point") @@ -181,41 +183,49 @@ ;; the arc, in units of degrees * 64. If the magnitude of angle2 is ;; greater than 360 degrees it is truncated to 360 degrees. -(define (draw-arc drawable gcontext x y width height angle1 angle2) +(define (draw-arc drawable gcontext rect angle1 angle2) (%draw-arc (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - x y width height angle1 angle2)) + (rect-x rect) (rect-y rect) + (rect-width rect) (rect-height rect) + angle1 angle2)) (import-lambda-definition %draw-arc (Xdisplay Xdrawable Xgcontext x y w h a1 a2) "scx_Draw_Arc") -(define (fill-arc drawable gcontext x y width height angle1 angle2) +(define (fill-arc drawable gcontext rect angle1 angle2) (%fill-arc (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - x y width height angle1 angle2)) + (rect-x rect) (rect-y rect) + (rect-width rect) (rect-height rect) + angle1 angle2)) (import-lambda-definition %fill-arc (Xdisplay Xdrawable Xgcontext x y w h a1 a2) "scx_Fill_Arc") -(define (draw-arcs drawable gcontext data) +;; draw-arcs/fill-arcs: the arcs argument has to be a list of arcs, +;; where an arc is a list (rect angle1 angle2) - and rect a list of (x +;; y width height). + +(define (draw-arcs drawable gcontext arcs) (%draw-arcs (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - (list->vector data))) + (list->vector arcs))) (import-lambda-definition %draw-arcs (Xdisplay Xdrawable Xgcontext vec) "scx_Draw_Arcs") -(define (fill-arcs drawable gcontext data) +(define (fill-arcs drawable gcontext arcs) (%fill-arcs (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - (list->vector data))) + (list->vector arcs))) (import-lambda-definition %fill-arcs (Xdisplay Xdrawable Xgcontext vec) "scx_Fill_Arcs") @@ -244,10 +254,39 @@ ;; Now some auxiliary functions: -(define rectangle list) +(define rect list) + +(define (rect? obj) + (and (list? obj) (= 4 (length obj)))) + +(define rect-x car) +(define rect-y cadr) +(define rect-width caddr) +(define rect-height cadddr) + +(define (set-rect-x! r x) (set-car! r x)) +(define (set-rect-y! r y) (set-car! (cdr r) y)) +(define (set-rect-width! r width) (set-car! (cddr r) width)) +(define (set-rect-height! r height) (set-car! (cdddr r) height)) (define (bounds x1 y1 x2 y2) - (rectangle x1 y2 (- x2 x1) (- y2 y1))) + (rect x1 y1 (- x2 x1) (- y2 y1))) + +(define (grow-rect r dw dh . maybe-centric?) + (if (or (null? maybe-centric?) (not (car maybe-centric?))) + (rect (rect-x r) (rect-y r) + (+ (rect-width r) dw) + (+ (rect-height r) dh)) + (rect (- (rect-x r) (quotient dw 2)) + (- (rect-y r) (quotient dh 2)) + (+ (rect-width r) dw) + (+ (rect-height r) dh)))) + +(define (move/resize-rect r dx dy dw dh) + (rect (+ (rect-x r) dx) + (+ (rect-y r) dy) + (+ (rect-width r) dw) + (+ (rect-height r) dh))) ;; converts '((x1 . y1) (x2 . y2) (x3 . y3) (x4 . y4)) -> '((x1 y1 x2 ;; y2) (x3 y3 x4 y4))