scx/c/xlib/pixmap.c

#include "xlib.h"

Generic_Predicate (Pixmap)

Generic_Equal_Dpy (Pixmap, PIXMAP, pm)

Generic_Print (Pixmap, "#[pixmap %lu]", PIXMAP(x)->pm)

Generic_Get_Display (Pixmap, PIXMAP)

static s48_value Internal_Make_Pixmap (finalize, dpy, pix)
	Display *dpy; Pixmap pix; {
    s48_value pm;

    if (pix == None)
	return Sym_None;
    pm = Find_Object (T_Pixmap, (GENERIC)dpy, Match_X_Obj, pix);
    if (S48_NULL_P (pm)) {
	pm = Alloc_Object (sizeof (struct S_Pixmap), T_Pixmap, 0);
	PIXMAP(pm)->tag = S48_NULL;
	PIXMAP(pm)->pm = pix;
	PIXMAP(pm)->dpy = dpy;
	PIXMAP(pm)->free = 0;
	Register_Object (pm, (GENERIC)dpy,
	    finalize ? P_Free_Pixmap : (PFO)0, 0);
    }
    return pm;
}

/* Backwards compatibility: */
s48_value Make_Pixmap (dpy, pix) Display *dpy; Pixmap pix; {
    return Internal_Make_Pixmap (1, dpy, pix);
}

s48_value Make_Pixmap_Foreign (dpy, pix) Display *dpy; Pixmap pix; {
    return Internal_Make_Pixmap (0, dpy, pix);
}

Pixmap Get_Pixmap (p) s48_value p; {
    Check_Type (p, T_Pixmap);
    return PIXMAP(p)->pm;
}

s48_value P_Free_Pixmap (p) s48_value p; {
    Check_Type (p, T_Pixmap);
    if (!PIXMAP(p)->free)
	XFreePixmap (PIXMAP(p)->dpy, PIXMAP(p)->pm);
    Deregister_Object (p);
    PIXMAP(p)->free = 1;
    return Void;
}

static s48_value P_Create_Pixmap (d, w, h, depth) s48_value d, w, h, depth; {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);

    return Make_Pixmap (dpy, XCreatePixmap (dpy, dr, (int)s48_extract_integer (w),
	(int)s48_extract_integer (h), (int)s48_extract_integer (depth)));
}

static s48_value P_Create_Bitmap_From_Data (win, data, pw, ph)
	s48_value win, data, pw, ph; {
    register w, h;

    Check_Type (win, T_Window);
    Check_Type (data, T_String);
    w = (int)s48_extract_integer (pw);
    h = (int)s48_extract_integer (ph);
    if (w * h > 8 * STRING(data)->size)
	Primitive_Error ("bitmap too small");
    return Make_Pixmap (WINDOW(win)->dpy,
	XCreateBitmapFromData (WINDOW(win)->dpy, WINDOW(win)->win,
	    STRING(data)->data, w, h));
}

static s48_value P_Create_Pixmap_From_Bitmap_Data (win, data, pw, ph, fg, bg,
	depth) s48_value win, data, pw, ph, fg, bg, depth; {
    register w, h;

    Check_Type (win, T_Window);
    Check_Type (data, T_String);
    w = (int)s48_extract_integer (pw);
    h = (int)s48_extract_integer (ph);
    if (w * h > 8 * STRING(data)->size)
	Primitive_Error ("bitmap too small");
    return Make_Pixmap (WINDOW(win)->dpy,
	XCreatePixmapFromBitmapData (WINDOW(win)->dpy, WINDOW(win)->win,
	    STRING(data)->data, w, h, Get_Pixel (fg), Get_Pixel (bg),
		(int)s48_extract_integer (depth)));
}

static s48_value P_Read_Bitmap_File (d, fn) s48_value d, fn; {
    Display *dpy;
    Drawable dr = Get_Drawable (d, &dpy);
    unsigned width, height;
    int r, xhot, yhot;
    Pixmap bitmap;
    s48_value t, ret, x;
    S48_DECLARE_GC_PROTECT(2);

    Disable_Interrupts;
    r = XReadBitmapFile (dpy, dr, Get_Strsym (fn), &width, &height, &bitmap,
	&xhot, &yhot);
    Enable_Interrupts;
    if (r != BitmapSuccess)
	return Bits_To_Symbols ((unsigned long)r, 0, Bitmapstatus_Syms);
    t = ret = P_Make_List (s48_enter_integer (5), S48_NULL);
    S48_GC_PROTECT_2 (ret, t);
    x = Make_Pixmap (dpy, bitmap);
    S48_CAR (t) = x; t = S48_CDR (t);
    S48_CAR (t) = s48_enter_integer (width); t = S48_CDR (t);
    S48_CAR (t) = s48_enter_integer (height); t = S48_CDR (t);
    S48_CAR (t) = s48_enter_integer (xhot); t = S48_CDR (t);
    S48_CAR (t) = s48_enter_integer (yhot);
    S48_GC_UNPROTECT;
    return ret;
}

static s48_value P_Write_Bitmap_File (argc, argv) s48_value *argv; {
    Pixmap pm;
    int ret, xhot = -1, yhot = -1;

    pm = Get_Pixmap (argv[1]);
    if (argc == 5)
	Primitive_Error ("both x-hot and y-hot must be specified");
    if (argc == 6) {
	xhot = (int)s48_extract_integer (argv[4]);
	yhot = (int)s48_extract_integer (argv[5]);
    }
    Disable_Interrupts;
    ret = XWriteBitmapFile (PIXMAP(argv[1])->dpy, Get_Strsym (argv[0]), pm,
	(int)s48_extract_integer (argv[2]), (int)s48_extract_integer (argv[3]), xhot, yhot);
    Enable_Interrupts;
    return Bits_To_Symbols ((unsigned long)ret, 0, Bitmapstatus_Syms);
}

elk_init_xlib_pixmap () {
    Generic_Define (Pixmap, "pixmap", "pixmap?");
    Define_Primitive (P_Pixmap_Display,    "pixmap-display",    1, 1, EVAL);
    Define_Primitive (P_Free_Pixmap,       "free-pixmap",       1, 1, EVAL);
    Define_Primitive (P_Create_Pixmap,     "create-pixmap",     4, 4, EVAL);
    Define_Primitive (P_Create_Bitmap_From_Data,
			"create-bitmap-from-data",              4, 4, EVAL);
    Define_Primitive (P_Create_Pixmap_From_Bitmap_Data,
			"create-pixmap-from-bitmap-data",       7, 7, EVAL);
    Define_Primitive (P_Read_Bitmap_File,  "read-bitmap-file",  2, 2, EVAL);
    Define_Primitive (P_Write_Bitmap_File, "write-bitmap-file", 4, 6, VARARGS);
}