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

Major changes. The first window showed up!

This commit is contained in:
frese 2001-06-11 15:25:39 +00:00
parent 54bc366be8
commit 36f9d36db5
9 changed files with 564 additions and 496 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
c/xlib/color.c
View File

@ -1,78 +1,55 @@
#include "xlib.h"
#include "scheme48.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;
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;
}
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;
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;
}
XColor *Get_Color (c) s48_value c; {
Check_Type (c, T_Color);
return &COLOR(c)->c;
s48_value Extract_RGB_Values(s48_value Xcolor) {
XColor* col = EXTRACT_COLOR(Xcolor);
return Int_Extract_RGB_Values(*col);
}
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);
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);
}
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));
}
/*
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);
static s48_value P_Color_Rgb_Values (c) s48_value c; {
s48_value ret, t, x;
S48_DECLARE_GC_PROTECT(3);
long l = S48_VECTOR_LENGTH(Xpixels);
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;
register XColor *p;
@ -100,30 +77,32 @@ static s48_value P_Query_Colors (cmap, v) s48_value cmap, v; {
return ret;
}
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;
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;
}
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);
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);
}

119
c/xlib/colormap.c
View File

@ -1,88 +1,53 @@
#include "xlib.h"
#include "scheme48.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;
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;
}
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;
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;
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);
r = XAllocColor (dpy, cm, cp);
if (!r) return S48_FALSE;
else return ENTER_PIXEL(cp->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);
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;
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;
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;
}
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);
void s48_init_colormap(void) {
S48_EXPORT_FUNCTION(Free_Colormap);
S48_EXPORT_FUNCTION(Alloc_Color);
S48_EXPORT_FUNCTION(Alloc_Named_Color);
}

85
c/xlib/display.c
View File

@ -1,21 +1,22 @@
#include "xlib.h"
#include "scheme48.h"
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;
Display* dpy;
if (!S48_FALSE_P(name))
cname = s48_extract_string(name);
res = XOpenDisplay(cname);
return s48_enter_fixnum(res);
dpy = XOpenDisplay(cname);
return s48_enter_integer((long)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);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XCloseDisplay(dpy);
return S48_UNSPECIFIC;
}
@ -23,54 +24,54 @@ s48_value Close_Display(s48_value Xdisplay) {
// 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);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Window wnd = DefaultRootWindow(dpy);
return s48_enter_integer((long)wnd);
return ENTER_WINDOW(wnd);
}
s48_value Display_Default_Colormap(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Colormap cmp = DefaultColormap(dpy, DefaultScreen(dpy));
return s48_enter_integer((long)cmp);
return ENTER_COLORMAP(cmp);
}
s48_value Display_Default_Gcontext(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
GC gc = DefaultGC(dpy, DefaultScreen(dpy));
return s48_enter_integer((long)gc);
return ENTER_GC(gc);
}
s48_value Display_Default_Depth(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int depth = DefaultDepth(dpy, DefaultScreen(dpy));
return s48_enter_integer(depth);
}
s48_value Display_Default_Screen_Number(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DefaultScreen(dpy));
}
s48_value Display_Cells(s48_value Xdisplay, s48_value ScrNum) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int num = (int)s48_extract_integer(ScrNum);
return s48_enter_integer(DisplayCells(dpy, num));
}
s48_value Display_Planes(s48_value Xdisplay, s48_value ScrNum) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int num = (int)s48_extract_integer(ScrNum);
return s48_enter_integer(DisplayPlanes(dpy, num));
}
s48_value Display_String(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
char* s = DisplayString(dpy);
return s48_enter_string(s);
}
s48_value Display_Vendor(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
char* s = ServerVendor(dpy);
int i = VendorRelease(dpy);
return s48_cons( s48_enter_string(s),
@ -78,7 +79,7 @@ s48_value Display_Vendor(s48_value Xdisplay) {
}
s48_value Display_Protocol_Version(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int maj = ProtocolVersion(dpy);
int min = ProtocolRevision(dpy);
return s48_cons( s48_enter_integer(maj),
@ -86,80 +87,80 @@ s48_value Display_Protocol_Version(s48_value Xdisplay) {
}
s48_value Display_Screen_Count(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int cnt = ScreenCount(dpy);
return s48_enter_integer(cnt);
}
s48_value Display_Image_Byte_Order(s48_value d) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
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 );
}
s48_value Display_Bitmap_Unit(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(BitmapUnit(dpy));
}
s48_value Display_Bitmap_Bit_Order(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return Bits_To_Symbols( (unsigned long)BitmapBitOrder(dpy),
0, Byte_Order_Syms );
}
s48_value Display_Bitmap_Pad(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(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));
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DisplayWidth(dpy, DefaultScreen(dpy)));
}
s48_value Display_Height(s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DisplayHeight(dpy, DefaultScreen(dpy)));
}
s48_value Display_Width_Mm (s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(DisplayWidthMM(dpy, DefaultScreen(dpy)));
}
s48_value Display_Height_Mm (s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(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 = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return s48_enter_integer(XDisplayMotionBufferSize(dpy));
}
s48_value Display_Flush_Output (s48_value Xdisplay); {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
s48_value Display_Flush_Output (s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XFlush (dpy);
return S48_UNSPECIFIC;
}
s48_value Display_Wait_Output (s48_value Xdisplay, s48_value discard) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(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);
s48_value No_Op (s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XNoOp(dpy);
return S48_UNSPECIFIC;
}
s48_value List_Depths (s48_value Xdisplay, s48_value scr) {
S48_DECLARE_GC_PROTECT(1);
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int i, num;
int* p;
s48_value ret;
@ -175,12 +176,12 @@ s48_value List_Depths (s48_value Xdisplay, s48_value scr) {
XFree((char *)p);
}
S48_GC_UNPROTECT;
S48_GC_UNPROTECT();
return ret;
}
s48_value List_Pixmap_Formats (s48_value Xdisplay) {
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
S48_DECLARE_GC_PROTECT(2);
int num, i;
@ -188,7 +189,7 @@ s48_value List_Pixmap_Formats (s48_value Xdisplay) {
s48_value ret, t;
S48_GC_PROTECT_2(ret, t);
p = XListPixmapFormats(dpy, %num);
p = XListPixmapFormats(dpy, &num);
if (!p) ret = S48_FALSE;
else {
@ -196,14 +197,14 @@ s48_value List_Pixmap_Formats (s48_value Xdisplay) {
for (i = 0; i < num; i++) {
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_cons(s48_enter_integer(p[i].scanline_pad),
S48_NULL)));
S48_VECTOR_SET(ret, i, t);
}
XFree ((char *)p);
}
S48_GC_UNPROTECT;
S48_GC_UNPROTECT();
return ret;
}
@ -227,13 +228,13 @@ void s48_init_display(void) {
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_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_Flush_Output);
S48_EXPORT_FUNCTION(Display_Wait_Output);
S48_EXPORT_FUNCTION(No_Op);
S48_EXPORT_FUNCTION(List_Depths);

23
c/xlib/main.c Normal file
View File

@ -0,0 +1,23 @@
#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);
}

51
c/xlib/pixel.c
View File

@ -1,48 +1,17 @@
#include "xlib.h"
#include "scheme48.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;
s48_value Black_Pixel(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return ENTER_PIXEL( BlackPixel(dpy, DefaultScreen(dpy)) );
}
unsigned long Get_Pixel (p) s48_value p; {
Check_Type (p, T_Pixel);
return PIXEL(p)->pix;
s48_value White_Pixel(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
return ENTER_PIXEL( WhitePixel(dpy, DefaultScreen(dpy)) );
}
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);
void s48_init_pixel(void) {
S48_EXPORT_FUNCTION(Black_Pixel);
S48_EXPORT_FUNCTION(White_Pixel);
}

BIN
c/xlib/test Executable file
View File

Binary file not shown.

71
c/xlib/type.c
View File

@ -1,17 +1,38 @@
#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:
*/
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;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(res);
while (table[i].name != (char*)0) {
name = table[i].name;
val = table[i].val;
@ -33,10 +54,32 @@ s48_value Bits_To_Symbols(unsigned long bits, int mask_flag, SYMDESCR* table) {
return res;
}
typedef struct {
char *name;
unsigned long val;
} SYMDESCR;
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[] = {
{ "clear", GXclear },
@ -317,7 +360,7 @@ SYMDESCR Shape_Syms[] = {
};
SYMDESCR Initial_State_Syms[] = {
{ "dont-care", DontS48_CAReState },
{ "dont-care", DontCareState },
{ "normal", NormalState },
{ "zoom", ZoomState },
{ "iconic", IconicState },
@ -407,7 +450,7 @@ SYMDESCR Error_Syms[] = {
Other things
*************************************************************************/
/*
static s48_value Set_Attr_Slots;
@ -714,7 +757,7 @@ unsigned long Vector_To_Record (v, len, sym, rp) s48_value v, sym;
*(Pixmap *)rp->slot = CopyFromParent;
break;
}
/* fall through */
// fall through
case T_PIXMAP:
*(Pixmap *)rp->slot = Get_Pixmap (*p); break;
case T_BOOL:
@ -846,3 +889,11 @@ elk_init_xlib_type () {
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);
}

426
c/xlib/window.c
View File

@ -1,42 +1,264 @@
#include "xlib.h"
#include "scheme48.h"
static s48_value Sym_Set_Attr, Sym_Get_Attr, Sym_Geo;
s48_value Sym_Conf;
static s48_value window_record_type_binding = S48_FALSE;
Generic_Predicate (Window)
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;
}
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;
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);
}
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;
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; {
@ -48,106 +270,21 @@ Drawable Get_Drawable (d, dpyp) s48_value d; Display **dpyp; {
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);
//NOTREACHED
}
static s48_value P_Get_Geometry (d) s48_value d; {
Display *dpy;
Drawable dr = Get_Drawable (d, &dpy);
/* GEO.width, GEO.height, etc. should really be unsigned, not int.
*/
// 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,
(unsigned *)&GEO.depth);
return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L);
}
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;
@ -230,33 +367,22 @@ static s48_value P_Query_Pointer (win) s48_value win; {
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);
*/
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);
}

136
c/xlib/xlib.h
View File

@ -2,8 +2,8 @@
#include <X11/Xlib.h>
#include <X11/Xutil.h>
#undef S48_TRUE
#undef S48_FALSE
//#undef S48_TRUE
//#undef S48_FALSE
#ifndef NeedFunctionPrototypes /* Kludge */
#error "X11 Release 3 (or earlier) no longer supported"
@ -17,8 +17,31 @@
# define XLIB_RELEASE_6_OR_LATER
#endif
#include "scheme.h"
#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;
extern int T_Pixel;
@ -111,6 +134,9 @@ enum Type {
T_WINDOW, T_MASK, T_SYM, T_SHORT, T_BACKGROUND, T_BORDER
};
*/
/*
typedef struct {
char *slot;
char *name;
@ -118,12 +144,23 @@ typedef struct {
SYMDESCR *syms;
int mask;
} RECORD;
*/
typedef struct {
Window root;
int x, y, width, height, border_width, depth;
} GEOMETRY;
typedef struct {
char *name;
unsigned long val;
} SYMDESCR;
/*
C_LINKAGE_BEGIN
extern Colormap Get_Colormap P_((Object));
@ -168,6 +205,8 @@ extern unsigned long Vector_To_Record P_((Object, int, Object, RECORD*));
C_LINKAGE_END
*/
extern XSetWindowAttributes SWA;
extern XWindowChanges WC;
extern XGCValues GCV;
@ -180,9 +219,12 @@ extern XSizeHints SZH;
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[],
Grav_Syms[], Backing_Store_Syms[], Class_Syms[], Stack_Mode_Syms[],
@ -197,91 +239,3 @@ extern SYMDESCR Func_Syms[], Bit_Grav_Syms[], Event_Syms[], Error_Syms[],
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);\
}