From ce53a9ebd9eeaab458f7501567ed2ba4bb05279f Mon Sep 17 00:00:00 2001 From: frese Date: Mon, 21 May 2001 15:33:32 +0000 Subject: [PATCH] Untested conversion to the s48 ffi. --- c/xlib/display.c | 420 ++++++++++++++++++++--------------------------- 1 file changed, 177 insertions(+), 243 deletions(-) diff --git a/c/xlib/display.c b/c/xlib/display.c index 80af219..2a5be78 100644 --- a/c/xlib/display.c +++ b/c/xlib/display.c @@ -1,308 +1,242 @@ #include "xlib.h" -static Display_Visit (dp, f) s48_value *dp; int (*f)(); { - (*f)(&DISPLAY(*dp)->after); +static s48_value display_record_type_binding = S48_FALSE; + +// Open_Display(name) name should be a string or S48_FALSE (=> Null) +s48_value Open_Display (s48_value name) { + char* cname = (char*)0; + int res; + if (!S48_FALSE_P(name)) + cname = s48_extract_string(name); + res = XOpenDisplay(cname); + return s48_enter_fixnum(res); } -Generic_Predicate (Display) - -Generic_Equal (Display, DISPLAY, dpy) - -static Display_Print (d, port, raw, depth, length) s48_value d, port; { - Printf (port, "#[display %lu %s]", (unsigned)DISPLAY(d)->dpy, - DisplayString (DISPLAY(d)->dpy)); +// Close_Display( Xdisplay ) Xdisplay should be a pointer to the X-lib struct +// cast into a Scheme-Integer. +s48_value Close_Display(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + XCloseDisplay(dpy); + return S48_UNSPECIFIC; } -s48_value Make_Display (finalize, dpy) Display *dpy; { - s48_value d; - - d = Find_Object (T_Display, (GENERIC)dpy, Match_X_Obj); - if (S48_NULL_P (d)) { - d = Alloc_Object (sizeof (struct S_Display), T_Display, 0); - DISPLAY(d)->dpy = dpy; - DISPLAY(d)->free = 0; - DISPLAY(d)->after = S48_FALSE; - Register_Object (d, (GENERIC)dpy, finalize ? P_Close_Display : - (PFO)0, 1); - } - return d; +// The following procedure mainly wrap a corresponding XLib macro without +// underscores... +s48_value Display_Default_Root_Window(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + Window wnd = DefaultRootWindow(dpy); + return s48_enter_integer((long)wnd); } -static s48_value P_Open_Display (argc, argv) s48_value *argv; { - register char *s; - Display *dpy; - - if (argc == 1) { - if ((dpy = XOpenDisplay (Get_Strsym (argv[0]))) == 0) - Primitive_Error ("cannot open display ~s", argv[0]); - } else if ((dpy = XOpenDisplay ((char *)0)) == 0) { - s = XDisplayName ((char *)0); - Primitive_Error ("cannot open display ~s", - Make_String (s, strlen (s))); - } - return Make_Display (1, dpy); +s48_value Display_Default_Colormap(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + Colormap cmp = DefaultColormap(dpy, DefaultScreen(dpy)); + return s48_enter_integer((long)cmp); } -s48_value P_Close_Display (d) s48_value d; { - register struct S_Display *p; - - Check_Type (d, T_Display); - p = DISPLAY(d); - if (!p->free) { - Terminate_Group ((GENERIC)p->dpy); - XCloseDisplay (p->dpy); - } - Deregister_Object (d); - p->free = 1; - return Void; +s48_value Display_Default_Gcontext(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + GC gc = DefaultGC(dpy, DefaultScreen(dpy)); + return s48_enter_integer((long)gc); } -static s48_value P_Display_Default_Root_Window (d) s48_value d; { - Check_Type (d, T_Display); - return Make_Window (0, DISPLAY(d)->dpy, - DefaultRootWindow (DISPLAY(d)->dpy)); +s48_value Display_Default_Depth(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + int depth = DefaultDepth(dpy, DefaultScreen(dpy)); + return s48_enter_integer(depth); } -static s48_value P_Display_Default_Colormap (d) s48_value d; { - register Display *dpy; - - Check_Type (d, T_Display); - dpy = DISPLAY(d)->dpy; - return Make_Colormap (0, dpy, DefaultColormap (dpy, DefaultScreen (dpy))); +s48_value Display_Default_Screen_Number(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(DefaultScreen(dpy)); } -static s48_value P_Display_Default_Gcontext (d) s48_value d; { - register Display *dpy; - - Check_Type (d, T_Display); - dpy = DISPLAY(d)->dpy; - return Make_Gc (0, dpy, DefaultGC (dpy, DefaultScreen (dpy))); +s48_value Display_Cells(s48_value Xdisplay, s48_value ScrNum) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + int num = (int)s48_extract_integer(ScrNum); + return s48_enter_integer(DisplayCells(dpy, num)); } -static s48_value P_Display_Default_Depth (d) s48_value d; { - register Display *dpy; - - Check_Type (d, T_Display); - dpy = DISPLAY(d)->dpy; - return s48_enter_integer (DefaultDepth (dpy, DefaultScreen (dpy))); +s48_value Display_Planes(s48_value Xdisplay, s48_value ScrNum) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + int num = (int)s48_extract_integer(ScrNum); + return s48_enter_integer(DisplayPlanes(dpy, num)); } -static s48_value P_Display_Default_Screen_Number (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (DefaultScreen (DISPLAY(d)->dpy)); +s48_value Display_String(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + char* s = DisplayString(dpy); + return s48_enter_string(s); } -int Get_Screen_Number (dpy, scr) Display *dpy; s48_value scr; { - register s; - - if ((s = (int)s48_extract_integer (scr)) < 0 || s > ScreenCount (dpy)-1) - Primitive_Error ("invalid screen number"); - return s; +s48_value Display_Vendor(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + char* s = ServerVendor(dpy); + int i = VendorRelease(dpy); + return s48_cons( s48_enter_string(s), + s48_enter_integer(i) ); } -static s48_value P_Display_Cells (d, scr) s48_value d, scr; { - Check_Type (d, T_Display); - return s48_enter_integer (DisplayCells (DISPLAY(d)->dpy, - Get_Screen_Number (DISPLAY(d)->dpy, scr))); +s48_value Display_Protocol_Version(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + int maj = ProtocolVersion(dpy); + int min = ProtocolRevision(dpy); + return s48_cons( s48_enter_integer(maj), + s48_enter_integer(min) ); } -static s48_value P_Display_Planes (d, scr) s48_value d, scr; { - Check_Type (d, T_Display); - return s48_enter_integer (DisplayPlanes (DISPLAY(d)->dpy, - Get_Screen_Number (DISPLAY(d)->dpy, scr))); +s48_value Display_Screen_Count(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + int cnt = ScreenCount(dpy); + return s48_enter_integer(cnt); } -static s48_value P_Display_String (d) s48_value d; { - register char *s; - Check_Type (d, T_Display); - s = DisplayString (DISPLAY(d)->dpy); - return Make_String (s, strlen (s)); +s48_value Display_Image_Byte_Order(s48_value d) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return Bits_To_Symbols( (unsigned long)ImageByteOrder(dpy), + 0, Byte_Order_Syms ); } -static s48_value P_Display_Vendor (d) s48_value d; { - register char *s; - s48_value ret, name; - S48_DECLARE_GC_PROTECT(1); - - Check_Type (d, T_Display); - s = ServerVendor (DISPLAY(d)->dpy); - name = Make_String (s, strlen (s)); - S48_GC_PROTECT_1 (name); - ret = s48_cons (S48_NULL, s48_enter_integer (VendorRelease (DISPLAY(d)->dpy))); - S48_CAR (ret) = name; - S48_GC_UNPROTECT; - return ret; +s48_value Display_Bitmap_Unit(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(BitmapUnit(dpy)); } -static s48_value P_Display_Protocol_Version (d) s48_value d; { - Check_Type (d, T_Display); - return s48_cons (s48_enter_integer (ProtocolVersion (DISPLAY(d)->dpy)), - s48_enter_integer (ProtocolRevision (DISPLAY(d)->dpy))); +s48_value Display_Bitmap_Bit_Order(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return Bits_To_Symbols( (unsigned long)BitmapBitOrder(dpy), + 0, Byte_Order_Syms ); } -static s48_value P_Display_Screen_Count (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (ScreenCount (DISPLAY(d)->dpy)); +s48_value Display_Bitmap_Pad(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(BitmapPad(dpy)); } -static s48_value P_Display_Image_Byte_Order (d) s48_value d; { - Check_Type (d, T_Display); - return Bits_To_Symbols ((unsigned long)ImageByteOrder (DISPLAY(d)->dpy), - 0, Byte_Order_Syms); +s48_value Display_Width(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(DisplayWidth(dpy), DefaultScreen(dpy)); } -static s48_value P_Display_Bitmap_Unit (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (BitmapUnit (DISPLAY(d)->dpy)); +s48_value Display_Height(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(DisplayHeight(dpy, DefaultScreen(dpy))); } -static s48_value P_Display_Bitmap_Bit_Order (d) s48_value d; { - Check_Type (d, T_Display); - return Bits_To_Symbols ((unsigned long)BitmapBitOrder (DISPLAY(d)->dpy), - 0, Byte_Order_Syms); +s48_value Display_Width_Mm (s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(DisplayWidthMM(dpy, DefaultScreen(dpy))); } -static s48_value P_Display_Bitmap_Pad (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (BitmapPad (DISPLAY(d)->dpy)); +s48_value Display_Height_Mm (s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(DisplayHeightMM(dpy, DefaultScreen(dpy))); } -static s48_value P_Display_Width (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (DisplayWidth (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); +s48_value Display_Motion_Buffer_Size(s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + return s48_enter_integer(XDisplayMotionBufferSize(dpy)); } -static s48_value P_Display_Height (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (DisplayHeight (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); +s48_value Display_Flush_Output (s48_value Xdisplay); { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + XFlush (dpy); + return S48_UNSPECIFIC; } -static s48_value P_Display_Width_Mm (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (DisplayWidthMM (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); +s48_value Display_Wait_Output (s48_value Xdisplay, s48_value discard) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + XSync (dpy, !S48_FALSE_P(discard)); + return S48_UNSPECIFIC; } -static s48_value P_Display_Height_Mm (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (DisplayHeightMM (DISPLAY(d)->dpy, - DefaultScreen (DISPLAY(d)->dpy))); +s48_value P_No_Op (s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + XNoOp(dpy); + return S48_UNSPECIFIC; } -static s48_value P_Display_Motion_Buffer_Size (d) s48_value d; { - Check_Type (d, T_Display); - return s48_enter_integer (XDisplayMotionBufferSize (DISPLAY(d)->dpy)); -} +s48_value List_Depths (s48_value Xdisplay, s48_value scr) { + S48_DECLARE_GC_PROTECT(1); + Display* dpy = (Display*)s48_extract_integer(Xdisplay); + int i, num; + int* p; + s48_value ret; + S48_GC_PROTECT_1(ret); -static s48_value P_Display_Flush_Output (d) s48_value d; { - Check_Type (d, T_Display); - XFlush (DISPLAY(d)->dpy); - return Void; -} - -static s48_value P_Display_Wait_Output (d, discard) s48_value d, discard; { - Check_Type (d, T_Display); - Check_Type (discard, T_Boolean); - XSync (DISPLAY(d)->dpy, S48_EQ_P(discard, S48_TRUE)); - return Void; -} - -static s48_value P_No_Op (d) s48_value d; { - Check_Type (d, T_Display); - XNoOp (DISPLAY(d)->dpy); - return Void; -} - -static s48_value P_List_Depths (d, scr) s48_value d, scr; { - int num; - register *p, i; - s48_value ret; - - Check_Type (d, T_Display); - if (!(p = XListDepths (DISPLAY(d)->dpy, - Get_Screen_Number (DISPLAY(d)->dpy, scr), &num))) - return S48_FALSE; - ret = s48_make_vector (num, S48_NULL); + p = XListDepths(dpy, s48_extract_integer(scr), &num); + if (!p) + ret = S48_FALSE; + else { + ret = s48_make_vector(num, S48_NULL); for (i = 0; i < num; i++) - S48_VECTOR_SET(ret, i, s48_enter_integer (p[i]);) - XFree ((char *)p); - return ret; + S48_VECTOR_SET(ret, i, s48_enter_integer(p[i])); + XFree((char *)p); + } + + S48_GC_UNPROTECT; + return ret; } -static s48_value P_List_Pixmap_Formats (d) s48_value d; { - register XPixmapFormatValues *p; - int num; - register i; - s48_value ret; - S48_DECLARE_GC_PROTECT(1); +s48_value List_Pixmap_Formats (s48_value Xdisplay) { + Display* dpy = (Display*)s48_extract_integer(Xdisplay); - Check_Type (d, T_Display); - if (!(p = XListPixmapFormats (DISPLAY(d)->dpy, &num))) - return S48_FALSE; + S48_DECLARE_GC_PROTECT(2); + int num, i; + XPixmapFormatValues* p; + s48_value ret, t; + S48_GC_PROTECT_2(ret, t); + + p = XListPixmapFormats(dpy, %num); + + if (!p) ret = S48_FALSE; + else { ret = s48_make_vector (num, S48_NULL); - S48_GC_PROTECT_1 (ret); for (i = 0; i < num; i++) { - s48_value t; - - t = P_Make_List (s48_enter_integer (3), S48_NULL); - S48_VECTOR_SET(ret, i, t;) - S48_CAR (t) = s48_enter_integer (p[i].depth); t = S48_CDR (t); - S48_CAR (t) = s48_enter_integer (p[i].bits_per_pixel); t = S48_CDR (t); - S48_CAR (t) = s48_enter_integer (p[i].scanline_pad); + t = s48_cons(s48_enter_integer(p[i].depth), + s48_cons(s48_enter_integer(p[i].bits_per_pixel), + s48_cons(s48_enter_integer(p[i].pad), + S48_NULL))); + S48_VECTOR_SET(ret, i, t); } - S48_GC_UNPROTECT; XFree ((char *)p); - return ret; + } + + S48_GC_UNPROTECT; + return ret; } -elk_init_xlib_display () { - T_Display = Define_Type (0, "display", NOFUNC, sizeof (struct S_Display), - Display_Equal, Display_Equal, Display_Print, Display_Visit); - Define_Primitive (P_Displayp, "display?", 1, 1, EVAL); - Define_Primitive (P_Open_Display, "open-display", 0, 1, VARARGS); - Define_Primitive (P_Close_Display, "close-display", 1, 1, EVAL); - Define_Primitive (P_Display_Default_Root_Window, - "display-default-root-window", 1, 1, EVAL); - Define_Primitive (P_Display_Default_Colormap, - "display-default-colormap", 1, 1, EVAL); - Define_Primitive (P_Display_Default_Gcontext, - "display-default-gcontext", 1, 1, EVAL); - Define_Primitive (P_Display_Default_Depth, - "display-default-depth", 1, 1, EVAL); - Define_Primitive (P_Display_Default_Screen_Number, - "display-default-screen-number", 1, 1, EVAL); - Define_Primitive (P_Display_Cells, "display-cells", 2, 2, EVAL); - Define_Primitive (P_Display_Planes, "display-planes", 2, 2, EVAL); - Define_Primitive (P_Display_String, "display-string", 1, 1, EVAL); - Define_Primitive (P_Display_Vendor, "display-vendor", 1, 1, EVAL); - Define_Primitive (P_Display_Protocol_Version, - "display-protocol-version", 1, 1, EVAL); - Define_Primitive (P_Display_Screen_Count, - "display-screen-count", 1, 1, EVAL); - Define_Primitive (P_Display_Image_Byte_Order, - "display-image-byte-order", 1, 1, EVAL); - Define_Primitive (P_Display_Bitmap_Unit, - "display-bitmap-unit", 1, 1, EVAL); - Define_Primitive (P_Display_Bitmap_Bit_Order, - "display-bitmap-bit-order", 1, 1, EVAL); - Define_Primitive (P_Display_Bitmap_Pad, - "display-bitmap-pad", 1, 1, EVAL); - Define_Primitive (P_Display_Width, "display-width", 1, 1, EVAL); - Define_Primitive (P_Display_Height, "display-height", 1, 1, EVAL); - Define_Primitive (P_Display_Width_Mm,"display-width-mm", 1, 1, EVAL); - Define_Primitive (P_Display_Height_Mm, - "display-height-mm", 1, 1, EVAL); - Define_Primitive (P_Display_Motion_Buffer_Size, - "display-motion-buffer-size", 1, 1, EVAL); - Define_Primitive (P_Display_Flush_Output, - "display-flush-output", 1, 1, EVAL); - Define_Primitive (P_Display_Wait_Output, - "display-wait-output", 2, 2, EVAL); - Define_Primitive (P_No_Op, "no-op", 1, 1, EVAL); - Define_Primitive (P_List_Depths, "list-depths", 2, 2, EVAL); - Define_Primitive (P_List_Pixmap_Formats, - "list-pixmap-formats", 1, 1, EVAL); +void s48_init_display(void) { + S48_GC_PROTECT_GLOBAL(display_record_type_binding); + display_record_type_binding = s48_get_imported_binding("display-record-type"); + + S48_EXPORT_FUNCTION(Open_Display); + S48_EXPORT_FUNCTION(Close_Display); + S48_EXPORT_FUNCTION(Display_Default_Root_Window); + S48_EXPORT_FUNCTION(Display_Default_Colormap); + S48_EXPORT_FUNCTION(Display_Default_Gcontext); + S48_EXPORT_FUNCTION(Display_Default_Depth); + S48_EXPORT_FUNCTION(Display_Default_Screen_Number); + S48_EXPORT_FUNCTION(Display_Cells); + S48_EXPORT_FUNCTION(Display_Planes); + S48_EXPORT_FUNCTION(Display_String); + S48_EXPORT_FUNCTION(Display_Vendor); + S48_EXPORT_FUNCTION(Display_Protocol_Version); + S48_EXPORT_FUNCTION(Display_Screen_Count); + S48_EXPORT_FUNCTION(Display_Image_Byte_Order); + S48_EXPORT_FUNCTION(Display_Bitmap_Unit); + S48_EXPORT_FUNCTION(Display_Bitmap_Bit_Order); + S48_EXPORT_FUNCTION(Display_Display_Bitmap_Pad); + S48_EXPORT_FUNCTION(Display_Width); + S48_EXPORT_FUNCTION(Display_Height); + S48_EXPORT_FUNCTION(Display_Width_Mm); + S48_EXPORT_FUNCTION(Display_Height_Mm); + S48_EXPORT_FUNCTION(Display_Motion_Buffer_Size); + S48_EXPORT_FUNCTION(Display_Flushed_Output); + S48_EXPORT_FUNCTION(Display_Wait_Output); + S48_EXPORT_FUNCTION(No_Op); + S48_EXPORT_FUNCTION(List_Depths); + S48_EXPORT_FUNCTION(List_Pixmap_Formats); + }