[Scsh-checkins] CVS: scx/c/xlib cursor.c,1.2,1.3

[David Frese <frese@users.sourceforge.net>]

Update of /cvsroot/scsh/scx/c/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv23107

Modified Files:
        cursor.c 
Log Message:
implemented in scheme48.


Index: cursor.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/cursor.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** cursor.c    2001/05/14 13:48:37     1.2
--- cursor.c    2001/07/30 14:11:41     1.3
***************
*** 1,91 ****
  #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);
  }
--- 1,52 ----
  #include "xlib.h"
+ #include "scheme48.h"
  
! s48_value Free_Cursor(s48_value Xdisplay, s48_value Xcursor) {
!   XFreeCursor(EXTRACT_DISPLAY(Xdisplay),
!             EXTRACT_CURSOR(Xcursor));
!   return S48_UNSPECIFIC;
! }
! 
! 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 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);
! }
! 
! 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_init_cursor() {
!   S48_EXPORT_FUNCTION(Free_Cursor);
!   S48_EXPORT_FUNCTION(Create_Pixmap_Cursor);
!   S48_EXPORT_FUNCTION(Create_Glyph_Cursor);
!   S48_EXPORT_FUNCTION(Recolor_Cursor);
  }