+ 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.
This commit is contained in:
frese
parent
f388edb0f1
commit
41efc382c7
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
@ -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:
|
||||
;; <text> ::= <text-spec> | ( <text-spec>+ )
|
||||
;; <text-spec> ::= <integer> | <char> | <string> | <symbol> | <font>
|
||||
;; | (null . <delta>) | (<font> . <delta>)
|
||||
;; <delta> ::= <integer>
|
||||
;; 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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue