Update of /cvsroot/scsh/scx/c/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv3718
Modified Files:
color.c colormap.c display.c pixel.c type.c window.c xlib.h
Added Files:
main.c test
Log Message:
Major changes. The first window showed up!
--- NEW FILE ---
#include "scheme48.h"
extern void s48_init_window();
extern void s48_init_display();
extern void s48_init_type();
extern void s48_init_color();
extern void s48_init_colormap();
extern void s48_init_pixel();
int main(){
s48_add_external_init(s48_init_window);
s48_add_external_init(s48_init_display);
s48_add_external_init(s48_init_type);
s48_add_external_init(s48_init_color);
s48_add_external_init(s48_init_color);
s48_add_external_init(s48_init_colormap);
s48_add_external_init(s48_init_pixel);
s48_main(8000000, 64000,
"/afs/wsi/home/dfreese/i386_fbsd43/scsh-0.6/lib/scheme48/scsh.image",
0,(char**) 0);
}
--- NEW FILE ---
ELF FreeBSD
%
"
?EÌ?Eð?Mô@?Äüjj
ÿÿÿ?Ä?Â?Ðë?ÉÃ?öU?å?ì(?Äô?EPèJ
¸
¸
?TÖë
?ö¡XÖ?P ?XÖÉÃU?å?ìVS?u?^Áû?~
u?ÄôSè0
&
?ÂÆD:ý
ýAëò?v
[...1412 lines suppressed...]
1
_Syms
Index: color.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/color.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** color.c 2001/05/14 13:48:37 1.2
--- color.c 2001/06/11 15:25:39 1.3
***************
*** 1,77 ****
#include "xlib.h"
! Generic_Predicate (Color)
! static Color_Equal (x, y) s48_value x, y; {
! register XColor *p = &COLOR(x)->c, *q = &COLOR(y)->c;
! return p->red == q->red && p->green == q->green && p->blue == q->blue;
! }
!
! Generic_Print (Color, "#[color %lu]", POINTER(x))
!
! s48_value Make_Color (r, g, b) unsigned int r, g, b; {
! s48_value c;
!
! c = Find_Object (T_Color, (GENERIC)0, Match_X_Obj, r, g, b);
! if (S48_NULL_P (c)) {
! c = Alloc_Object (sizeof (struct S_Color), T_Color, 0);
! COLOR(c)->tag = S48_NULL;
! COLOR(c)->c.red = r;
! COLOR(c)->c.green = g;
! COLOR(c)->c.blue = b;
! Register_Object (c, (GENERIC)0, (PFO)0, 0);
! }
! return c;
! }
!
! XColor *Get_Color (c) s48_value c; {
! Check_Type (c, T_Color);
! return &COLOR(c)->c;
! }
!
! static unsigned short Get_RGB_Value (x) s48_value x; {
! double d;
!
! d = s48_extract_double (x);
! if (d < 0.0 || d > 1.0)
! Primitive_Error ("bad RGB value: ~s", x);
! return (unsigned short)(d * 65535);
! }
!
! static s48_value P_Make_Color (r, g, b) s48_value r, g, b; {
! return Make_Color (Get_RGB_Value (r), Get_RGB_Value (g), Get_RGB_Value
(b));
! }
!
! static s48_value P_Color_Rgb_Values (c) s48_value c; {
! s48_value ret, t, x;
! S48_DECLARE_GC_PROTECT(3);
!
! Check_Type (c, T_Color);
! ret = t = S48_NULL;
! S48_GC_PROTECT_3 (c, ret, t);
! t = ret = P_Make_List (s48_enter_integer (3), S48_NULL);
! S48_GC_UNPROTECT;
! x = Make_Reduced_Flonum ((double)COLOR(c)->c.red / 65535.0);
! S48_CAR (t) = x; t = S48_CDR (t);
! x = Make_Reduced_Flonum ((double)COLOR(c)->c.green / 65535.0);
! S48_CAR (t) = x; t = S48_CDR (t);
! x = Make_Reduced_Flonum ((double)COLOR(c)->c.blue / 65535.0);
! S48_CAR (t) = x;
! return ret;
! }
!
! static s48_value P_Query_Color (cmap, p) s48_value cmap, p; {
! XColor c;
! Colormap cm = Get_Colormap (cmap);
- c.pixel = Get_Pixel (p);
- Disable_Interrupts;
- XQueryColor (COLORMAP(cmap)->dpy, cm, &c);
- Enable_Interrupts;
- return Make_Color (c.red, c.green, c.blue);
- }
- static s48_value P_Query_Colors (cmap, v) s48_value cmap, v; {
- Colormap cm = Get_Colormap (cmap);
register i, n;
s48_value ret;
--- 1,54 ----
#include "xlib.h"
+ #include "scheme48.h"
! s48_value Create_Color(s48_value r, s48_value g, s48_value b) {
! s48_value col = S48_MAKE_VALUE(XColor);
! XColor* c = S48_EXTRACT_VALUE_POINTER(col, XColor);
! c->red = s48_extract_integer(r);
! c->green = s48_extract_integer(g);
! c->blue = s48_extract_integer(b);
!
! return col;
! }
!
! s48_value Int_Extract_RGB_Values(XColor col) {
! s48_value res = S48_NULL;
! S48_DECLARE_GC_PROTECT(1);
! S48_GC_PROTECT_1(res);
!
! res = s48_cons( s48_enter_integer(col.red), res );
! res = s48_cons( s48_enter_integer(col.green), res );
! res = s48_cons( s48_enter_integer(col.blue), res );
!
! S48_GC_UNPROTECT();
! return res;
! }
!
! s48_value Extract_RGB_Values(s48_value Xcolor) {
! XColor* col = EXTRACT_COLOR(Xcolor);
! return Int_Extract_RGB_Values(*col);
! }
!
! s48_value Query_Color (s48_value Xcolormap, s48_value Xpixel,
! s48_value Xdisplay) {
! XColor c;
! Colormap cm = EXTRACT_COLORMAP(Xcolormap);
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
!
! c.pixel = EXTRACT_PIXEL(Xpixel);
! XQueryColor(dpy, cm, &c);
!
! return Int_Extract_RGB_Values(c);
! }
!
! /*
! s48_value Query_Colors(s48_value Xcolormap, s48_value Xpixels,
! s48_value Xdisplay) {
! Colormap* cm = (Colormap*)S48_EXTRACT_VALUE_POINTER(Xcolormap, Colormap);
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
! long l = S48_VECTOR_LENGTH(Xpixels);
register i, n;
s48_value ret;
***************
*** 101,129 ****
}
! static s48_value P_Lookup_Color (cmap, name) s48_value cmap, name; {
! XColor visual, exact;
! Colormap cm = Get_Colormap (cmap);
! s48_value ret, x;
! S48_DECLARE_GC_PROTECT(1);
!
! if (!XLookupColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
! &visual, &exact))
! Primitive_Error ("no such color: ~s", name);
! ret = s48_cons (S48_NULL, S48_NULL);
! S48_GC_PROTECT_1 (ret);
! x = Make_Color (visual.red, visual.green, visual.blue);
! S48_CAR (ret) = x;
! x = Make_Color (exact.red, exact.green, exact.blue);
! S48_CDR (ret) = x;
! S48_GC_UNPROTECT;
! return ret;
! }
! elk_init_xlib_color () {
! Generic_Define (Color, "color", "color?");
! Define_Primitive (P_Make_Color, "make-color", 3, 3, EVAL);
! Define_Primitive (P_Color_Rgb_Values, "color-rgb-values", 1, 1, EVAL);
! Define_Primitive (P_Query_Color, "query-color", 2, 2, EVAL);
! Define_Primitive (P_Query_Colors, "query-colors", 2, 2, EVAL);
! Define_Primitive (P_Lookup_Color, "lookup-color", 2, 2, EVAL);
}
--- 78,108 ----
}
! */
! s48_value Lookup_Color(s48_value Xcolormap, s48_value Xdisplay,
! s48_value color_name) {
! XColor visual, exact;
! Colormap cm = EXTRACT_COLORMAP(Xcolormap);
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
!
! s48_value res = S48_FALSE;
! S48_DECLARE_GC_PROTECT(1);
! S48_GC_PROTECT_1(res);
!
! if (XLookupColor( dpy, cm, s48_extract_string(color_name),
! &visual, &exact )) {
! res = s48_cons( Int_Extract_RGB_Values( visual ),
! Int_Extract_RGB_Values( exact ) );
! }
!
! S48_GC_UNPROTECT();
! return res;
! }
!
! void s48_init_color(void) {
! S48_EXPORT_FUNCTION(Create_Color);
! S48_EXPORT_FUNCTION(Extract_RGB_Values);
! S48_EXPORT_FUNCTION(Query_Color);
! // S48_EXPORT_FUNCTION(Query_Colors);
! S48_EXPORT_FUNCTION(Lookup_Color);
}
Index: colormap.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/colormap.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** colormap.c 2001/05/14 13:48:37 1.2
--- colormap.c 2001/06/11 15:25:39 1.3
***************
*** 1,88 ****
#include "xlib.h"
! Generic_Predicate (Colormap)
!
! Generic_Equal_Dpy (Colormap, COLORMAP, cm)
!
! Generic_Print (Colormap, "#[colormap %lu]", COLORMAP(x)->cm)
!
! Generic_Get_Display (Colormap, COLORMAP)
!
! s48_value Make_Colormap (finalize, dpy, cmap) Display *dpy; Colormap cmap; {
! s48_value cm;
!
! if (cmap == None)
! return Sym_None;
! cm = Find_Object (T_Colormap, (GENERIC)dpy, Match_X_Obj, cmap);
! if (S48_NULL_P (cm)) {
! cm = Alloc_Object (sizeof (struct S_Colormap), T_Colormap, 0);
! COLORMAP(cm)->tag = S48_NULL;
! COLORMAP(cm)->cm = cmap;
! COLORMAP(cm)->dpy = dpy;
! COLORMAP(cm)->free = 0;
! Register_Object (cm, (GENERIC)dpy, finalize ? P_Free_Colormap :
! (PFO)0, 0);
! }
! return cm;
}
! Colormap Get_Colormap (c) s48_value c; {
! Check_Type (c, T_Colormap);
! return COLORMAP(c)->cm;
! }
! s48_value P_Free_Colormap (c) s48_value c; {
! Check_Type (c, T_Colormap);
! if (!COLORMAP(c)->free)
! XFreeColormap (COLORMAP(c)->dpy, COLORMAP(c)->cm);
! Deregister_Object (c);
! COLORMAP(c)->free = 1;
! return Void;
}
! static s48_value P_Alloc_Color (cmap, color) s48_value cmap, color; {
! XColor c;
! Colormap cm = Get_Colormap (cmap);
! int r;
!
! c = *Get_Color (color);
! Disable_Interrupts;
! r = XAllocColor (COLORMAP(cmap)->dpy, cm, &c);
! Enable_Interrupts;
! if (!r)
! return S48_FALSE;
! return Make_Pixel (c.pixel);
! }
! static s48_value P_Alloc_Named_Color (cmap, name) s48_value cmap, name; {
! Colormap cm = Get_Colormap (cmap);
! XColor screen, exact;
! int r;
! s48_value ret, t, x;
! S48_DECLARE_GC_PROTECT(2);
!
! Disable_Interrupts;
! r = XAllocNamedColor (COLORMAP(cmap)->dpy, cm, Get_Strsym (name),
! &screen, &exact);
! Enable_Interrupts;
! if (!r)
! return S48_FALSE;
! t = ret = P_Make_List (s48_enter_integer (3), S48_NULL);
! S48_GC_PROTECT_2 (t, ret);
! x = Make_Pixel (screen.pixel);
! S48_CAR (t) = x; t = S48_CDR (t);
! x = Make_Color (screen.red, screen.green, screen.blue);
! S48_CAR (t) = x; t = S48_CDR (t);
! x = Make_Color (exact.red, exact.green, exact.blue);
! S48_CAR (t) = x;
! S48_GC_UNPROTECT;
! return ret;
}
! elk_init_xlib_colormap () {
! Generic_Define (Colormap, "colormap", "colormap?");
! Define_Primitive (P_Colormap_Display, "colormap-display", 1, 1, EVAL);
! Define_Primitive (P_Free_Colormap, "free-colormap", 1, 1, EVAL);
! Define_Primitive (P_Alloc_Color, "alloc-color", 2, 2, EVAL);
! Define_Primitive (P_Alloc_Named_Color,"alloc-named-color",2, 2, EVAL);
}
--- 1,53 ----
#include "xlib.h"
+ #include "scheme48.h"
! s48_value Free_Colormap (s48_value Xcolormap, s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Colormap cm = EXTRACT_COLORMAP(Xcolormap);
! XFreeColormap(dpy, cm);
! return S48_UNSPECIFIC;
}
! s48_value Alloc_Color(s48_value Xcolormap, s48_value Xcolor,
! s48_value Xdisplay) {
! XColor* cp = EXTRACT_COLOR(Xcolor);
! Colormap cm = EXTRACT_COLORMAP(Xcolormap);
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! int r;
!
! r = XAllocColor (dpy, cm, cp);
! if (!r) return S48_FALSE;
! else return ENTER_PIXEL(cp->pixel);
}
! s48_value Alloc_Named_Color(s48_value Xcolormap, s48_value color_name,
! s48_value Xdisplay) {
! Colormap cm = EXTRACT_COLORMAP(Xcolormap);
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! XColor screen, exact;
! int r;
! s48_value ret;
!
! S48_DECLARE_GC_PROTECT(1);
!
! r = XAllocNamedColor (dpy, cm, s48_extract_string(color_name),
! &screen, &exact);
!
! if (!r) return S48_FALSE;
!
! S48_GC_PROTECT_1(ret);
! ret = s48_cons(Int_Extract_RGB_Values(exact), S48_NULL);
! ret = s48_cons(Int_Extract_RGB_Values(screen), ret);
! ret = s48_cons(ENTER_PIXEL(screen.pixel), ret);
! S48_GC_UNPROTECT();
! return ret;
}
+
! void s48_init_colormap(void) {
! S48_EXPORT_FUNCTION(Free_Colormap);
! S48_EXPORT_FUNCTION(Alloc_Color);
! S48_EXPORT_FUNCTION(Alloc_Named_Color);
}
Index: display.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/display.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** display.c 2001/05/21 15:33:32 1.3
--- display.c 2001/06/11 15:25:39 1.4
***************
*** 1,3 ****
--- 1,4 ----
#include "xlib.h"
+ #include "scheme48.h"
static s48_value display_record_type_binding = S48_FALSE;
***************
*** 6,14 ****
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);
}
--- 7,15 ----
s48_value Open_Display (s48_value name) {
char* cname = (char*)0;
! Display* dpy;
if (!S48_FALSE_P(name))
cname = s48_extract_string(name);
! dpy = XOpenDisplay(cname);
! return s48_enter_integer((long)dpy);
}
***************
*** 16,20 ****
// cast into a Scheme-Integer.
s48_value Close_Display(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
XCloseDisplay(dpy);
return S48_UNSPECIFIC;
--- 17,21 ----
// cast into a Scheme-Integer.
s48_value Close_Display(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XCloseDisplay(dpy);
return S48_UNSPECIFIC;
***************
*** 24,46 ****
// 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);
}
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 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);
}
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);
--- 25,47 ----
// underscores...
s48_value Display_Default_Root_Window(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Window wnd = DefaultRootWindow(dpy);
! return ENTER_WINDOW(wnd);
}
s48_value Display_Default_Colormap(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Colormap cmp = DefaultColormap(dpy, DefaultScreen(dpy));
! return ENTER_COLORMAP(cmp);
}
s48_value Display_Default_Gcontext(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
GC gc = DefaultGC(dpy, DefaultScreen(dpy));
! return ENTER_GC(gc);
}
s48_value Display_Default_Depth(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int depth = DefaultDepth(dpy, DefaultScreen(dpy));
return s48_enter_integer(depth);
***************
*** 48,57 ****
s48_value Display_Default_Screen_Number(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
return s48_enter_integer(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));
--- 49,58 ----
s48_value Display_Default_Screen_Number(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DefaultScreen(dpy));
}
s48_value Display_Cells(s48_value Xdisplay, s48_value ScrNum) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int num = (int)s48_extract_integer(ScrNum);
return s48_enter_integer(DisplayCells(dpy, num));
***************
*** 59,63 ****
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));
--- 60,64 ----
s48_value Display_Planes(s48_value Xdisplay, s48_value ScrNum) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int num = (int)s48_extract_integer(ScrNum);
return s48_enter_integer(DisplayPlanes(dpy, num));
***************
*** 65,69 ****
s48_value Display_String(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
char* s = DisplayString(dpy);
return s48_enter_string(s);
--- 66,70 ----
s48_value Display_String(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
char* s = DisplayString(dpy);
return s48_enter_string(s);
***************
*** 71,75 ****
s48_value Display_Vendor(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
char* s = ServerVendor(dpy);
int i = VendorRelease(dpy);
--- 72,76 ----
s48_value Display_Vendor(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
char* s = ServerVendor(dpy);
int i = VendorRelease(dpy);
***************
*** 79,83 ****
s48_value Display_Protocol_Version(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
int maj = ProtocolVersion(dpy);
int min = ProtocolRevision(dpy);
--- 80,84 ----
s48_value Display_Protocol_Version(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int maj = ProtocolVersion(dpy);
int min = ProtocolRevision(dpy);
***************
*** 87,91 ****
s48_value Display_Screen_Count(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
int cnt = ScreenCount(dpy);
return s48_enter_integer(cnt);
--- 88,92 ----
s48_value Display_Screen_Count(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int cnt = ScreenCount(dpy);
return s48_enter_integer(cnt);
***************
*** 93,98 ****
! 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 );
--- 94,99 ----
! s48_value Display_Image_Byte_Order(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return Bits_To_Symbols( (unsigned long)ImageByteOrder(dpy),
0, Byte_Order_Syms );
***************
*** 100,109 ****
s48_value Display_Bitmap_Unit(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
return s48_enter_integer(BitmapUnit(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 );
--- 101,110 ----
s48_value Display_Bitmap_Unit(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(BitmapUnit(dpy));
}
s48_value Display_Bitmap_Bit_Order(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return Bits_To_Symbols( (unsigned long)BitmapBitOrder(dpy),
0, Byte_Order_Syms );
***************
*** 111,145 ****
s48_value Display_Bitmap_Pad(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
return s48_enter_integer(BitmapPad(dpy));
}
s48_value Display_Width(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
! return s48_enter_integer(DisplayWidth(dpy), DefaultScreen(dpy));
}
s48_value Display_Height(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
return s48_enter_integer(DisplayHeight(dpy, DefaultScreen(dpy)));
}
s48_value Display_Width_Mm (s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
return s48_enter_integer(DisplayWidthMM(dpy, DefaultScreen(dpy)));
}
s48_value Display_Height_Mm (s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
return s48_enter_integer(DisplayHeightMM(dpy, DefaultScreen(dpy)));
}
s48_value Display_Motion_Buffer_Size(s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
return s48_enter_integer(XDisplayMotionBufferSize(dpy));
}
! s48_value Display_Flush_Output (s48_value Xdisplay); {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
XFlush (dpy);
return S48_UNSPECIFIC;
--- 112,146 ----
s48_value Display_Bitmap_Pad(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(BitmapPad(dpy));
}
s48_value Display_Width(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! return s48_enter_integer(DisplayWidth(dpy, DefaultScreen(dpy)));
}
s48_value Display_Height(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DisplayHeight(dpy, DefaultScreen(dpy)));
}
s48_value Display_Width_Mm (s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DisplayWidthMM(dpy, DefaultScreen(dpy)));
}
s48_value Display_Height_Mm (s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DisplayHeightMM(dpy, DefaultScreen(dpy)));
}
s48_value Display_Motion_Buffer_Size(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(XDisplayMotionBufferSize(dpy));
}
! s48_value Display_Flush_Output (s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XFlush (dpy);
return S48_UNSPECIFIC;
***************
*** 147,157 ****
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;
}
! s48_value P_No_Op (s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
XNoOp(dpy);
return S48_UNSPECIFIC;
--- 148,158 ----
s48_value Display_Wait_Output (s48_value Xdisplay, s48_value discard) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XSync (dpy, !S48_FALSE_P(discard));
return S48_UNSPECIFIC;
}
! s48_value No_Op (s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XNoOp(dpy);
return S48_UNSPECIFIC;
***************
*** 160,164 ****
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;
--- 161,165 ----
s48_value List_Depths (s48_value Xdisplay, s48_value scr) {
S48_DECLARE_GC_PROTECT(1);
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int i, num;
int* p;
***************
*** 176,185 ****
}
! S48_GC_UNPROTECT;
return ret;
}
s48_value List_Pixmap_Formats (s48_value Xdisplay) {
! Display* dpy = (Display*)s48_extract_integer(Xdisplay);
S48_DECLARE_GC_PROTECT(2);
--- 177,186 ----
}
! S48_GC_UNPROTECT();
return ret;
}
s48_value List_Pixmap_Formats (s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
S48_DECLARE_GC_PROTECT(2);
***************
*** 189,193 ****
S48_GC_PROTECT_2(ret, t);
! p = XListPixmapFormats(dpy, %num);
if (!p) ret = S48_FALSE;
--- 190,194 ----
S48_GC_PROTECT_2(ret, t);
! p = XListPixmapFormats(dpy, &num);
if (!p) ret = S48_FALSE;
***************
*** 197,201 ****
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);
--- 198,202 ----
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].scanline_pad),
S48_NULL)));
S48_VECTOR_SET(ret, i, t);
***************
*** 204,208 ****
}
! S48_GC_UNPROTECT;
return ret;
}
--- 205,209 ----
}
! S48_GC_UNPROTECT();
return ret;
}
***************
*** 228,232 ****
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);
--- 229,233 ----
S48_EXPORT_FUNCTION(Display_Bitmap_Unit);
S48_EXPORT_FUNCTION(Display_Bitmap_Bit_Order);
! S48_EXPORT_FUNCTION(Display_Bitmap_Pad);
S48_EXPORT_FUNCTION(Display_Width);
S48_EXPORT_FUNCTION(Display_Height);
***************
*** 234,238 ****
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);
--- 235,239 ----
S48_EXPORT_FUNCTION(Display_Height_Mm);
S48_EXPORT_FUNCTION(Display_Motion_Buffer_Size);
! S48_EXPORT_FUNCTION(Display_Flush_Output);
S48_EXPORT_FUNCTION(Display_Wait_Output);
S48_EXPORT_FUNCTION(No_Op);
Index: pixel.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/pixel.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** pixel.c 2001/05/14 13:48:37 1.2
--- pixel.c 2001/06/11 15:25:39 1.3
***************
*** 1,48 ****
#include "xlib.h"
! Generic_Predicate (Pixel)
!
! Generic_Simple_Equal (Pixel, PIXEL, pix)
!
! Generic_Print (Pixel, "#[pixel 0x%lx]", PIXEL(x)->pix)
!
! s48_value Make_Pixel (val) unsigned long val; {
! s48_value pix;
!
! pix = Find_Object (T_Pixel, (GENERIC)0, Match_X_Obj, val);
! if (S48_NULL_P (pix)) {
! pix = Alloc_Object (sizeof (struct S_Pixel), T_Pixel, 0);
! PIXEL(pix)->tag = S48_NULL;
! PIXEL(pix)->pix = val;
! Register_Object (pix, (GENERIC)0, (PFO)0, 0);
! }
! return pix;
! }
!
! unsigned long Get_Pixel (p) s48_value p; {
! Check_Type (p, T_Pixel);
! return PIXEL(p)->pix;
! }
!
! static s48_value P_Pixel_Value (p) s48_value p; {
! return s48_enter_integer (Get_Pixel (p));
! }
!
! static s48_value P_Black_Pixel (d) s48_value d; {
! Check_Type (d, T_Display);
! return Make_Pixel (BlackPixel (DISPLAY(d)->dpy,
! DefaultScreen (DISPLAY(d)->dpy)));
}
! static s48_value P_White_Pixel (d) s48_value d; {
! Check_Type (d, T_Display);
! return Make_Pixel (WhitePixel (DISPLAY(d)->dpy,
! DefaultScreen (DISPLAY(d)->dpy)));
}
! elk_init_xlib_pixel () {
! Generic_Define (Pixel, "pixel", "pixel?");
! Define_Primitive (P_Pixel_Value, "pixel-value", 1, 1, EVAL);
! Define_Primitive (P_Black_Pixel, "black-pixel", 1, 1, EVAL);
! Define_Primitive (P_White_Pixel, "white-pixel", 1, 1, EVAL);
}
--- 1,17 ----
#include "xlib.h"
+ #include "scheme48.h"
! s48_value Black_Pixel(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! return ENTER_PIXEL( BlackPixel(dpy, DefaultScreen(dpy)) );
}
! s48_value White_Pixel(s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! return ENTER_PIXEL( WhitePixel(dpy, DefaultScreen(dpy)) );
}
! void s48_init_pixel(void) {
! S48_EXPORT_FUNCTION(Black_Pixel);
! S48_EXPORT_FUNCTION(White_Pixel);
}
Index: type.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/type.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** type.c 2001/05/21 15:33:59 1.3
--- type.c 2001/06/11 15:25:39 1.4
***************
*** 1,4 ****
--- 1,24 ----
#include "xlib.h"
+ #include "scheme48.h"
+ #include <string.h>
+
+ /* Scheme48 "Extensions"
+ */
+
+ char* s48_extract_symbol(s48_value sym) {
+ return s48_extract_string(S48_SYMBOL_TO_STRING(sym));
+ }
+
+
+ s48_value string_to_symbol_binding;
+
+ s48_value s48_enter_symbol(char* name) {
+ return s48_call_scheme(S48_SHARED_BINDING_REF(string_to_symbol_binding),
+ 1, s48_enter_string(name));
+ }
+
+
+
/* Types, functions and variables for the conversion between XLib constants
and the scheme symbols:
***************
*** 6,16 ****
s48_value Bits_To_Symbols(unsigned long bits, int mask_flag, SYMDESCR* table)
{
- S48_DECLARE_GC_PROTECT(1);
s48_value res = S48_NULL;
- S48_GC_PROTECT_1(res);
-
char* name;
int val;
int i = 0;
while (table[i].name != (char*)0) {
name = table[i].name;
--- 26,37 ----
s48_value Bits_To_Symbols(unsigned long bits, int mask_flag, SYMDESCR* table)
{
s48_value res = S48_NULL;
char* name;
int val;
int i = 0;
+
+ S48_DECLARE_GC_PROTECT(1);
+ S48_GC_PROTECT_1(res);
+
while (table[i].name != (char*)0) {
name = table[i].name;
***************
*** 33,41 ****
return res;
}
! typedef struct {
! char *name;
! unsigned long val;
! } SYMDESCR;
SYMDESCR Func_Syms[] = {
--- 54,84 ----
return res;
}
+
+ unsigned long Symbols_To_Bits(s48_value Syms, int mask_flag, SYMDESCR* table)
{
+ unsigned long res = 0;
+ s48_value l;
+
+ if (mask_flag) {
+ for (l = Syms; !S48_NULL_P(l); l = S48_CDR(l)) {
+ res |= Symbol_To_Bit(S48_CAR(l), table);
+ }
+ } else {
+ res |= Symbol_To_Bit(l, table);
+ }
+
+ return res;
+ }
! unsigned long Symbol_To_Bit(s48_value Sym, SYMDESCR* table) {
! unsigned long res = 0;
! char* sym = s48_extract_symbol(Sym);
! int i;
! for (i=0; table[i].val != 0 ;i++) {
! if (strcmp(sym, table[i].name) == 0) {
! res = res | table[i].val;
! }
! }
! return res;
! }
SYMDESCR Func_Syms[] = {
***************
*** 318,322 ****
SYMDESCR Initial_State_Syms[] = {
! { "dont-care", DontS48_CAReState },
{ "normal", NormalState },
{ "zoom", ZoomState },
--- 361,365 ----
SYMDESCR Initial_State_Syms[] = {
! { "dont-care", DontCareState },
{ "normal", NormalState },
{ "zoom", ZoomState },
***************
*** 407,412 ****
Other things
*************************************************************************/
-
--- 450,455 ----
Other things
*************************************************************************/
+ /*
***************
*** 715,719 ****
break;
}
! /* fall through */
case T_PIXMAP:
*(Pixmap *)rp->slot = Get_Pixmap (*p); break;
--- 758,762 ----
break;
}
! // fall through
case T_PIXMAP:
*(Pixmap *)rp->slot = Get_Pixmap (*p); break;
***************
*** 846,848 ****
--- 889,899 ----
Define_Symbol (&Sym_Parent_Relative, "parent-relative");
Define_Symbol (&Sym_Copy_From_Parent, "copy-from-parent");
+ }
+
+ */
+
+ void s48_init_type(void) {
+ S48_GC_PROTECT_GLOBAL(string_to_symbol_binding);
+ string_to_symbol_binding = s48_get_imported_binding("string->symbol");
+ // string_to_symbol_binding =
S48_SHARED_BINDING_REF(string_to_symbol_binding);
}
Index: window.c
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/window.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** window.c 2001/05/14 13:48:37 1.2
--- window.c 2001/06/11 15:25:39 1.3
***************
*** 1,93 ****
#include "xlib.h"
! static s48_value Sym_Set_Attr, Sym_Get_Attr, Sym_Geo;
! s48_value Sym_Conf;
! Generic_Predicate (Window)
! Generic_Equal_Dpy (Window, WINDOW, win)
! Generic_Print (Window, "#[window %lu]", WINDOW(x)->win)
! Generic_Get_Display (Window, WINDOW)
!
! s48_value Make_Window (finalize, dpy, win) Display *dpy; Window win; {
! s48_value w;
!
! if (win == None)
! return Sym_None;
! if (win == PointerRoot)
! return Intern ("pointer-root");
! w = Find_Object (T_Window, (GENERIC)dpy, Match_X_Obj, win);
! if (S48_NULL_P (w)) {
! w = Alloc_Object (sizeof (struct S_Window), T_Window, 0);
! WINDOW(w)->tag = S48_NULL;
! WINDOW(w)->win = win;
! WINDOW(w)->dpy = dpy;
! WINDOW(w)->free = 0;
! WINDOW(w)->finalize = finalize;
! Register_Object (w, (GENERIC)dpy, finalize ? P_Destroy_Window :
! (PFO)0, 0);
! }
! return w;
}
! Window Get_Window (w) s48_value w; {
! if (S48_EQ_P(w, Sym_None))
! return None;
! Check_Type (w, T_Window);
! return WINDOW(w)->win;
}
! Drawable Get_Drawable (d, dpyp) s48_value d; Display **dpyp; {
! if (TYPE(d) == T_Window) {
! *dpyp = WINDOW(d)->dpy;
! return (Drawable)WINDOW(d)->win;
! } else if (TYPE(d) == T_Pixmap) {
! *dpyp = PIXMAP(d)->dpy;
! return (Drawable)PIXMAP(d)->pm;
! }
! Wrong_Type_Combination (d, "drawable");
! /*NOTREACHED*/
}
! static s48_value P_Create_Window (parent, x, y, width, height, border_width,
attr)
! s48_value parent, x, y, width, height, border_width, attr; {
! unsigned long mask;
! Window win;
!
! Check_Type (parent, T_Window);
! mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
! if ((win = XCreateWindow (WINDOW(parent)->dpy, WINDOW(parent)->win,
! (int)s48_extract_integer (x), (int)s48_extract_integer (y),
(int)s48_extract_integer (width),
! (int)s48_extract_integer (height), (int)s48_extract_integer
(border_width),
! CopyFromParent, CopyFromParent, CopyFromParent, mask, &SWA)) == 0)
! Primitive_Error ("cannot create window");
! return Make_Window (1, WINDOW(parent)->dpy, win);
}
- static s48_value P_Configure_Window (w, conf) s48_value w, conf; {
- unsigned long mask;
- Check_Type (w, T_Window);
- mask = Vector_To_Record (conf, Conf_Size, Sym_Conf, Conf_Rec);
- XConfigureWindow (WINDOW(w)->dpy, WINDOW(w)->win, mask, &WC);
- return Void;
- }
- static s48_value P_Change_Window_Attributes (w, attr) s48_value w, attr; {
- unsigned long mask;
! Check_Type (w, T_Window);
! mask = Vector_To_Record (attr, Set_Attr_Size, Sym_Set_Attr, Set_Attr_Rec);
! XChangeWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, mask, &SWA);
! return Void;
}
! static s48_value P_Get_Window_Attributes (w) s48_value w; {
! Check_Type (w, T_Window);
! XGetWindowAttributes (WINDOW(w)->dpy, WINDOW(w)->win, &WA);
! return Record_To_Vector (Win_Attr_Rec, Win_Attr_Size, Sym_Get_Attr,
! WINDOW(w)->dpy, ~0L);
}
--- 1,275 ----
#include "xlib.h"
+ #include "scheme48.h"
! static s48_value window_record_type_binding = S48_FALSE;
! unsigned long AList_To_XSetWindowAttributes(s48_value attrAlist,
! XSetWindowAttributes* Xattrs) {
! unsigned long mask = 0;
! s48_value l;
! char* cname;
! s48_value name, value;
!
! for (l = attrAlist; !S48_NULL_P(l); l = S48_CDR(l)) {
! name = S48_CAR(l);
! value = S48_CDR(l);
! cname = s48_extract_string(S48_SYMBOL_TO_STRING(name));
!
! if (cname == "background-pixmap") {
! Xattrs->background_pixmap = extract_background(value);
! mask |= CWBackPixmap;
! } else if (cname == "background-pixel") {
! Xattrs->background_pixel = s48_extract_integer(value);
! mask |= CWBackPixel;
! } else if (cname == "border-pixmap") {
! Xattrs->border_pixmap = extract_border(value);
! mask |= CWBorderPixmap;
! } else if (cname == "border-pixel") {
! Xattrs->border_pixel = s48_extract_integer(value);
! mask |= CWBorderPixel;
! } else if (cname == "bit-gravity") {
! Xattrs->bit_gravity = Symbols_To_Bits(value, 0, Bit_Grav_Syms);
! mask |= CWBitGravity;
! } else if (cname == "gravity") {
! Xattrs->win_gravity = Symbols_To_Bits(value, 0, Grav_Syms);
! mask |= CWWinGravity;
! } else if (cname == "backing-store") {
! Xattrs->backing_store = Symbols_To_Bits(value, 0, Backing_Store_Syms);
! mask |= CWBackingStore;
! } else if (cname == "backing-planes") {
! Xattrs->backing_planes = s48_extract_integer(value);
! mask |= CWBackingPlanes;
! } else if (cname == "backing-pixel") {
! Xattrs->backing_pixel = s48_extract_integer(value);
! mask |= CWBackingPixel;
! } else if (cname == "save-under") {
! Xattrs->save_under = !S48_FALSE_P(value);
! mask |= CWSaveUnder;
! } else if (cname == "event-mask") {
! Xattrs->event_mask = Symbols_To_Bits(value, 1, Event_Syms);
! mask |= CWEventMask;
! } else if (cname == "do-not-propagate-mask") {
! Xattrs->do_not_propagate_mask = Symbols_To_Bits(value, 1, Event_Syms);
! mask |= CWDontPropagate;
! } else if (cname == "override-redirect") {
! Xattrs->override_redirect = !S48_FALSE_P(value);
! mask |= CWOverrideRedirect;
! } else if (cname == "colormap") {
! Xattrs->colormap = s48_extract_integer(value);
! mask |= CWColormap;
! } else if (cname == "cursor") {
! Xattrs->cursor = s48_extract_integer(value);
! mask |= CWCursor;
! } // else error
! } /* for */
! return mask;
! }
!
! int extract_background(s48_value value) {
! if (S48_SYMBOL_P(value)) {
! char* v = s48_extract_string(S48_SYMBOL_TO_STRING(value));
! if (v == "none")
! return None;
! else if (v == "parent-relative")
! return ParentRelative;
! //else // error ...
! }
! return EXTRACT_PIXMAP(value);
! }
!
! int extract_border(s48_value value) {
! if (S48_SYMBOL_P(value)) {
! char* v = s48_extract_string(S48_SYMBOL_TO_STRING(value));
! if (v == "copy-from-parent")
! return CopyFromParent;
! // else error
! } else
! return s48_extract_integer(value);
! }
!
! s48_value Create_Window (s48_value Xdisplay, s48_value Xparent, s48_value x,
! s48_value y, s48_value width, s48_value height,
! s48_value border_width, s48_value attrAlist) {
!
! XSetWindowAttributes Xattrs;
! unsigned long mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs );
!
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window parent = EXTRACT_WINDOW(Xparent);
!
! Window win;
! win = XCreateWindow( dpy, parent, (int)s48_extract_integer(x),
! (int)s48_extract_integer(y),
! (int)s48_extract_integer (width),
! (int)s48_extract_integer (height),
! (int)s48_extract_integer (border_width),
! CopyFromParent,
! CopyFromParent,
! CopyFromParent,
! mask,
! &Xattrs );
! return ENTER_WINDOW(win);
! }
!
! s48_value Destroy_Window (s48_value Xdisplay, s48_value Xwindow) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XDestroyWindow (dpy, win);
! return S48_UNSPECIFIC;
! }
!
! s48_value Change_Window_Attributes(s48_value Xwindow, s48_value Xdisplay,
! s48_value attrAlist) {
!
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XSetWindowAttributes Xattrs;
! unsigned long mask = 0;
!
! mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs );
!
! XChangeWindowAttributes(dpy, win, mask, &Xattrs);
! return S48_UNSPECIFIC;
! }
!
! s48_value Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XWindowAttributes WA;
!
! S48_DECLARE_GC_PROTECT(1);
!
! s48_value res = S48_NULL;
! S48_GC_PROTECT_1(res);
!
! XGetWindowAttributes(dpy, win, &WA);
!
! // ... usw.
! res = s48_cons( s48_enter_integer(WA.backing_planes), res);
! res = s48_cons( Bits_To_Symbols(WA.backing_store, 1, Backing_Store_Syms),
! res);
! res = s48_cons( Bits_To_Symbols(WA.win_gravity, 1, Grav_Syms),
! res);
! res = s48_cons( Bits_To_Symbols(WA.bit_gravity, 1, Bit_Grav_Syms), res);
! res = s48_cons( Bits_To_Symbols(WA.class, 1, Class_Syms), res);
! res = s48_cons( s48_enter_integer(WA.root), res); // a Window !
! res = s48_cons( s48_enter_integer((long)WA.visual), res); // a Visual* !
! res = s48_cons( s48_enter_integer(WA.depth), res);
! res = s48_cons( s48_enter_integer(WA.border_width), res);
! res = s48_cons( s48_enter_integer(WA.height), res);
! res = s48_cons( s48_enter_integer(WA.width), res);
! res = s48_cons( s48_enter_integer(WA.y), res);
! res = s48_cons( s48_enter_integer(WA.x), res);
!
! S48_GC_UNPROTECT();
! return res;
! }
!
! s48_value Configure_Window (s48_value Xwindow, s48_value Xdisplay,
! s48_value alist) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
!
! unsigned long mask = 0;
! XWindowChanges WC;
! s48_value l;
! char* cname;
! int cvalue;
! s48_value name, value;
!
! for (l = alist; !S48_NULL_P(l); l = S48_CDR(l)) {
! name = S48_CAR(l);
! value = S48_CDR(l);
! cname = s48_extract_string(S48_SYMBOL_TO_STRING(name));
! cvalue = (int)s48_extract_integer(value); // only ints here
!
! if (cname == "x") {
! WC.x = cvalue;
! mask |= CWX;
! } else if (cname == "y") {
! WC.y = cvalue;
! mask |= CWY;
! } else if (cname == "width") {
! WC.width = cvalue;
! mask |= CWWidth;
! } else if (cname == "height") {
! WC.height = cvalue;
! mask |= CWHeight;
! } else if (cname == "border-width") {
! WC.border_width = cvalue;
! mask |= CWBorderWidth;
! } else if (cname == "sibling") {
! WC.sibling = (Window)s48_extract_integer(value);
! mask |= CWSibling;
! } else if (cname == "stack-mode") {
! WC.stack_mode = cvalue;
! mask |= CWStackMode;
! }
! } // for
! XConfigureWindow (dpy, win, mask, &WC);
! return S48_UNSPECIFIC;
! }
! s48_value Map_Window(s48_value Xwindow, s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XMapWindow(dpy, win);
! return S48_UNSPECIFIC;
! }
!
! s48_value Unmap_Window(s48_value Xwindow, s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XUnmapWindow(dpy, win);
! return S48_UNSPECIFIC;
! }
! s48_value Destroy_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XDestroySubwindows(dpy, win);
! return S48_UNSPECIFIC;
}
! s48_value Map_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XMapSubwindows(dpy, win);
! return S48_UNSPECIFIC;
}
! s48_value Unmap_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! XUnmapSubwindows(dpy, win);
! return S48_UNSPECIFIC;
}
! s48_value Circulate_Subwindows(s48_value Xwindow, s48_value Xdisplay,
! s48_value dir) {
! Display* dpy = EXTRACT_DISPLAY(Xdisplay);
! Window win = EXTRACT_WINDOW(Xwindow);
! long direction = s48_extract_integer(dir);
! XCirculateSubwindows(dpy, win, direction ? LowerHighest : RaiseLowest);
! return S48_UNSPECIFIC;
}
! /*
}
! Drawable Get_Drawable (d, dpyp) s48_value d; Display **dpyp; {
! if (TYPE(d) == T_Window) {
! *dpyp = WINDOW(d)->dpy;
! return (Drawable)WINDOW(d)->win;
! } else if (TYPE(d) == T_Pixmap) {
! *dpyp = PIXMAP(d)->dpy;
! return (Drawable)PIXMAP(d)->pm;
! }
! Wrong_Type_Combination (d, "drawable");
! //NOTREACHED
}
***************
*** 96,101 ****
Drawable dr = Get_Drawable (d, &dpy);
! /* GEO.width, GEO.height, etc. should really be unsigned, not int.
! */
XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, (unsigned *)&GEO.width,
(unsigned *)&GEO.height, (unsigned *)&GEO.border_width,
--- 278,283 ----
Drawable dr = Get_Drawable (d, &dpy);
! // GEO.width, GEO.height, etc. should really be unsigned, not int.
!
XGetGeometry (dpy, dr, &GEO.root, &GEO.x, &GEO.y, (unsigned *)&GEO.width,
(unsigned *)&GEO.height, (unsigned *)&GEO.border_width,
***************
*** 104,153 ****
}
- static s48_value P_Map_Window (w) s48_value w; {
- Check_Type (w, T_Window);
- XMapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
- return Void;
- }
-
- static s48_value P_Unmap_Window (w) s48_value w; {
- Check_Type (w, T_Window);
- XUnmapWindow (WINDOW(w)->dpy, WINDOW(w)->win);
- return Void;
- }
- s48_value P_Destroy_Window (w) s48_value w; {
- Check_Type (w, T_Window);
- if (!WINDOW(w)->free)
- XDestroyWindow (WINDOW(w)->dpy, WINDOW(w)->win);
- Deregister_Object (w);
- WINDOW(w)->free = 1;
- return Void;
- }
-
- static s48_value P_Destroy_Subwindows (w) s48_value w; {
- Check_Type (w, T_Window);
- XDestroySubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
- return Void;
- }
-
- static s48_value P_Map_Subwindows (w) s48_value w; {
- Check_Type (w, T_Window);
- XMapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
- return Void;
- }
-
- static s48_value P_Unmap_Subwindows (w) s48_value w; {
- Check_Type (w, T_Window);
- XUnmapSubwindows (WINDOW(w)->dpy, WINDOW(w)->win);
- return Void;
- }
-
- static s48_value P_Circulate_Subwindows (w, dir) s48_value w, dir; {
- Check_Type (w, T_Window);
- XCirculateSubwindows (WINDOW(w)->dpy, WINDOW(w)->win,
- Symbols_To_Bits (dir, 0, Circulate_Syms));
- return Void;
- }
-
static s48_value P_Query_Tree (w) s48_value w; {
Window root, parent, *children;
--- 286,290 ----
***************
*** 230,262 ****
return l;
}
- elk_init_xlib_window () {
- Define_Symbol (&Sym_Set_Attr, "set-window-attributes");
- Define_Symbol (&Sym_Get_Attr, "get-window-attributes");
- Define_Symbol (&Sym_Conf, "window-configuration");
- Define_Symbol (&Sym_Geo, "geometry");
- Generic_Define (Window, "window", "window?");
- Define_Primitive (P_Window_Display, "window-display", 1, 1, EVAL);
- Define_Primitive (P_Create_Window,
- "xlib-create-window", 7, 7, EVAL);
- Define_Primitive (P_Configure_Window,
- "xlib-configure-window", 2, 2, EVAL);
- Define_Primitive (P_Change_Window_Attributes,
- "xlib-change-window-attributes", 2, 2, EVAL);
- Define_Primitive (P_Get_Window_Attributes,
- "xlib-get-window-attributes", 1, 1, EVAL);
- Define_Primitive (P_Get_Geometry, "xlib-get-geometry",1, 1, EVAL);
- Define_Primitive (P_Map_Window, "map-window", 1, 1, EVAL);
- Define_Primitive (P_Unmap_Window, "unmap-window", 1, 1, EVAL);
- Define_Primitive (P_Circulate_Subwindows,
- "circulate-subwindows", 2, 2, EVAL);
- Define_Primitive (P_Destroy_Window, "destroy-window", 1, 1, EVAL);
- Define_Primitive (P_Destroy_Subwindows,
- "destroy-subwindows", 1, 1, EVAL);
- Define_Primitive (P_Map_Subwindows, "map-subwindows", 1, 1, EVAL);
- Define_Primitive (P_Unmap_Subwindows, "unmap-subwindows", 1, 1, EVAL);
- Define_Primitive (P_Query_Tree, "query-tree", 1, 1, EVAL);
- Define_Primitive (P_Translate_Coordinates,
- "translate-coordinates", 4, 4, EVAL);
- Define_Primitive (P_Query_Pointer, "query-pointer", 1, 1, EVAL);
}
--- 367,388 ----
return l;
}
+
+ */
+
+ void s48_init_window(void) {
+ S48_GC_PROTECT_GLOBAL(window_record_type_binding);
+ window_record_type_binding = s48_get_imported_binding("window-record-type");
+
+ S48_EXPORT_FUNCTION(Create_Window);
+ S48_EXPORT_FUNCTION(Destroy_Window);
+ S48_EXPORT_FUNCTION(Change_Window_Attributes);
+ S48_EXPORT_FUNCTION(Get_Window_Attributes);
+ S48_EXPORT_FUNCTION(Configure_Window);
+ S48_EXPORT_FUNCTION(Map_Window);
+ S48_EXPORT_FUNCTION(Unmap_Window);
+ S48_EXPORT_FUNCTION(Destroy_Subwindows);
+ S48_EXPORT_FUNCTION(Map_Subwindows);
+ S48_EXPORT_FUNCTION(Unmap_Subwindows);
+ S48_EXPORT_FUNCTION(Circulate_Subwindows);
}
Index: xlib.h
===================================================================
RCS file: /cvsroot/scsh/scx/c/xlib/xlib.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** xlib.h 2001/05/14 13:48:37 1.2
--- xlib.h 2001/06/11 15:25:39 1.3
***************
*** 3,8 ****
#include <X11/Xutil.h>
! #undef S48_TRUE
! #undef S48_FALSE
#ifndef NeedFunctionPrototypes /* Kludge */
--- 3,8 ----
#include <X11/Xutil.h>
! //#undef S48_TRUE
! //#undef S48_FALSE
#ifndef NeedFunctionPrototypes /* Kludge */
***************
*** 18,23 ****
#endif
! #include "scheme.h"
extern int T_Display;
extern int T_Gc;
--- 18,46 ----
#endif
! #include "scheme48.h"
+
+ #define S48_NULL_P(x) S48_EQ(x, S48_NULL)
+
+ #define S48_FALSE_P(x) S48_EQ(x, S48_FALSE)
+
+
+ /* Extraction-Macros for the new types, from their s48_value wrapping.
+ */
+
+ #define EXTRACT_DISPLAY(x) (Display*)s48_extract_integer(x)
+ #define EXTRACT_WINDOW(x) (Window)s48_extract_integer(x)
+ #define ENTER_WINDOW(x) s48_enter_integer((long)x);
+ #define EXTRACT_COLOR(x) (XColor*)S48_EXTRACT_VALUE_POINTER(x, XColor)
+ #define EXTRACT_COLORMAP(x) (Colormap)s48_extract_integer(x)
+ #define ENTER_COLORMAP(x) s48_enter_integer((long)x)
+ #define EXTRACT_PIXEL(x) (unsigned long)s48_extract_integer(x)
+ #define ENTER_PIXEL(x) s48_enter_integer((long)x)
+ #define EXTRACT_GC(x) (GC)s48_extract_integer(x)
+ #define ENTER_GC(x) s48_enter_integer((long)x)
+ #define EXTRACT_PIXMAP(x) (Pixmap)s48_extract_integer(x)
+
+
+ /*
extern int T_Display;
extern int T_Gc;
***************
*** 112,115 ****
--- 135,141 ----
};
+ */
+
+ /*
typedef struct {
char *slot;
***************
*** 119,122 ****
--- 145,149 ----
int mask;
} RECORD;
+ */
typedef struct {
***************
*** 125,128 ****
--- 152,165 ----
} GEOMETRY;
+
+ typedef struct {
+ char *name;
+ unsigned long val;
+ } SYMDESCR;
+
+
+
+ /*
+
C_LINKAGE_BEGIN
***************
*** 169,172 ****
--- 206,211 ----
C_LINKAGE_END
+ */
+
extern XSetWindowAttributes SWA;
extern XWindowChanges WC;
***************
*** 181,187 ****
--- 220,229 ----
extern Set_Attr_Size, Conf_Size, GC_Size, Geometry_Size, Win_Attr_Size,
Font_Info_Size, Char_Info_Size, Wm_Hints_Size, Size_Hints_Size;
+
+ /*
extern RECORD Set_Attr_Rec[], Conf_Rec[], GC_Rec[], Geometry_Rec[],
Win_Attr_Rec[], Font_Info_Rec[], Char_Info_Rec[], Wm_Hints_Rec[],
Size_Hints_Rec[];
+ */
extern SYMDESCR Func_Syms[], Bit_Grav_Syms[], Event_Syms[], Error_Syms[],
***************
*** 198,287 ****
extern s48_value Sym_None, Sym_Now, Sym_Char_Info, Sym_Conf;
-
- #if __STDC__ || defined(ANSI_CPP)
- # define conc(a,b) a##b
- # define conc3(a,b,c) a##b##c
- #else
- # define _identity(x) x
- # define conc(a,b) _identity(a)b
- # define conc3(a,b,c) conc(conc(a,b),c)
- #endif
-
-
- /* Generic_Predicate (Pixmap) generates:
- *
- * int T_Pixmap;
- *
- * static s48_value P_Pixmapp (x) s48_value x; {
- * return TYPE(x) == T_Pixmap ? S48_TRUE : S48_FALSE;
- * }
- */
- #define Generic_Predicate(type) int conc(T_,type);\
- \
- static s48_value conc3(P_,type,p) (x) s48_value x; {\
- return TYPE(x) == conc(T_,type) ? S48_TRUE : S48_FALSE;\
- }
-
- /* Generic_Equal (Pixmap, PIXMAP, pm) generates:
- *
- * static Pixmap_Equal (x, y) s48_value x, y; {
- * return PIXMAP(x)->pm == PIXMAP(y)->field
- * && !PIXMAP(x)->free && !PIXMAP(y)->free;
- * }
- */
- #define Generic_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
- s48_value x, y; {\
- return cast(x)->field == cast(y)->field\
- && !cast(x)->free && !cast(y)->free;\
- }
-
- /* Same as above, but doesn't check for ->free:
- */
- #define Generic_Simple_Equal(type,cast,field) static conc(type,_Equal) (x, y)\
- s48_value x, y; {\
- return cast(x)->field == cast(y)->field;\
- }
-
- /* Same as above, but also checks ->dpy
- */
- #define Generic_Equal_Dpy(type,cast,field) static conc(type,_Equal)\
- (x, y)\
- s48_value x, y; {\
- return cast(x)->field == cast(y)->field && cast(x)->dpy == cast(y)->dpy\
- && !cast(x)->free && !cast(y)->free;\
- }
-
- /* Generic_Print (Pixmap, "#[pixmap %u]", PIXMAP(x)->pm) generates:
- *
- * static Pixmap_Print (x, port, raw, depth, len) s48_value x, port; {
- * Printf (port, "#[pixmap %u]", PIXMAP(x)->pm);
- * }
- */
- #define Generic_Print(type,fmt,how) static conc(type,_Print)\
- (x, port, raw, depth, len) s48_value x, port; {\
- Printf (port, fmt, (unsigned)how);\
- }
-
- /* Generic_Define (Pixmap, "pixmap", "pixmap?") generates:
- *
- * T_Pixmap = Define_Type (0, "pixmap", NOFUNC, sizeof (struct S_Pixmap),
- * Pixmap_Equal, Pixmap_Equal, Pixmap_Print, NOFUNC);
- * Define_Primitive (P_Pixmapp, "pixmap?", 1, 1, EVAL);
- */
- #define Generic_Define(type,name,pred) conc(T_,type) =\
- Define_Type (0, name, NOFUNC, sizeof (struct conc(S_,type)),\
- conc(type,_Equal), conc(type,_Equal), conc(type,_Print), NOFUNC);\
- Define_Primitive (conc3(P_,type,p), pred, 1, 1, EVAL);
-
- /* Generic_Get_Display (Pixmap, PIXMAP) generates:
- *
- * static s48_value P_Pixmap_Display (x) s48_value x; {
- * Check_Type (x, T_Pixmap);
- * return Make_Display (PIXMAP(x)->dpy);
- * }
- */
- #define Generic_Get_Display(type,cast) static s48_value
conc3(P_,type,_Display)\
- (x) s48_value x; {\
- Check_Type (x, conc(T_,type));\
- return Make_Display (0, cast(x)->dpy);\
- }
--- 240,241 ----
|