scx/c/xlib/gcontext.c

#include "xlib.h"

static s48_value Sym_Gc;

Generic_Predicate (Gc)

Generic_Equal_Dpy (Gc, GCONTEXT, gc)

Generic_Print (Gc, "#[gcontext %lu]", GCONTEXT(x)->gc)

Generic_Get_Display (Gc, GCONTEXT)

s48_value Make_Gc (finalize, dpy, g) Display *dpy; GC g; {
    s48_value gc;

    if (g == None)
	return Sym_None;
    gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g);
    if (S48_NULL_P (gc)) {
	gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0);
	GCONTEXT(gc)->tag = S48_NULL;
	GCONTEXT(gc)->gc = g;
	GCONTEXT(gc)->dpy = dpy;
	GCONTEXT(gc)->free = 0;
	Register_Object (gc, (GENERIC)dpy, finalize ? P_Free_Gc :
	    (PFO)0, 0);
    }
    return gc;
}

static s48_value P_Create_Gc (w, g) s48_value w, g; {
    unsigned long mask;
    Display *dpy;
    Drawable dr;

    dr = Get_Drawable (w, &dpy);
    mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec);
    return Make_Gc (1, dpy, XCreateGC (dpy, dr, mask, &GCV));
}

static s48_value P_Copy_Gc (gc, w) s48_value gc, w; {
    GC dst;
    Display *dpy;
    Drawable dr;

    Check_Type (gc, T_Gc);
    dr = Get_Drawable (w, &dpy);
    dst = XCreateGC (dpy, dr, 0L, &GCV);
    XCopyGC (dpy, GCONTEXT(gc)->gc, ~0L, dst);
    return Make_Gc (1, dpy, dst);
}

static s48_value P_Change_Gc (gc, g) s48_value gc, g; {
    unsigned long mask;

    Check_Type (gc, T_Gc);
    mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec);
    XChangeGC (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV);
    return Void;
}

s48_value P_Free_Gc (g) s48_value g; {
    Check_Type (g, T_Gc);
    if (!GCONTEXT(g)->free)
	XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc);
    Deregister_Object (g);
    GCONTEXT(g)->free = 1;
    return Void;
}

static s48_value P_Query_Best_Size (d, w, h, shape) s48_value d, w, h, shape; {
    unsigned int rw, rh;

    Check_Type (d, T_Display);
    if (!XQueryBestSize (DISPLAY(d)->dpy, Symbols_To_Bits (shape, 0,
	    Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy),
	    (int)s48_extract_integer (w), (int)s48_extract_integer (h), &rw, &rh))
	Primitive_Error ("cannot query best shape");
    return s48_cons (s48_enter_integer (rw), s48_enter_integer (rh));
}

static s48_value P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord)
	s48_value gc, x, y, v, ord; {
    register XRectangle *p;
    register i, n;
    Alloca_Begin;

    Check_Type (gc, T_Gc);
    Check_Type (v, T_Vector);
    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));
    }
    XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, (int)s48_extract_integer (x),
	(int)s48_extract_integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms));
    Alloca_End;
    return Void;
}

static s48_value P_Set_Gcontext_Dashlist (gc, off, v) s48_value gc, off, v; {
    register char *p;
    register i, n, d;
    Alloca_Begin;

    Check_Type (gc, T_Gc);
    Check_Type (v, T_Vector);
    n = S48_VECTOR_LENGTH(v);
    Alloca (p, char*, n);
    for (i = 0; i < n; i++) {
	d = (int)s48_extract_integer (VECTOR(v)->data[i]);
	if (d < 0 || d > 255)
	    Range_Error (VECTOR(v)->data[i]);
	p[i] = d;
    }
    XSetDashes (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, (int)s48_extract_integer (off), p, n);
    Alloca_End;
    return Void;
}

#define ValidGCValuesBits \
    (GCFunction | GCPlaneMask | GCForeground | GCBackground | GCLineWidth |\
    GCLineStyle | GCCapStyle | GCJoinStyle | GCFillStyle | GCFillRule |\
    GCTile | GCStipple | GCTileStipXOrigin | GCTileStipYOrigin | GCFont |\
    GCSubwindowMode | GCGraphicsExposures | GCClipXOrigin | GCClipYOrigin |\
    GCDashOffset | GCArcMode)

static s48_value P_Get_Gc_Values (gc) s48_value gc; {
    unsigned long mask = ValidGCValuesBits;

    Check_Type (gc, T_Gc);
    if (!XGetGCValues (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV))
	Primitive_Error ("cannot get gcontext values");
    return Record_To_Vector (GC_Rec, GC_Size, Sym_Gc, GCONTEXT(gc)->dpy,
	mask);
}

elk_init_xlib_gcontext () {
    Define_Symbol (&Sym_Gc, "gcontext");
    Generic_Define (Gc, "gcontext", "gcontext?");
    Define_Primitive (P_Gc_Display,      "gcontext-display",    1, 1, EVAL);
    Define_Primitive (P_Create_Gc,       "xlib-create-gcontext",2, 2, EVAL);
    Define_Primitive (P_Copy_Gc,         "copy-gcontext",       2, 2, EVAL);
    Define_Primitive (P_Change_Gc,       "xlib-change-gcontext",2, 2, EVAL);
    Define_Primitive (P_Free_Gc,         "free-gcontext",       1, 1, EVAL);
    Define_Primitive (P_Query_Best_Size, "query-best-size",     4, 4, EVAL);
    Define_Primitive (P_Set_Gcontext_Clip_Rectangles,
	"set-gcontext-clip-rectangles!",                        5, 5, EVAL);
    Define_Primitive (P_Set_Gcontext_Dashlist,
	"set-gcontext-dashlist!",                               3, 3, EVAL);
    Define_Primitive (P_Get_Gc_Values,
			"xlib-get-gcontext-values",             1, 1, EVAL);
}