From 41efc382c7827d5d72aaaefbb2a01a0f11d44afb Mon Sep 17 00:00:00 2001 From: frese Date: Thu, 4 Oct 2001 12:31:44 +0000 Subject: [PATCH] + graphic: changed representations of rectangles to lists (x y width height), and points to pairs (x . y). Added some auxiliary functions for that. + text: made the format arguments optional, and default to '1-byte. + added comments. --- c/xlib/graphics.c | 47 ++++++------- scheme/xlib/graphics.scm | 142 ++++++++++++++++++++++++++------------- scheme/xlib/text.scm | 120 +++++++++++++++++---------------- 3 files changed, 184 insertions(+), 125 deletions(-) diff --git a/c/xlib/graphics.c b/c/xlib/graphics.c index a03e4dc..8a1dce1 100644 --- a/c/xlib/graphics.c +++ b/c/xlib/graphics.c @@ -136,10 +136,10 @@ s48_value scx_Draw_Segments (s48_value Xdisplay, s48_value Xdrawable, XSegment p[n]; for (i = 0; i < n; i++) { s48_value seg = S48_VECTOR_REF(vec, i); - p[i].x1 = (int)s48_extract_integer (S48_CAR (seg)); seg = S48_CDR (seg); - p[i].y1 = (int)s48_extract_integer (S48_CAR (seg)); seg = S48_CDR (seg); - p[i].x2 = (int)s48_extract_integer (S48_CAR (seg)); seg = S48_CDR (seg); - p[i].y2 = (int)s48_extract_integer (S48_CAR (seg)); + p[i].x1 = (int)s48_extract_integer (S48_VECTOR_REF(seg, 0)); + p[i].y1 = (int)s48_extract_integer (S48_VECTOR_REF(seg, 1)); + p[i].x2 = (int)s48_extract_integer (S48_VECTOR_REF(seg, 2)); + p[i].y2 = (int)s48_extract_integer (S48_VECTOR_REF(seg, 3)); } XDrawSegments (SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_DRAWABLE(Xdrawable), SCX_EXTRACT_GCONTEXT(Xgcontext), p, n); @@ -149,47 +149,48 @@ s48_value scx_Draw_Segments (s48_value Xdisplay, s48_value Xdrawable, s48_value scx_Draw_Rectangle(s48_value Xdisplay, s48_value Xdrawable, - s48_value Xgcontext, s48_value x, s48_value y, - s48_value w, s48_value h){ + s48_value Xgcontext, s48_value rect) { + XDrawRectangle (SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_DRAWABLE(Xdrawable), - SCX_EXTRACT_GCONTEXT(Xgcontext), (int)s48_extract_integer(x), - (int)s48_extract_integer(y), (int)s48_extract_integer(w), - (int)s48_extract_integer(h)); + SCX_EXTRACT_GCONTEXT(Xgcontext), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 0)), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 1)), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 2)), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 3))); return S48_UNSPECIFIC; } s48_value scx_Fill_Rectangle (s48_value Xdisplay, s48_value Xdrawable, - s48_value Xgcontext, s48_value x, s48_value y, - s48_value w, s48_value h){ + s48_value Xgcontext, s48_value rect) { XFillRectangle(SCX_EXTRACT_DISPLAY(Xdisplay), SCX_EXTRACT_DRAWABLE(Xdrawable), - SCX_EXTRACT_GCONTEXT(Xgcontext), (int)s48_extract_integer(x), - (int)s48_extract_integer(y), (int)s48_extract_integer(w), - (int)s48_extract_integer(h)); - + SCX_EXTRACT_GCONTEXT(Xgcontext), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 0)), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 1)), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 2)), + (int)s48_extract_integer(S48_VECTOR_REF(rect, 3))); + return S48_UNSPECIFIC; } //This Function is for internal use only! -void Vector_To_XRectangle(s48_value vec, XRectangle* p, int n){ +void Vector_To_XRectangle(s48_value vec, XRectangle* p, int n) { int i; for (i = 0; i < n; i++){ s48_value rect; rect = S48_VECTOR_REF(vec, i); - 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)); + p[i].x = (int)s48_extract_integer(S48_VECTOR_REF(rect, 0)); + p[i].y = (int)s48_extract_integer(S48_VECTOR_REF(rect, 1)); + p[i].width = (int)s48_extract_integer(S48_VECTOR_REF(rect, 2)); + p[i].height = (int)s48_extract_integer(S48_VECTOR_REF(rect, 3)); } } - s48_value scx_Draw_Rectangles (s48_value Xdisplay, s48_value Xdrawable, - s48_value Xgcontext, s48_value vec){ + s48_value Xgcontext, s48_value vec){ int n = S48_VECTOR_LENGTH(vec); XRectangle p[n]; Vector_To_XRectangle(vec, p, n); diff --git a/scheme/xlib/graphics.scm b/scheme/xlib/graphics.scm index 65d2344..3b564dd 100644 --- a/scheme/xlib/graphics.scm +++ b/scheme/xlib/graphics.scm @@ -2,19 +2,22 @@ ;; creation date : 18/06/2001 ;; last change : 04/07/2001 +;; 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. (define (clear-area window x y width height exposures?) (%clear-area (window-Xwindow window) (display-Xdisplay (window-display window)) x y width height exposures?)) - (import-lambda-definition %clear-area (Xwindow Xdisplay x y width height exposures?) "scx_Clear_Area") - -;; _____ +;; 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) @@ -28,9 +31,10 @@ (import-lambda-definition %copy-area (Xdisplay srcXdrawable Xgcontext srcx srcy width height destXdrawable destx desty) "scx_Copy_Area") - -;; _____ +;; copy-plane uses a single bit plane of the specified source +;; 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) @@ -42,26 +46,27 @@ (drawable-Xobject dst-drawable) dst-x dst-y)) - (import-lambda-definition %copy-plane (Xdisplay srcXdrawable Xgcontext plane srcx srcy width height destXdrawable destx desty) "scx_Copy_Plane") -;; _____ +;; draw-point uses the foreground pixel and function components of the +;; 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) - x y)) + (car x-y) (cdr x-y))) (import-lambda-definition %draw-point (Xdisplay Xdrawable Xgcontext x y) "scx_Draw_Point") - -;; _____ +;; draw-points draws multiple points the same way as draw-point +;; does. The points have to be specified as a list of pairs. See +;; XDrawPoints. (define (draw-points drawable gcontext points relative?) (%draw-point (display-Xdisplay (drawable-display drawable)) @@ -74,21 +79,26 @@ relative) "scx_Draw_Points") +;; draw-line uses the components of the specified GC to draw a line +;; between the specified set of points (x1 . y1) and (x2 . y2). See +;; XDrawLine. -;; _____ - -(define (draw-line drawable gcontext x1 y1 x2 y2) +(define (draw-line drawable gcontext x-y-1 x-y-2) (%draw-line (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - x1 y1 x2 y2)) + (car x-y-1) (cdr x-y-1) + (car x-y-2) (cdr x-y-2))) (import-lambda-definition %draw-line (Xdisplay Xdrawable Xgcontext x1 y1 x2 y2) "scx_Draw_Line") - -;; _____ - +;; draw-lines uses the components of the specified GC to draw lines +;; between each pair of points (xi . yi) (xi+1 . yi+1) in the list +;; points. It draws the lines in the order given in the list. The +;; lines join correctly at all intermediate points, and if the first +;; and last points coincide, the first and last lines also join +;; correctly. See XDrawLines. (define (draw-lines drawable gcontext points relative?) (%draw-lines (display-Xdisplay (drawable-display drawable)) @@ -100,63 +110,76 @@ (import-lambda-definition %draw-lines (Xdisplay Xdrawable Xgcontext vec rel) "scx_Draw_Lines") -;; _____ - -;; Note: points is a list which contains lists with 4 -;; integers in Form: (x1, y1, x2, y2) +;; draw-segments function draws multiple, unconnected lines. The +;; points have to be specified as list of lists of 4 integers (x1 y1 +;; x2 y2). Use points->segments to convert a list of points into a +;; list of segments. See XDraw Segements. (define (draw-segments drawable gcontext points) (%draw-segments (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - (list->vector points))) + (list->vector (map list->vector points)))) (import-lambda-definition %draw-segments (Xdisplay Xdrawable Xgcontext vec) "scx_Draw_Segments") +;; draw-rectangle and draw-rectangles draw the outlines of the +;; specified rectangle or rectangles as if a five-point PolyLine +;; protocol request were specified for each rectangle. The rectangles +;; have to be specified as a list (x y width height). See +;; XDrawRectangle(s). -(define (draw-rectangle drawable gcontext x y width height) +(define (draw-rectangle drawable gcontext rect) (%draw-rectangle (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - x y width height)) + (list->vector rect))) -(import-lambda-definition %draw-rectangle (Xdisplay Xdrawable Xgcontext x y - w h) +(import-lambda-definition %draw-rectangle (Xdisplay Xdrawable Xgcontext rect) "scx_Draw_Rectangle") -(define (fill-rectangle drawable gcontext x y width height) - (%fill-rectangle (display-Xdisplay (drawable-display drawable)) - (drawable-Xobject drawable) - (gcontext-Xgcontext gcontext) - x y width height)) - -(import-lambda-definition %fill-rectangle (Xdisplay Xdrawable Xgcontext x y - w h) - "scx_Fill_Rectangle") - - (define (draw-rectangles drawable gcontext rectangles) (%draw-rectangles (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - (list->vector rectangles))) + (list->vector (map list->vector rectangles)))) -(import-lambda-definition %draw-rectangles (Xdisplay Xdrawable Xgcontext - vec) +(import-lambda-definition %draw-rectangles (Xdisplay Xdrawable Xgcontext vec) "scx_Draw_Rectangles") +;; fill-rectangle and fill-rectangles fill the rectangle(s) outlined +;; with draw-rectangle(s). See XFillRectangle(s). + +(define (fill-rectangle drawable gcontext rect) + (%fill-rectangle (display-Xdisplay (drawable-display drawable)) + (drawable-Xobject drawable) + (gcontext-Xgcontext gcontext) + (list->vector rect))) + +(import-lambda-definition %fill-rectangle (Xdisplay Xdrawable Xgcontext rect) + "scx_Fill_Rectangle") (define (fill-rectangles drawable gcontext rectangles) (%fill-rectangles (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext) - (list->vector rectangles))) + (list->vector (map list->vector rectangles)))) -(import-lambda-definition %fill-rectangles (Xdisplay Xdrawable Xgcontext - vec) +(import-lambda-definition %fill-rectangles (Xdisplay Xdrawable Xgcontext vec) "scx_Fill_Rectangles") +;; draw-arc(s) and fill-arc(s) draws a single/multiple circular or +;; elliptical arc(s). Each arc is specified by a rectangle and two +;; angles. The center of the circle or ellipse is the center of the +;; rectangle, and the major and minor axes are specified by the width +;; and height. Positive angles indicate counterclockwise motion, and +;; negative angles indicate clockwise motion. +;; angle1 specifies the start of the arc relative to the three-o'clock +;; position from the center, in units of degrees * 64. angle2 +;; specifies the path and extent of the arc relative to the start of +;; 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) (%draw-arc (display-Xdisplay (drawable-display drawable)) @@ -197,6 +220,10 @@ (import-lambda-definition %fill-arcs (Xdisplay Xdrawable Xgcontext vec) "scx_Fill_Arcs") +;; fill-polygon fills the region closed by the specified path. The +;; path is closed automatically if the last point in the list does not +;; coincide with the first point. See XFillPolygon. + (define (fill-polygon drawable gcontext points relative? shape) (%fill-polygon (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) @@ -206,3 +233,28 @@ (import-lambda-definition %fill-polygon (Xdisplay Xdrawable Xgcontext vec relative shape) "scx_Fill_Polygon") + +;; Now some auxiliary functions: + +(define rectangle list) + +(define (bounds x1 y1 x2 y2) + (rectangle x1 y2 (- x2 x1) (- y2 y1))) + +;; converts '((x1 . y1) (x2 . y2) (x3 . y3) (x4 . y4)) -> '((x1 y1 x2 +;; y2) (x3 y3 x4 y4)) + +(define (points->segments points) + (cdr (fold-right (lambda (this rest) + (if (null? (car rest)) + (cons (list (car this) + (cdr this)) + (cdr rest)) + (cons '() + (cons (cons (car this) + (cons (cdr this) + (car rest))) + (cdr rest))))) + '(()) + points))) + \ No newline at end of file diff --git a/scheme/xlib/text.scm b/scheme/xlib/text.scm index c333944..248de59 100644 --- a/scheme/xlib/text.scm +++ b/scheme/xlib/text.scm @@ -83,82 +83,88 @@ (list->vector t))) -; --- text-width returns the widht of the given 1- or 2-byte char-string, -; represented by a vector of integers. +;; text-width returns the widht of the given 1-byte or 2-byte string, +;; represented by an integer, character, string or symbol, or event a +;; list of those types. the optional argument format is one of '1-byte +;; or '2-byte, which defaults to '1-byte. See XTextWidth. -(define (text-width font text format) - (%text-width (font-Xfontstruct font) - (text->internal-text text format) - (get-format-id format))) +(define (text-width font text . format) + (let ((format (if (null? format) '1-byte (car format)))) + (%text-width (font-Xfontstruct font) + (text->internal-text text format) + (get-format-id format)))) (import-lambda-definition %text-width (Xfontstruct text format) "scx_Text_Width") -; --- Each extents-...-functions returns a number. +; --- Each extents-...-function returns a number. -(define (extents-lbearing font text format) - (extents-intern font text format 0)) +(define (extents-intern id) + (lambda (font text . format) + (let ((format (if (null? format) '1-byte (car format)))) + (%extents (font-Xfontstruct font) + (text->internal-text text format) + (get-format-id format) + id)))) - -(define (extents-rbearing font text format) - (extents-intern font text format 1)) - - -(define (extents-width font text format) - (extents-intern font text format 2)) - - -(define (extents-ascent font text format) - (extents-intern font text format 3)) - - -(define (extents-descent font text format) - (extents-intern font text format 4)) - - -(define (extents-intern font text format which?) - (%extents (font-Xfontstruct font) - (text->internal-text text format) - (get-format-id format) - which?)) +(define extents-lbearing (extents-intern 0)) +(define extents-rbearing (extents-intern 1)) +(define extents-width (extents-intern 2)) +(define extents-ascent (extents-intern 3)) +(define extents-descent (extents-intern 4)) (import-lambda-definition %extents-text (Xfontstruct text format which) "scx_Extents_Text") -; --- draw-image-text draws the text. text is a integer, character, string -; or symbol, or event a list of these types. +;; draw-image-text draws a text on the gcontext at the specified +;; position. text is an integer, character, string or symbol, or even +;; a list of these types. format is '1-byte or '2-byte. '1-byte is the +;; default value. See XDrawImageString. -(define (draw-image-text drawable gcontext x y text format) - (%draw-image-text (display-Xdisplay (drawable-display drawable)) - (drawable-Xobject drawable) - (gcontext-Xgcontext gcontext) - x y - (text->internal-text text format) - (eq? format '2-byte))) +(define (draw-image-text drawable gcontext x y text . format) + (let ((format (if (null? format) '1-byte (car format)))) + (%draw-image-text (display-Xdisplay (drawable-display drawable)) + (drawable-Xobject drawable) + (gcontext-Xgcontext gcontext) + x y + (text->internal-text text format) + (eq? format '2-byte)))) (import-lambda-definition %draw-image-text (Xdisplay Xdrawable Xgcontext x y text format) "scx_Draw_Image_Text") -; --- text is a list of font-object and chars. +;; draw-poly-test is a more complex function for text drawing. text +;; has the following format: +;; ::= | ( + ) +;; ::= | | | | +;; | (null . ) | ( . ) +;; ::= +;; so for example a text argument of +;; (list font-1 "Hello" (cons font-2 5) "World") +;; should draw Hello in font-1 and World in font-2 with a +;; character-spacing of 5. +;; the optional format argument is one of '1-byte or '2-byte and +;; defaults to '1-byte. -(define (draw-poly-text drawable gcontext x y text format) - (let ((text-spec - (map (lambda (text-or-font) - (cond - ((font? text-or-font) - (cons (font-Xfont text-or-font) - 0)) - ((and (pair? text-or-font) - (not (list? text-or-font))) - (cons (if (font? (car text-or-font)) - (font-Xfont (car text-or-font)) - 'none) - (cdr text-or-font))) - (else (text->internal-text text-or-font - format)))) - (separate-fonts text)))) +(define (draw-poly-text drawable gcontext x y text . format) + (let* ((format (if (null? format) '1-byte (car format))) + (text-spec + (map (lambda (text-or-font) + (cond + ((font? text-or-font) + (cons (font-Xfont text-or-font) + 0)) + ((and (pair? text-or-font) + (not (list? text-or-font))) + (cons (if (font? (car text-or-font)) + (font-Xfont (car text-or-font)) + 'none) + (cdr text-or-font))) + (else (text->internal-text text-or-font + format)))) + (separate-fonts text)))) (%draw-poly-text (display-Xdisplay (drawable-display drawable)) (drawable-Xobject drawable) (gcontext-Xgcontext gcontext)