implemented in scheme48.
This commit is contained in:
frese
parent
72e7e23b89
commit
6163f90f6f
121
c/xlib/cursor.c
121
c/xlib/cursor.c
|
|
@ -1,91 +1,52 @@
|
||||||
#include "xlib.h"
|
#include "xlib.h"
|
||||||
|
#include "scheme48.h"
|
||||||
|
|
||||||
Generic_Predicate (Cursor)
|
s48_value Free_Cursor(s48_value Xdisplay, s48_value Xcursor) {
|
||||||
|
XFreeCursor(EXTRACT_DISPLAY(Xdisplay),
|
||||||
Generic_Equal_Dpy (Cursor, CURSOR, cursor)
|
EXTRACT_CURSOR(Xcursor));
|
||||||
|
return S48_UNSPECIFIC;
|
||||||
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 Create_Pixmap_Cursor(s48_value Xdisplay,
|
||||||
s48_value Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; {
|
s48_value src, s48_value mask, s48_value x,
|
||||||
return Internal_Make_Cursor (1, dpy, cursor);
|
s48_value y, s48_value foreground,
|
||||||
|
s48_value background) {
|
||||||
|
Cursor xc = XCreatePixmapCursor(EXTRACT_DISPLAY(Xdisplay),
|
||||||
|
EXTRACT_PIXMAP(src),
|
||||||
|
EXTRACT_PIXMAP(mask),
|
||||||
|
EXTRACT_COLOR(foreground),
|
||||||
|
EXTRACT_COLOR(background),
|
||||||
|
s48_extract_integer(x),
|
||||||
|
s48_extract_integer(y));
|
||||||
|
return ENTER_CURSOR(xc);
|
||||||
}
|
}
|
||||||
|
|
||||||
s48_value Make_Cursor_Foreign (dpy, cursor) Display *dpy; Cursor cursor; {
|
s48_value Create_Glyph_Cursor(s48_value Xdisplay,
|
||||||
return Internal_Make_Cursor (0, dpy, cursor);
|
s48_value src, s48_value srcc,
|
||||||
|
s48_value mask, s48_value maskc,
|
||||||
|
s48_value foreground, s48_value background) {
|
||||||
|
Cursor xc = XCreateGlyphCursor(EXTRACT_DISPLAY(Xdisplay),
|
||||||
|
EXTRACT_FONT(src),
|
||||||
|
EXTRACT_FONT(mask),
|
||||||
|
s48_extract_integer(srcc),
|
||||||
|
s48_extract_integer(maskc),
|
||||||
|
EXTRACT_COLOR(foreground),
|
||||||
|
EXTRACT_COLOR(background));
|
||||||
|
return ENTER_CURSOR(xc);
|
||||||
}
|
}
|
||||||
|
|
||||||
Cursor Get_Cursor (c) s48_value c; {
|
s48_value Recolor_Cursor(s48_value Xdisplay, s48_value Xcursor,
|
||||||
if (S48_EQ_P(c, Sym_None))
|
s48_value f, s48_value b) {
|
||||||
return None;
|
XRecolorCursor(EXTRACT_DISPLAY(Xdisplay),
|
||||||
Check_Type (c, T_Cursor);
|
EXTRACT_CURSOR(Xcursor),
|
||||||
return CURSOR(c)->cursor;
|
EXTRACT_COLOR(f),
|
||||||
|
EXTRACT_COLOR(b));
|
||||||
|
return S48_UNSPECIFIC;
|
||||||
}
|
}
|
||||||
|
|
||||||
s48_value P_Free_Cursor (c) s48_value c; {
|
s48_init_cursor() {
|
||||||
Check_Type (c, T_Cursor);
|
S48_EXPORT_FUNCTION(Free_Cursor);
|
||||||
if (!CURSOR(c)->free)
|
S48_EXPORT_FUNCTION(Create_Pixmap_Cursor);
|
||||||
XFreeCursor (CURSOR(c)->dpy, CURSOR(c)->cursor);
|
S48_EXPORT_FUNCTION(Create_Glyph_Cursor);
|
||||||
Deregister_Object (c);
|
S48_EXPORT_FUNCTION(Recolor_Cursor);
|
||||||
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);
|
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue