scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implemented in scheme48.

This commit is contained in:
frese 2001-07-30 14:11:41 +00:00
parent 72e7e23b89
commit 6163f90f6f
1 changed files with 41 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
c/xlib/cursor.c
View File

@ -1,91 +1,52 @@
#include "xlib.h"
#include "scheme48.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;
s48_value Free_Cursor(s48_value Xdisplay, s48_value Xcursor) {
XFreeCursor(EXTRACT_DISPLAY(Xdisplay),
EXTRACT_CURSOR(Xcursor));
return S48_UNSPECIFIC;
}
/* Backwards compatibility: */
s48_value Make_Cursor (dpy, cursor) Display *dpy; Cursor cursor; {
return Internal_Make_Cursor (1, dpy, cursor);
s48_value Create_Pixmap_Cursor(s48_value Xdisplay,
s48_value src, s48_value mask, s48_value x,
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; {
return Internal_Make_Cursor (0, dpy, cursor);
s48_value Create_Glyph_Cursor(s48_value Xdisplay,
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; {
if (S48_EQ_P(c, Sym_None))
return None;
Check_Type (c, T_Cursor);
return CURSOR(c)->cursor;
s48_value Recolor_Cursor(s48_value Xdisplay, s48_value Xcursor,
s48_value f, s48_value b) {
XRecolorCursor(EXTRACT_DISPLAY(Xdisplay),
EXTRACT_CURSOR(Xcursor),
EXTRACT_COLOR(f),
EXTRACT_COLOR(b));
return S48_UNSPECIFIC;
}
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);
s48_init_cursor() {
S48_EXPORT_FUNCTION(Free_Cursor);
S48_EXPORT_FUNCTION(Create_Pixmap_Cursor);
S48_EXPORT_FUNCTION(Create_Glyph_Cursor);
S48_EXPORT_FUNCTION(Recolor_Cursor);
}