elk/lib/xlib/gcontext.c

#include "xlib.h"

static Object Sym_Gc;

Generic_Predicate (Gc)

Generic_Equal_Dpy (Gc, GCONTEXT, gc)

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

Generic_Get_Display (Gc, GCONTEXT)

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

    if (g == None)
        return Sym_None;
    gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g);
    if (Nullp (gc)) {
        gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0);
        GCONTEXT(gc)->tag = 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 Object P_Create_Gc (w, g) Object 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 Object P_Copy_Gc (gc, w) Object 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 Object P_Change_Gc (gc, g) Object 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;
}

Object P_Free_Gc (g) Object 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 Object P_Query_Best_Size (d, w, h, shape) Object 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),
            Get_Integer (w), Get_Integer (h), &rw, &rh))
        Primitive_Error ("cannot query best shape");
    return Cons (Make_Integer (rw), Make_Integer (rh));
}

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

    Check_Type (gc, T_Gc);
    Check_Type (v, T_Vector);
    n = VECTOR(v)->size;
    Alloca (p, XRectangle*, n * sizeof (XRectangle));
    for (i = 0; i < n; i++) {
        Object rect;

        rect = VECTOR(v)->data[i];
        Check_Type (rect, T_Pair);
        if (Fast_Length (rect) != 4)
            Primitive_Error ("invalid rectangle: ~s", rect);
        p[i].x = Get_Integer (Car (rect)); rect = Cdr (rect);
        p[i].y = Get_Integer (Car (rect)); rect = Cdr (rect);
        p[i].width = Get_Integer (Car (rect)); rect = Cdr (rect);
        p[i].height = Get_Integer (Car (rect));
    }
    XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, Get_Integer (x),
        Get_Integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms));
    Alloca_End;
    return Void;
}

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

    Check_Type (gc, T_Gc);
    Check_Type (v, T_Vector);
    n = VECTOR(v)->size;
    Alloca (p, char*, n);
    for (i = 0; i < n; i++) {
        d = Get_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, Get_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 Object P_Get_Gc_Values (gc) Object 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);
}