scx/c/xlib/graphics.c

#include "xlib.h"

extern XDrawPoints(), XDrawLines(), XDrawRectangle(), XFillRectangle();
extern XDrawRectangles(), XFillRectangles(), XDrawArc(), XFillArc();
extern XDrawArcs(), XFillArcs(), XFillPolygon();

static s48_value P_Clear_Area (win, x, y, w, h, e) s48_value win, x, y, w, h, e; {
    Check_Type (win, T_Window);
    Check_Type (e, T_Boolean);
    XClearArea (WINDOW(win)->dpy, WINDOW(win)->win, (int)s48_extract_integer (x),
	(int)s48_extract_integer (y), (int)s48_extract_integer (w), (int)s48_extract_integer (h), S48_EQ_P(e, S48_TRUE));
    return Void;
}

static s48_value P_Copy_Area (src, gc, sx, sy, w, h, dst, dx, dy) s48_value src, gc,
	sx, sy, w, h, dst, dx, dy; {
    Display *dpy;
    Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);

    Check_Type (gc, T_Gc);
    XCopyArea (dpy, dsrc, ddst, GCONTEXT(gc)->gc, (int)s48_extract_integer (sx),
	(int)s48_extract_integer (sy), (int)s48_extract_integer (w), (int)s48_extract_integer (h),
	(int)s48_extract_integer (dx), (int)s48_extract_integer (dy));
    return Void;
}

static s48_value P_Copy_Plane (src, gc, plane, sx, sy, w, h, dst, dx, dy)
	s48_value src, gc, plane, sx, sy, w, h, dst, dx, dy; {
    Display *dpy;
    Drawable ddst = Get_Drawable (dst, &dpy), dsrc = Get_Drawable (src, &dpy);
    register unsigned long p;

    Check_Type (gc, T_Gc);
    p = (unsigned long)s48_extract_integer (plane);
    if (p & (p-1))
	Primitive_Error ("invalid plane: ~s", plane);
    XCopyPlane (dpy, dsrc, ddst, GCONTEXT(gc)->gc, (int)s48_extract_integer (sx),
	(int)s48_extract_integer (sy), (int)s48_extract_integer (w), (int)s48_extract_integer (h),
	(int)s48_extract_integer (dx), (int)s48_extract_integer (dy), p);
    return Void;
}

static s48_value P_Draw_Point (d, gc, x, y) s48_value d, gc, x, y; {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);

    Check_Type (gc, T_Gc);
    XDrawPoint (dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x), (int)s48_extract_integer (y));
    return Void;
}

static s48_value Internal_Draw_Points (d, gc, v, relative, func, shape)
	s48_value d, gc, v, relative, shape; int (*func)(); {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);
    register XPoint *p;
    register i, n;
    int rel, sh;
    Alloca_Begin;

    Check_Type (gc, T_Gc);
    Check_Type (relative, T_Boolean);
    rel = S48_EQ_P(relative, S48_TRUE) ? CoordModePrevious : CoordModeOrigin;
    if (func == XFillPolygon)
	sh = Symbols_To_Bits (shape, 0, Polyshape_Syms);
    n = S48_VECTOR_LENGTH(v);
    Alloca (p, XPoint*, n * sizeof (XPoint));
    for (i = 0; i < n; i++) {
	s48_value point;
	
	point = S48_VECTOR_REF(v, i);
	Check_Type (point, T_Pair);
	p[i].x = (int)s48_extract_integer (S48_CAR (point));
	p[i].y = (int)s48_extract_integer (S48_CDR (point));
    }
    if (func == XFillPolygon)
	XFillPolygon (dpy, dr, GCONTEXT(gc)->gc, p, n, sh, rel);
    else
	(*func)(dpy, dr, GCONTEXT(gc)->gc, p, n, rel);
    Alloca_End;
    return Void;
}

static s48_value P_Draw_Points (d, gc, v, relative) s48_value d, gc, v, relative; {
    return Internal_Draw_Points (d, gc, v, relative, XDrawPoints, S48_NULL);
}

static s48_value P_Draw_Line (d, gc, x1, y1, x2, y2)
	s48_value d, gc, x1, y1, x2, y2; {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);

    Check_Type (gc, T_Gc);
    XDrawLine (dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x1), (int)s48_extract_integer (y1),
	(int)s48_extract_integer (x2), (int)s48_extract_integer (y2));
    return Void;
}

static s48_value P_Draw_Lines (d, gc, v, relative) s48_value d, gc, v, relative; {
    return Internal_Draw_Points (d, gc, v, relative, XDrawLines, S48_NULL);
}

static s48_value P_Draw_Segments (d, gc, v) s48_value d, gc, v; {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);
    register XSegment *p;
    register i, n;
    Alloca_Begin;

    Check_Type (gc, T_Gc);
    n = S48_VECTOR_LENGTH(v);
    Alloca (p, XSegment*, n * sizeof (XSegment));
    for (i = 0; i < n; i++) {
	s48_value seg;
	
	seg = S48_VECTOR_REF(v, i);
	Check_Type (seg, T_Pair);
	if (Fast_Length (seg) != 4)
	    Primitive_Error ("invalid segment: ~s", seg);
	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));
    }
    XDrawSegments (dpy, dr, GCONTEXT(gc)->gc, p, n);
    Alloca_End;
    return Void;
}

static s48_value Internal_Draw_Rectangle (d, gc, x, y, w, h, func)
	s48_value d, gc, x, y, w, h; int (*func)(); {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);

    Check_Type (gc, T_Gc);
    (*func)(dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x),
	(int)s48_extract_integer (y), (int)s48_extract_integer (w), (int)s48_extract_integer (h));
    return Void;
}

