scx/c/xlib/cursor.c

#include "xlib.h"

Generic_Predicate (Cursor)

Generic_Equal_Dpy (Cursor, CURSOR, cursor)

Generic_Print (Cursor, "#[cursor %lu]", CURSOR(x)->cursor)

Generic_Get_Display (Cursor, CURSOR)

static s48_value Internal_Make_Cursor (finalize, dpy, cursor)
	Display *dpy; Cursor cursor; {
    s48_value c;

    if (cursor == None)
	return Sym_None;
    c = Find_Object (T_Cursor, (GENERIC)dpy, Match_X_Obj, cursor);
    if (S48_NULL_P (c)) {
	c = Alloc_Object (sizeof (struct S_Cursor), T_Cursor, 0);
	CURSOR(c)->tag = S48_NULL;
	CURSOR(c)->cursor = cursor;
	CURSOR(c)->dpy = dpy;
	CURSOR(c)->free = 0;
	Register_Object (c, (GENERIC)dpy,
	    finalize ? P_Free_Cursor : (PFO)0, 0);
    }
    return c;
}

/* Backwards compatibility: */
s48_value Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; {
    return Internal_Make_Cursor (1, dpy, cursor);
}

s48_value Make_Cursor_Foreign (dpy, cursor) Display *dpy; Cursor cursor; {
    return Internal_Make_Cursor (0, dpy, cursor);
}

Cursor Get_Cursor (c) s48_value c; {
    if (S48_EQ_P(c, Sym_None))
	return None;
    Check_Type (c, T_Cursor);
    return CURSOR(c)->cursor;
}

s48_value P_Free_Cursor (c) s48_value c; {
    Check_Type (c, T_Cursor);
    if (!CURSOR(c)->free)
	XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor);
    Deregister_Object (c);
    CURSOR(c)->free = 1;
    return Void;
}

static s48_value P_Create_Cursor (srcp, maskp, x, y, f, b)
	s48_value srcp, maskp, x, y, f, b; {
    Pixmap sp = Get_Pixmap (srcp), mp;
    Display *d = PIXMAP(srcp)->dpy;

    mp = S48_EQ_P(maskp, Sym_None) ? None : Get_Pixmap (maskp);
    return Make_Cursor (d, XCreatePixmapCursor (d, sp, mp,
	Get_Color (f), Get_Color (b), (int)s48_extract_integer (x), (int)s48_extract_integer (y)));
}

static s48_value P_Create_Glyph_Cursor (srcf, srcc, maskf, maskc, f, b)
	s48_value srcf, srcc, maskf, maskc, f, b; {
    Font sf = Get_Font (srcf), mf;
    Display *d = FONT(srcf)->dpy;

    mf = S48_EQ_P(maskf, Sym_None) ? None : Get_Font (maskf);
    return Make_Cursor (d, XCreateGlyphCursor (d, sf, mf,
	(int)s48_extract_integer (srcc), mf == None ? 0 : (int)s48_extract_integer (maskc),
	Get_Color (f), Get_Color (b)));
}

static s48_value P_Recolor_Cursor (c, f, b) s48_value c, f, b; {
    Check_Type (c, T_Cursor);
    XRecolorCursor (CURSOR(c)->dpy, CURSOR(c)->cursor, Get_Color (f),
	Get_Color (b));
    return Void;
}

elk_init_xlib_cursor () {
    Generic_Define (Cursor, "cursor", "cursor?");
    Define_Primitive (P_Cursor_Display, "cursor-display", 1, 1, EVAL);
    Define_Primitive (P_Free_Cursor,    "free-cursor",    1, 1, EVAL);
    Define_Primitive (P_Create_Cursor,  "create-cursor",  6, 6, EVAL);
    Define_Primitive (P_Create_Glyph_Cursor, "create-glyph-cursor",
							  6, 6, EVAL);
    Define_Primitive (P_Recolor_Cursor, "recolor-cursor", 3, 3, EVAL);
}