scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- graphic functions now all use lists and pairs as rectangle/point 

arguments.
- addded some auxiliary functions for rectangles.
This commit is contained in:
frese 2002-03-17 15:49:02 +00:00
parent 351ba3e23e
commit 26c416d441
2 changed files with 70 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
c/xlib/graphics.c
View File

@ -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);

85
scheme/xlib/graphics.scm
View File

@ -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))