static s48_value P_Draw_Rectangle (d, gc, x, y, w, h) s48_value d, gc, x, y, w, h; {
    return Internal_Draw_Rectangle (d, gc, x, y, w, h, XDrawRectangle);
}

static s48_value P_Fill_Rectangle (d, gc, x, y, w, h) s48_value d, gc, x, y, w, h; {
    return Internal_Draw_Rectangle (d, gc, x, y, w, h, XFillRectangle);
}

static s48_value Internal_Draw_Rectangles (d, gc, v, func)
	s48_value d, gc, v; int (*func)(); {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);
    register XRectangle *p;
    register i, n;
    Alloca_Begin;

    Check_Type (gc, T_Gc);
    n = S48_VECTOR_LENGTH(v);
    Alloca (p, XRectangle*, n * sizeof (XRectangle));
    for (i = 0; i < n; i++) {
	s48_value rect;
	
	rect = S48_VECTOR_REF(v, i);
	Check_Type (rect, T_Pair);
	if (Fast_Length (rect) != 4)
	    Primitive_Error ("invalid rectangle: ~s", rect);
	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));
    }
    (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
    Alloca_End;
    return Void;
}

static s48_value P_Draw_Rectangles (d, gc, v) s48_value d, gc, v; {
    return Internal_Draw_Rectangles (d, gc, v, XDrawRectangles);
}

static s48_value P_Fill_Rectangles (d, gc, v) s48_value d, gc, v; {
    return Internal_Draw_Rectangles (d, gc, v, XFillRectangles);
}

static s48_value Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, func)
	s48_value d, gc, x, y, w, h, a1, a2; int (*func)(); {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);

    Check_Type (gc, T_Gc);
    (*func)(dpy, dr, GCONTEXT(gc)->gc, (int)s48_extract_integer (x), (int)s48_extract_integer (y),
	(int)s48_extract_integer (w), (int)s48_extract_integer (h), (int)s48_extract_integer (a1), (int)s48_extract_integer (a2));
    return Void;
}

static s48_value P_Draw_Arc (d, gc, x, y, w, h, a1, a2)
	s48_value d, gc, x, y, w, h, a1, a2; {
    return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XDrawArc);
}

static s48_value P_Fill_Arc (d, gc, x, y, w, h, a1, a2)
	s48_value d, gc, x, y, w, h, a1, a2; {
    return Internal_Draw_Arc (d, gc, x, y, w, h, a1, a2, XFillArc);
}

static s48_value Internal_Draw_Arcs (d, gc, v, func) s48_value d, gc, v;
	int (*func)(); {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);
    register XArc *p;
    register i, n;
    Alloca_Begin;

    Check_Type (gc, T_Gc);
    n = S48_VECTOR_LENGTH(v);
    Alloca (p, XArc*, n * sizeof (XArc));
    for (i = 0; i < n; i++) {
	s48_value arc;
	
	arc = S48_VECTOR_REF(v, i);
	Check_Type (arc, T_Pair);
	if (Fast_Length (arc) != 6)
	    Primitive_Error ("invalid arc: ~s", arc);
	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)); arc = S48_CDR (arc);
	p[i].angle1 = (int)s48_extract_integer (S48_CAR (arc)); arc = S48_CDR (arc);
	p[i].angle2 = (int)s48_extract_integer (S48_CAR (arc));
    }
    (*func)(dpy, dr, GCONTEXT(gc)->gc, p, n);
    Alloca_End;
    return Void;
}

static s48_value P_Draw_Arcs (d, gc, v) s48_value d, gc, v; {
    return Internal_Draw_Arcs (d, gc, v, XDrawArcs);
}

static s48_value P_Fill_Arcs (d, gc, v) s48_value d, gc, v; {
    return Internal_Draw_Arcs (d, gc, v, XFillArcs);
}

static s48_value P_Fill_Polygon (d, gc, v, relative, shape)
	s48_value d, gc, v, relative, shape; {
    return Internal_Draw_Points (d, gc, v, relative, XFillPolygon, shape);
}

elk_init_xlib_graphics () {
    Define_Primitive (P_Clear_Area,        "clear-area",       6, 6, EVAL);
    Define_Primitive (P_Copy_Area,         "copy-area",        9, 9, EVAL);
    Define_Primitive (P_Copy_Plane,        "copy-plane",      10,10, EVAL);
    Define_Primitive (P_Draw_Point,        "draw-point",       4, 4, EVAL);
    Define_Primitive (P_Draw_Points,       "draw-points",      4, 4, EVAL);
    Define_Primitive (P_Draw_Line,         "draw-line",        6, 6, EVAL);
    Define_Primitive (P_Draw_Lines,        "draw-lines",       4, 4, EVAL);
    Define_Primitive (P_Draw_Segments,     "draw-segments",    3, 3, EVAL);
    Define_Primitive (P_Draw_Rectangle,    "draw-rectangle",   6, 6, EVAL);
    Define_Primitive (P_Fill_Rectangle,    "fill-rectangle",   6, 6, EVAL);
    Define_Primitive (P_Draw_Rectangles,   "draw-rectangles",  3, 3, EVAL);
    Define_Primitive (P_Fill_Rectangles,   "fill-rectangles",  3, 3, EVAL);
    Define_Primitive (P_Draw_Arc,          "draw-arc",         8, 8, EVAL);
    Define_Primitive (P_Fill_Arc,          "fill-arc",         8, 8, EVAL);
    Define_Primitive (P_Draw_Arcs,         "draw-arcs",        3, 3, EVAL);
    Define_Primitive (P_Fill_Arcs,         "fill-arcs",        3, 3, EVAL);
    Define_Primitive (P_Fill_Polygon,      "fill-polygon",     5, 5, EVAL);
}