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

some changes, cleaned up, debuged and tested.

This commit is contained in:
frese 2001-06-27 13:44:48 +00:00
parent 45ffe04e5f
commit 8e54e23d26
10 changed files with 453 additions and 412 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
c/xlib/Makefile Normal file
View File

@ -0,0 +1,9 @@
.c.o:
gcc -g -c -I /usr/X11R6/include/ -I /afs/wsi/home/dfreese/scsh-0.6/c/ -o $@ $<
OBJECTS = main.o display.o window.o type.o color.o colormap.o pixel.o gcontext.o
test: $(OBJECTS)
gcc -g -o test -L /afs/wsi/home/dfreese/i386_fbsd43/scsh-0.6/lib/scsh/ \
-L /usr/X11R6/lib \
$(OBJECTS) -lscsh -lm -lX11 -lcrypt

65
c/xlib/color.c
View File

@ -25,72 +25,53 @@ s48_value Int_Extract_RGB_Values(XColor col) {
} }
s48_value Extract_RGB_Values(s48_value Xcolor) { s48_value Extract_RGB_Values(s48_value Xcolor) {
XColor* col = EXTRACT_COLOR(Xcolor); return Int_Extract_RGB_Values(*EXTRACT_COLOR(Xcolor));
return Int_Extract_RGB_Values(*col);
} }
s48_value Query_Color (s48_value Xcolormap, s48_value Xpixel, s48_value Query_Color (s48_value Xcolormap, s48_value Xpixel,
s48_value Xdisplay) { s48_value Xdisplay) {
XColor c; XColor c;
Colormap cm = EXTRACT_COLORMAP(Xcolormap);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
c.pixel = EXTRACT_PIXEL(Xpixel); c.pixel = EXTRACT_PIXEL(Xpixel);
XQueryColor(dpy, cm, &c); XQueryColor(EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap), &c);
return Int_Extract_RGB_Values(c); return Int_Extract_RGB_Values(c);
} }
/*
s48_value Query_Colors(s48_value Xcolormap, s48_value Xpixels, s48_value Query_Colors(s48_value Xcolormap, s48_value Xpixels,
s48_value Xdisplay) { s48_value Xdisplay) {
Colormap* cm = (Colormap*)S48_EXTRACT_VALUE_POINTER(Xcolormap, Colormap); s48_value result;
Display* dpy = (Display*)s48_extract_integer(Xdisplay);
long l = S48_VECTOR_LENGTH(Xpixels);
register i, n;
s48_value ret;
register XColor *p;
S48_DECLARE_GC_PROTECT(1); S48_DECLARE_GC_PROTECT(1);
Alloca_Begin;
Check_Type (v, T_Vector); long n = S48_VECTOR_LENGTH(Xpixels);
n = S48_VECTOR_LENGTH(v); XColor p[n];
Alloca (p, XColor*, n * sizeof (XColor)); int i;
for (i = 0; i < n; i++)
p[i].pixel = Get_Pixel (VECTOR(v)->data[i]);
Disable_Interrupts;
XQueryColors (COLORMAP(cmap)->dpy, cm, p, n);
Enable_Interrupts;
ret = s48_make_vector (n, S48_NULL);
S48_GC_PROTECT_1 (ret);
for (i = 0; i < n; i++, p++) {
s48_value x;
x = Make_Color (p->red, p->green, p->blue); for (i=0; i < n; i++)
S48_VECTOR_SET(ret, i, x;) p[i].pixel = EXTRACT_PIXEL(S48_VECTOR_REF(Xpixels, i));
}
S48_GC_UNPROTECT; XQueryColors( EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap), p, n );
Alloca_End;
return ret; S48_GC_PROTECT_1(result);
result = s48_make_vector(n, S48_FALSE);
for (i=0; i < n; i++)
S48_VECTOR_SET(result, i, Int_Extract_RGB_Values(p[i]));
S48_GC_UNPROTECT();
return result;
} }
*/
s48_value Lookup_Color(s48_value Xcolormap, s48_value Xdisplay, s48_value Lookup_Color(s48_value Xcolormap, s48_value Xdisplay,
s48_value color_name) { s48_value color_name) {
XColor visual, exact; XColor visual, exact;
Colormap cm = EXTRACT_COLORMAP(Xcolormap);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
s48_value res = S48_FALSE; s48_value res = S48_FALSE;
S48_DECLARE_GC_PROTECT(1); S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(res);
if (XLookupColor( dpy, cm, s48_extract_string(color_name), if (XLookupColor( EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap),
&visual, &exact )) { s48_extract_string(color_name), &visual, &exact )) {
S48_GC_PROTECT_1(res);
res = s48_cons( Int_Extract_RGB_Values( visual ), res = s48_cons( Int_Extract_RGB_Values( visual ),
Int_Extract_RGB_Values( exact ) ); Int_Extract_RGB_Values( exact ) );
} }
@ -103,6 +84,6 @@ void s48_init_color(void) {
S48_EXPORT_FUNCTION(Create_Color); S48_EXPORT_FUNCTION(Create_Color);
S48_EXPORT_FUNCTION(Extract_RGB_Values); S48_EXPORT_FUNCTION(Extract_RGB_Values);
S48_EXPORT_FUNCTION(Query_Color); S48_EXPORT_FUNCTION(Query_Color);
// S48_EXPORT_FUNCTION(Query_Colors); S48_EXPORT_FUNCTION(Query_Colors);
S48_EXPORT_FUNCTION(Lookup_Color); S48_EXPORT_FUNCTION(Lookup_Color);
} }

25
c/xlib/colormap.c
View File

@ -2,44 +2,39 @@
#include "scheme48.h" #include "scheme48.h"
s48_value Free_Colormap (s48_value Xcolormap, s48_value Xdisplay) { s48_value Free_Colormap (s48_value Xcolormap, s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XFreeColormap(EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap));
Colormap cm = EXTRACT_COLORMAP(Xcolormap);
XFreeColormap(dpy, cm);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Alloc_Color(s48_value Xcolormap, s48_value Xcolor, s48_value Alloc_Color(s48_value Xcolormap, s48_value Xcolor,
s48_value Xdisplay) { s48_value Xdisplay) {
XColor* cp = EXTRACT_COLOR(Xcolor); XColor* cp = EXTRACT_COLOR(Xcolor);
Colormap cm = EXTRACT_COLORMAP(Xcolormap);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int r;
r = XAllocColor (dpy, cm, cp); if (!XAllocColor(EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap), cp))
return S48_FALSE;
if (!r) return S48_FALSE; else
else return ENTER_PIXEL(cp->pixel); return ENTER_PIXEL(cp->pixel);
} }
s48_value Alloc_Named_Color(s48_value Xcolormap, s48_value color_name, s48_value Alloc_Named_Color(s48_value Xcolormap, s48_value color_name,
s48_value Xdisplay) { s48_value Xdisplay) {
Colormap cm = EXTRACT_COLORMAP(Xcolormap);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
XColor screen, exact; XColor screen, exact;
int r; int r;
s48_value ret; s48_value ret;
S48_DECLARE_GC_PROTECT(1); S48_DECLARE_GC_PROTECT(1);
r = XAllocNamedColor (dpy, cm, s48_extract_string(color_name), r = XAllocNamedColor (EXTRACT_DISPLAY(Xdisplay), EXTRACT_COLORMAP(Xcolormap),
s48_extract_string(color_name),
&screen, &exact); &screen, &exact);
if (!r) return S48_FALSE; if (!r) ret = S48_FALSE;
else {
S48_GC_PROTECT_1(ret); S48_GC_PROTECT_1(ret);
ret = s48_cons(Int_Extract_RGB_Values(exact), S48_NULL); ret = s48_cons(Int_Extract_RGB_Values(exact), S48_NULL);
ret = s48_cons(Int_Extract_RGB_Values(screen), ret); ret = s48_cons(Int_Extract_RGB_Values(screen), ret);
ret = s48_cons(ENTER_PIXEL(screen.pixel), ret); ret = s48_cons(ENTER_PIXEL(screen.pixel), ret);
}
S48_GC_UNPROTECT(); S48_GC_UNPROTECT();
return ret; return ret;

75
c/xlib/display.c
View File

@ -1,31 +1,26 @@
#include "xlib.h" #include "xlib.h"
#include "scheme48.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) // Open_Display(name) name should be a string or S48_FALSE (=> Null)
s48_value Open_Display (s48_value name) { s48_value Open_Display (s48_value name) {
char* cname = (char*)0; char* cname = (char*)0;
Display* dpy;
if (!S48_FALSE_P(name)) if (!S48_FALSE_P(name))
cname = s48_extract_string(name); cname = s48_extract_string(name);
dpy = XOpenDisplay(cname);
return s48_enter_integer((long)dpy); return ENTER_DISPLAY(XOpenDisplay(cname));
} }
// Close_Display( Xdisplay ) Xdisplay should be a pointer to the X-lib struct // Close_Display( Xdisplay ) Xdisplay should be a pointer to the X-lib struct
// cast into a Scheme-Integer. // cast into a Scheme-Integer.
s48_value Close_Display(s48_value Xdisplay) { s48_value Close_Display(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XCloseDisplay(EXTRACT_DISPLAY(Xdisplay));
XCloseDisplay(dpy);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
// The following procedure mainly wrap a corresponding XLib macro without // The following procedure mainly wrap a corresponding XLib macro without
// underscores... // underscores...
s48_value Display_Default_Root_Window(s48_value Xdisplay) { s48_value Display_Default_Root_Window(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); Window wnd = DefaultRootWindow(EXTRACT_DISPLAY(Xdisplay));
Window wnd = DefaultRootWindow(dpy);
return ENTER_WINDOW(wnd); return ENTER_WINDOW(wnd);
} }
@ -38,7 +33,7 @@ s48_value Display_Default_Colormap(s48_value Xdisplay) {
s48_value Display_Default_Gcontext(s48_value Xdisplay) { s48_value Display_Default_Gcontext(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); Display* dpy = EXTRACT_DISPLAY(Xdisplay);
GC gc = DefaultGC(dpy, DefaultScreen(dpy)); GC gc = DefaultGC(dpy, DefaultScreen(dpy));
return ENTER_GC(gc); return ENTER_GCONTEXT(gc);
} }
s48_value Display_Default_Depth(s48_value Xdisplay) { s48_value Display_Default_Depth(s48_value Xdisplay) {
@ -48,25 +43,21 @@ s48_value Display_Default_Depth(s48_value Xdisplay) {
} }
s48_value Display_Default_Screen_Number(s48_value Xdisplay) { s48_value Display_Default_Screen_Number(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); return s48_enter_integer(DefaultScreen(EXTRACT_DISPLAY(Xdisplay)));
return s48_enter_integer(DefaultScreen(dpy));
} }
s48_value Display_Cells(s48_value Xdisplay, s48_value ScrNum) { s48_value Display_Cells(s48_value Xdisplay, s48_value ScrNum) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int num = (int)s48_extract_integer(ScrNum); int num = (int)s48_extract_integer(ScrNum);
return s48_enter_integer(DisplayCells(dpy, num)); return s48_enter_integer(DisplayCells(EXTRACT_DISPLAY(Xdisplay), num));
} }
s48_value Display_Planes(s48_value Xdisplay, s48_value ScrNum) { s48_value Display_Planes(s48_value Xdisplay, s48_value ScrNum) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int num = (int)s48_extract_integer(ScrNum); int num = (int)s48_extract_integer(ScrNum);
return s48_enter_integer(DisplayPlanes(dpy, num)); return s48_enter_integer(DisplayPlanes(EXTRACT_DISPLAY(Xdisplay), num));
} }
s48_value Display_String(s48_value Xdisplay) { s48_value Display_String(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); char* s = DisplayString(EXTRACT_DISPLAY(Xdisplay));
char* s = DisplayString(dpy);
return s48_enter_string(s); return s48_enter_string(s);
} }
@ -87,8 +78,7 @@ Display* dpy = EXTRACT_DISPLAY(Xdisplay);
} }
s48_value Display_Screen_Count(s48_value Xdisplay) { s48_value Display_Screen_Count(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); int cnt = ScreenCount(EXTRACT_DISPLAY(Xdisplay));
int cnt = ScreenCount(dpy);
return s48_enter_integer(cnt); return s48_enter_integer(cnt);
} }
@ -100,8 +90,8 @@ s48_value Display_Image_Byte_Order(s48_value Xdisplay) {
} }
s48_value Display_Bitmap_Unit(s48_value Xdisplay) { s48_value Display_Bitmap_Unit(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); int bu = BitmapUnit(EXTRACT_DISPLAY(Xdisplay));
return s48_enter_integer(BitmapUnit(dpy)); return s48_enter_integer(bu);
} }
s48_value Display_Bitmap_Bit_Order(s48_value Xdisplay) { s48_value Display_Bitmap_Bit_Order(s48_value Xdisplay) {
@ -111,8 +101,8 @@ s48_value Display_Bitmap_Bit_Order(s48_value Xdisplay) {
} }
s48_value Display_Bitmap_Pad(s48_value Xdisplay) { s48_value Display_Bitmap_Pad(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); int bp = BitmapPad(EXTRACT_DISPLAY(Xdisplay));
return s48_enter_integer(BitmapPad(dpy)); return s48_enter_integer(bp);
} }
s48_value Display_Width(s48_value Xdisplay) { s48_value Display_Width(s48_value Xdisplay) {
@ -136,40 +126,36 @@ s48_value Display_Height_Mm (s48_value Xdisplay) {
} }
s48_value Display_Motion_Buffer_Size(s48_value Xdisplay) { s48_value Display_Motion_Buffer_Size(s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); int mbs = XDisplayMotionBufferSize(EXTRACT_DISPLAY(Xdisplay));
return s48_enter_integer(XDisplayMotionBufferSize(dpy)); return s48_enter_integer(mbs);
} }
s48_value Display_Flush_Output (s48_value Xdisplay) { s48_value Display_Flush_Output (s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XFlush (EXTRACT_DISPLAY(Xdisplay));
XFlush (dpy);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Display_Wait_Output (s48_value Xdisplay, s48_value discard) { s48_value Display_Wait_Output (s48_value Xdisplay, s48_value discard) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XSync (EXTRACT_DISPLAY(Xdisplay), !S48_FALSE_P(discard));
XSync (dpy, !S48_FALSE_P(discard));
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value No_Op (s48_value Xdisplay) { s48_value No_Op (s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XNoOp(EXTRACT_DISPLAY(Xdisplay));
XNoOp(dpy);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value List_Depths (s48_value Xdisplay, s48_value scr) { s48_value List_Depths (s48_value Xdisplay, s48_value scr) {
S48_DECLARE_GC_PROTECT(1);
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
int i, num; int i, num;
int* p; int* p;
s48_value ret; s48_value ret;
S48_GC_PROTECT_1(ret); S48_DECLARE_GC_PROTECT(1);
p = XListDepths(dpy, s48_extract_integer(scr), &num); p = XListDepths(EXTRACT_DISPLAY(Xdisplay), s48_extract_integer(scr), &num);
if (!p) if (!p)
ret = S48_FALSE; ret = S48_FALSE;
else { else {
S48_GC_PROTECT_1(ret);
ret = s48_make_vector(num, S48_NULL); ret = s48_make_vector(num, S48_NULL);
for (i = 0; i < num; i++) for (i = 0; i < num; i++)
S48_VECTOR_SET(ret, i, s48_enter_integer(p[i])); S48_VECTOR_SET(ret, i, s48_enter_integer(p[i]));
@ -181,19 +167,18 @@ s48_value List_Depths (s48_value Xdisplay, s48_value scr) {
} }
s48_value List_Pixmap_Formats (s48_value Xdisplay) { s48_value List_Pixmap_Formats (s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
S48_DECLARE_GC_PROTECT(2);
int num, i; int num, i;
XPixmapFormatValues* p; XPixmapFormatValues* p;
s48_value ret, t; s48_value ret, t;
S48_GC_PROTECT_2(ret, t); S48_DECLARE_GC_PROTECT(2);
p = XListPixmapFormats(dpy, &num); p = XListPixmapFormats(EXTRACT_DISPLAY(Xdisplay), &num);
if (!p) ret = S48_FALSE; if (!p)
ret = S48_FALSE;
else { else {
ret = s48_make_vector (num, S48_NULL); S48_GC_PROTECT_2(ret, t);
ret = s48_make_vector (num, S48_FALSE);
for (i = 0; i < num; i++) { for (i = 0; i < num; i++) {
t = s48_cons(s48_enter_integer(p[i].depth), 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].bits_per_pixel),
@ -209,9 +194,6 @@ s48_value List_Pixmap_Formats (s48_value Xdisplay) {
} }
void s48_init_display(void) { 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(Open_Display);
S48_EXPORT_FUNCTION(Close_Display); S48_EXPORT_FUNCTION(Close_Display);
S48_EXPORT_FUNCTION(Display_Default_Root_Window); S48_EXPORT_FUNCTION(Display_Default_Root_Window);
@ -239,5 +221,4 @@ void s48_init_display(void) {
S48_EXPORT_FUNCTION(No_Op); S48_EXPORT_FUNCTION(No_Op);
S48_EXPORT_FUNCTION(List_Depths); S48_EXPORT_FUNCTION(List_Depths);
S48_EXPORT_FUNCTION(List_Pixmap_Formats); S48_EXPORT_FUNCTION(List_Pixmap_Formats);
} }

361
c/xlib/gcontext.c
View File

@ -1,130 +1,113 @@
#include "xlib.h" #include "xlib.h"
#include "scheme48.h"
static s48_value Sym_Gc; unsigned long AList_To_GCValues(s48_value alist, XGCValues* GCV) {
Generic_Predicate (Gc)
Generic_Equal_Dpy (Gc, GCONTEXT, gc)
Generic_Print (Gc, "#[gcontext %lu]", GCONTEXT(x)->gc)
Generic_Get_Display (Gc, GCONTEXT)
s48_value Make_Gc (finalize, dpy, g) Display *dpy; GC g; {
s48_value gc;
if (g == None)
return Sym_None;
gc = Find_Object (T_Gc, (GENERIC)dpy, Match_X_Obj, g);
if (S48_NULL_P (gc)) {
gc = Alloc_Object (sizeof (struct S_Gc), T_Gc, 0);
GCONTEXT(gc)->tag = S48_NULL;
GCONTEXT(gc)->gc = g;
GCONTEXT(gc)->dpy = dpy;
GCONTEXT(gc)->free = 0;
Register_Object (gc, (GENERIC)dpy, finalize ? P_Free_Gc :
(PFO)0, 0);
}
return gc;
}
static s48_value P_Create_Gc (w, g) s48_value w, g; {
unsigned long mask; unsigned long mask;
Display *dpy; s48_value l;
Drawable dr; char* cname;
s48_value name, value;
dr = Get_Drawable (w, &dpy); for (l = alist; !S48_NULL_P(l); l = S48_CDR(l)) {
mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec); name = S48_CAR(l);
return Make_Gc (1, dpy, XCreateGC (dpy, dr, mask, &GCV)); value = S48_CDR(l);
} cname = s48_extract_string(S48_SYMBOL_TO_STRING(name));
static s48_value P_Copy_Gc (gc, w) s48_value gc, w; { if (cname == "function") {
GC dst; GCV->function = Symbols_To_Bits(value, 0, Func_Syms);
Display *dpy; mask |= GCFunction;
Drawable dr; } else if (cname == "plane-mask") {
GCV->plane_mask = EXTRACT_PIXEL(value);
Check_Type (gc, T_Gc); mask |= GCPlaneMask;
dr = Get_Drawable (w, &dpy); } else if (cname == "foreground") {
dst = XCreateGC (dpy, dr, 0L, &GCV); GCV->foreground = EXTRACT_PIXEL(value);
XCopyGC (dpy, GCONTEXT(gc)->gc, ~0L, dst); mask |= GCForeground;
return Make_Gc (1, dpy, dst); } else if (cname == "background") {
} GCV->background = EXTRACT_PIXEL(value);
mask |= GCBackground;
static s48_value P_Change_Gc (gc, g) s48_value gc, g; { } else if (cname == "line-width") {
unsigned long mask; GCV->line_width = s48_extract_integer(value);
mask |= GCLineWidth;
Check_Type (gc, T_Gc); } else if (cname == "line-style") {
mask = Vector_To_Record (g, GC_Size, Sym_Gc, GC_Rec); GCV->line_style = Symbol_To_Bit(value,Line_Style_Syms);
XChangeGC (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV); mask |= GCLineStyle;
return Void; } else if (cname == "cap-style") {
} GCV->cap_style = Symbol_To_Bit(value, Cap_Style_Syms);
mask |= GCCapStyle;
s48_value P_Free_Gc (g) s48_value g; { } else if (cname == "join-style") {
Check_Type (g, T_Gc); GCV->join_style = Symbol_To_Bit(value, Join_Style_Syms);
if (!GCONTEXT(g)->free) mask |= GCJoinStyle;
XFreeGC (GCONTEXT(g)->dpy, GCONTEXT(g)->gc); } else if (cname == "fill-style") {
Deregister_Object (g); GCV->fill_style = Symbol_To_Bit(value, Fill_Style_Syms);
GCONTEXT(g)->free = 1; mask |= GCFillStyle;
return Void; } else if (cname == "fill-rule") {
} GCV->fill_rule = Symbol_To_Bit(value, Fill_Rule_Syms);
mask |= GCFillRule;
static s48_value P_Query_Best_Size (d, w, h, shape) s48_value d, w, h, shape; { } else if (cname == "arc-mode") {
unsigned int rw, rh; GCV->arc_mode = Symbol_To_Bit(value, Arc_Mode_Syms);
mask |= GCArcMode;
Check_Type (d, T_Display); } else if (cname == "tile") {
if (!XQueryBestSize (DISPLAY(d)->dpy, Symbols_To_Bits (shape, 0, GCV->tile = EXTRACT_PIXMAP(value);
Shape_Syms), DefaultRootWindow (DISPLAY(d)->dpy), mask |= GCTile;
(int)s48_extract_integer (w), (int)s48_extract_integer (h), &rw, &rh)) } else if (cname == "stipple") {
Primitive_Error ("cannot query best shape"); GCV->stipple = EXTRACT_PIXMAP(value);
return s48_cons (s48_enter_integer (rw), s48_enter_integer (rh)); mask |= GCStipple;
} } else if (cname == "ts-x") {
GCV->ts_x_origin = s48_extract_integer(value);
static s48_value P_Set_Gcontext_Clip_Rectangles (gc, x, y, v, ord) mask |= GCTileStipXOrigin;
s48_value gc, x, y, v, ord; { } else if (cname == "ts-y") {
register XRectangle *p; GCV->ts_y_origin = s48_extract_integer(value);
register i, n; mask |= GCTileStipYOrigin;
Alloca_Begin; } else if (cname == "font") {
GCV->font = EXTRACT_FONT(value);
Check_Type (gc, T_Gc); mask |= GCFont;
Check_Type (v, T_Vector); } else if (cname == "subwindow-mode") {
n = S48_VECTOR_LENGTH(v); GCV->subwindow_mode = Symbol_To_Bit(value, Subwin_Mode_Syms);
Alloca (p, XRectangle*, n * sizeof (XRectangle)); mask |= GCSubwindowMode;
for (i = 0; i < n; i++) { } else if (cname == "exposures") {
s48_value rect; GCV->graphics_exposures = !S48_FALSE_P(value);
mask |= GCGraphicsExposures;
rect = S48_VECTOR_REF(v, i); } else if (cname == "clip-x") {
Check_Type (rect, T_Pair); GCV->clip_x_origin = s48_extract_integer(value);
if (Fast_Length (rect) != 4) mask |= GCClipXOrigin;
Primitive_Error ("invalid rectangle: ~s", rect); } else if (cname == "clip-y") {
p[i].x = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect); GCV->clip_y_origin = s48_extract_integer(value);
p[i].y = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect); mask |= GCClipYOrigin;
p[i].width = (int)s48_extract_integer (S48_CAR (rect)); rect = S48_CDR (rect); } else if (cname == "clip-mask") {
p[i].height = (int)s48_extract_integer (S48_CAR (rect)); GCV->clip_mask = EXTRACT_PIXMAP(value);
mask |= GCClipMask;
} else if (cname == "dash-offset") {
GCV->dash_offset = s48_extract_integer(value);
mask |= GCDashOffset;
} else if (cname == "dashes") {
GCV->dashes = (char)s48_extract_integer(value);
mask |= GCDashList;
} }
XSetClipRectangles (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, (int)s48_extract_integer (x), // else error ??
(int)s48_extract_integer (y), p, n, Symbols_To_Bits (ord, 0, Ordering_Syms)); } // for
Alloca_End;
return Void; return mask;
} }
static s48_value P_Set_Gcontext_Dashlist (gc, off, v) s48_value gc, off, v; { s48_value Create_Gc(s48_value Xdisplay, s48_value Xdrawable, s48_value args) {
register char *p; XGCValues GCV;
register i, n, d; unsigned long mask = AList_To_GCValues(args, &GCV);
Alloca_Begin;
Check_Type (gc, T_Gc); GC Xgcontext = XCreateGC(EXTRACT_DISPLAY(Xdisplay),
Check_Type (v, T_Vector); EXTRACT_DRAWABLE(Xdrawable),
n = S48_VECTOR_LENGTH(v); mask, &GCV);
Alloca (p, char*, n);
for (i = 0; i < n; i++) { return ENTER_GCONTEXT(Xgcontext);
d = (int)s48_extract_integer (VECTOR(v)->data[i]); }
if (d < 0 || d > 255)
Range_Error (VECTOR(v)->data[i]); s48_value Copy_Gc(s48_value Xdisplay, s48_value Xsource, s48_value Xdest) {
p[i] = d; XCopyGC(EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xsource),
} ~0L, EXTRACT_GCONTEXT(Xdest));
XSetDashes (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, (int)s48_extract_integer (off), p, n); return S48_UNSPECIFIC;
Alloca_End; }
return Void;
s48_value Free_Gc(s48_value Xgcontext, s48_value Xdisplay) {
XFreeGC(EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xgcontext));
return S48_UNSPECIFIC;
} }
#define ValidGCValuesBits \ #define ValidGCValuesBits \
@ -134,29 +117,129 @@ static s48_value P_Set_Gcontext_Dashlist (gc, off, v) s48_value gc, off, v; {
GCSubwindowMode | GCGraphicsExposures | GCClipXOrigin | GCClipYOrigin |\ GCSubwindowMode | GCGraphicsExposures | GCClipXOrigin | GCClipYOrigin |\
GCDashOffset | GCArcMode) GCDashOffset | GCArcMode)
static s48_value P_Get_Gc_Values (gc) s48_value gc; { s48_value Get_Gc_Values (s48_value Xgcontext, s48_value Xdisplay) {
unsigned long mask = ValidGCValuesBits; unsigned long mask = ValidGCValuesBits;
Check_Type (gc, T_Gc); XGCValues GCV;
if (!XGetGCValues (GCONTEXT(gc)->dpy, GCONTEXT(gc)->gc, mask, &GCV)) s48_value res;
Primitive_Error ("cannot get gcontext values"); S48_DECLARE_GC_PROTECT(1);
return Record_To_Vector (GC_Rec, GC_Size, Sym_Gc, GCONTEXT(gc)->dpy,
mask); if (!XGetGCValues (EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xgcontext),
mask, &GCV))
res = S48_FALSE;
else {
res = s48_make_vector(23, S48_FALSE);
S48_GC_PROTECT_1(res);
S48_VECTOR_SET(res, 0, s48_enter_integer(GCV.function));
S48_VECTOR_SET(res, 1, ENTER_PIXEL(GCV.plane_mask));
S48_VECTOR_SET(res, 2, ENTER_PIXEL(GCV.foreground));
S48_VECTOR_SET(res, 3, ENTER_PIXEL(GCV.background));
S48_VECTOR_SET(res, 4, s48_enter_integer(GCV.line_width));
S48_VECTOR_SET(res, 5, Bit_To_Symbol(GCV.line_style, Line_Style_Syms));
S48_VECTOR_SET(res, 6, Bit_To_Symbol(GCV.cap_style, Cap_Style_Syms));
S48_VECTOR_SET(res, 7, Bit_To_Symbol(GCV.join_style, Join_Style_Syms));
S48_VECTOR_SET(res, 8, Bit_To_Symbol(GCV.fill_style, Fill_Style_Syms));
S48_VECTOR_SET(res, 9, Bit_To_Symbol(GCV.fill_rule, Fill_Rule_Syms));
S48_VECTOR_SET(res, 10, Bit_To_Symbol(GCV.arc_mode, Arc_Mode_Syms));
S48_VECTOR_SET(res, 11, ENTER_PIXMAP(GCV.tile));
S48_VECTOR_SET(res, 12, ENTER_PIXMAP(GCV.stipple));
S48_VECTOR_SET(res, 13, s48_enter_integer(GCV.ts_x_origin));
S48_VECTOR_SET(res, 14, s48_enter_integer(GCV.ts_y_origin));
S48_VECTOR_SET(res, 15, ENTER_FONT(GCV.font));
S48_VECTOR_SET(res, 16, Bit_To_Symbol(GCV.subwindow_mode,
Subwin_Mode_Syms));
S48_VECTOR_SET(res, 17, GCV.graphics_exposures ? S48_TRUE : S48_FALSE);
S48_VECTOR_SET(res, 18, s48_enter_integer(GCV.clip_x_origin));
S48_VECTOR_SET(res, 19, s48_enter_integer(GCV.clip_y_origin));
S48_VECTOR_SET(res, 20, ENTER_PIXMAP(GCV.clip_mask));
S48_VECTOR_SET(res, 21, s48_enter_integer(GCV.dash_offset));
S48_VECTOR_SET(res, 22, s48_enter_integer(GCV.dashes));
}
S48_GC_UNPROTECT();
return res;
} }
elk_init_xlib_gcontext () { s48_value Change_Gc (s48_value Xgcontext, s48_value Xdisplay, s48_value args) {
Define_Symbol (&Sym_Gc, "gcontext"); XGCValues GCV;
Generic_Define (Gc, "gcontext", "gcontext?"); unsigned long mask = AList_To_GCValues(args, &GCV);
Define_Primitive (P_Gc_Display, "gcontext-display", 1, 1, EVAL);
Define_Primitive (P_Create_Gc, "xlib-create-gcontext",2, 2, EVAL); XChangeGC(EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xgcontext),
Define_Primitive (P_Copy_Gc, "copy-gcontext", 2, 2, EVAL); mask, &GCV);
Define_Primitive (P_Change_Gc, "xlib-change-gcontext",2, 2, EVAL);
Define_Primitive (P_Free_Gc, "free-gcontext", 1, 1, EVAL); return S48_UNSPECIFIC;
Define_Primitive (P_Query_Best_Size, "query-best-size", 4, 4, EVAL); }
Define_Primitive (P_Set_Gcontext_Clip_Rectangles,
"set-gcontext-clip-rectangles!", 5, 5, EVAL); s48_value Set_Gcontext_Dashlist(s48_value Xgcontext, s48_value Xdisplay,
Define_Primitive (P_Set_Gcontext_Dashlist, s48_value dashoffset, s48_value dashlist) {
"set-gcontext-dashlist!", 3, 3, EVAL); int n = S48_VECTOR_LENGTH(dashlist);
Define_Primitive (P_Get_Gc_Values, char v[n];
"xlib-get-gcontext-values", 1, 1, EVAL); int i;
for (i=0; i<n; i++) {
v[i] = (char)s48_extract_integer(S48_VECTOR_REF(dashlist, i));
}
XSetDashes( EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xgcontext),
s48_extract_integer(dashoffset), v, n);
return S48_UNSPECIFIC;
}
s48_value Set_Gcontext_Clip_Rectangles (s48_value Xgcontext,
s48_value Xdisplay, s48_value x,
s48_value y, s48_value v,
s48_value ord) {
int n = S48_VECTOR_LENGTH(v);
XRectangle p[n];
int i;
s48_value rect;
for (i = 0; i < n; i++) {
rect = S48_VECTOR_REF(v, i);
p[i].x = (int)s48_extract_integer (S48_CAR (rect));
rect = S48_CDR (rect);
p[i].y = (int)s48_extract_integer (S48_CAR (rect));
rect = S48_CDR (rect);
p[i].width = (int)s48_extract_integer (S48_CAR (rect));
rect = S48_CDR (rect);
p[i].height = (int)s48_extract_integer (S48_CAR (rect));
}
XSetClipRectangles (EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xgcontext),
(int)s48_extract_integer (x),
(int)s48_extract_integer (y), p, n,
Symbol_To_Bit(ord, Ordering_Syms));
return S48_UNSPECIFIC;
}
s48_value Query_Best_Size (s48_value Xdisplay, s48_value width,
s48_value height, s48_value shape) {
unsigned int rw, rh;
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
if (!XQueryBestSize (dpy,
Symbol_To_Bit (shape, Shape_Syms),
DefaultRootWindow (dpy), //??
(int)s48_extract_integer (width),
(int)s48_extract_integer (height),
&rw, &rh))
return S48_FALSE;
else
return s48_cons (s48_enter_integer (rw), s48_enter_integer (rh));
}
void s48_init_gcontext(void) {
S48_EXPORT_FUNCTION(Create_Gc);
S48_EXPORT_FUNCTION(Free_Gc);
S48_EXPORT_FUNCTION(Copy_Gc);
S48_EXPORT_FUNCTION(Get_Gc_Values);
S48_EXPORT_FUNCTION(Change_Gc);
S48_EXPORT_FUNCTION(Set_Gcontext_Dashlist);
S48_EXPORT_FUNCTION(Set_Gcontext_Clip_Rectangles);
} }

2
c/xlib/main.c
View File

@ -6,6 +6,7 @@ extern void s48_init_type();
extern void s48_init_color(); extern void s48_init_color();
extern void s48_init_colormap(); extern void s48_init_colormap();
extern void s48_init_pixel(); extern void s48_init_pixel();
extern void s48_init_gcontext();
int main(){ int main(){
s48_add_external_init(s48_init_window); s48_add_external_init(s48_init_window);
@ -15,6 +16,7 @@ int main(){
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_colormap);
s48_add_external_init(s48_init_pixel); s48_add_external_init(s48_init_pixel);
s48_add_external_init(s48_init_gcontext);
s48_main(8000000, 64000, s48_main(8000000, 64000,
"/afs/wsi/home/dfreese/i386_fbsd43/scsh-0.6/lib/scheme48/scsh.image", "/afs/wsi/home/dfreese/i386_fbsd43/scsh-0.6/lib/scheme48/scsh.image",

BIN
c/xlib/test
View File

Binary file not shown.

22
c/xlib/type.c
View File

@ -53,17 +53,6 @@ s48_value Bit_To_Symbol(unsigned long bits, SYMDESCR* table) {
return s48_enter_integer(bits); return s48_enter_integer(bits);
else else
return S48_CAR(res); return S48_CAR(res);
}}
unsigned long Symbols_To_Bits(s48_value Syms, SYMDESCR* table) {
unsigned long res = 0;
s48_value l;
for (l = Syms; !S48_NULL_P(l); l = S48_CDR(l)) {
res |= Symbol_To_Bit(S48_CAR(l), table);
}
return res;
} }
unsigned long Symbol_To_Bit(s48_value Sym, SYMDESCR* table) { unsigned long Symbol_To_Bit(s48_value Sym, SYMDESCR* table) {
@ -78,6 +67,17 @@ unsigned long Symbol_To_Bit(s48_value Sym, SYMDESCR* table) {
return res; return res;
} }
unsigned long Symbols_To_Bits(s48_value Syms, SYMDESCR* table) {
unsigned long res = 0;
s48_value l;
for (l = Syms; !S48_NULL_P(l); l = S48_CDR(l)) {
res |= Symbol_To_Bit(S48_CAR(l), table);
}
return res;
}
SYMDESCR Func_Syms[] = { SYMDESCR Func_Syms[] = {
{ "clear", GXclear }, { "clear", GXclear },
{ "and", GXand }, { "and", GXand },

230
c/xlib/window.c
View File

@ -1,8 +1,6 @@
#include "xlib.h" #include "xlib.h"
#include "scheme48.h" #include "scheme48.h"
static s48_value window_record_type_binding = S48_FALSE;
unsigned long AList_To_XSetWindowAttributes(s48_value attrAlist, unsigned long AList_To_XSetWindowAttributes(s48_value attrAlist,
XSetWindowAttributes* Xattrs) { XSetWindowAttributes* Xattrs) {
unsigned long mask = 0; unsigned long mask = 0;
@ -94,11 +92,9 @@ s48_value Create_Window (s48_value Xdisplay, s48_value Xparent, s48_value x,
XSetWindowAttributes Xattrs; XSetWindowAttributes Xattrs;
unsigned long mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs ); unsigned long mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs );
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Window parent = EXTRACT_WINDOW(Xparent);
Window win; Window win;
win = XCreateWindow( dpy, parent, (int)s48_extract_integer(x), win = XCreateWindow( EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xparent),
(int)s48_extract_integer(x),
(int)s48_extract_integer(y), (int)s48_extract_integer(y),
(int)s48_extract_integer (width), (int)s48_extract_integer (width),
(int)s48_extract_integer (height), (int)s48_extract_integer (height),
@ -112,65 +108,63 @@ s48_value Create_Window (s48_value Xdisplay, s48_value Xparent, s48_value x,
} }
s48_value Destroy_Window (s48_value Xdisplay, s48_value Xwindow) { s48_value Destroy_Window (s48_value Xdisplay, s48_value Xwindow) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XDestroyWindow (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
Window win = EXTRACT_WINDOW(Xwindow);
XDestroyWindow (dpy, win);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Change_Window_Attributes(s48_value Xwindow, s48_value Xdisplay, s48_value Change_Window_Attributes(s48_value Xwindow, s48_value Xdisplay,
s48_value attrAlist) { s48_value attrAlist) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Window win = EXTRACT_WINDOW(Xwindow);
XSetWindowAttributes Xattrs; XSetWindowAttributes Xattrs;
unsigned long mask = 0; unsigned long mask = 0;
mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs ); mask = AList_To_XSetWindowAttributes( attrAlist, &Xattrs );
XChangeWindowAttributes(dpy, win, mask, &Xattrs); XChangeWindowAttributes(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
mask, &Xattrs);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) { s48_value Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Window win = EXTRACT_WINDOW(Xwindow);
XWindowAttributes WA; XWindowAttributes WA;
S48_DECLARE_GC_PROTECT(1); S48_DECLARE_GC_PROTECT(1);
s48_value res = S48_NULL; s48_value res = S48_NULL;
S48_GC_PROTECT_1(res);
if (!XGetWindowAttributes(dpy, win, &WA)) if (!XGetWindowAttributes(EXTRACT_DISPLAY(Xdisplay),EXTRACT_WINDOW(Xwindow),
&WA))
res = S48_FALSE; res = S48_FALSE;
else { else {
S48_GC_PROTECT_1(res);
res = s48_make_vector(23, S48_FALSE);
S48_VECTOR_SET(res, 0, s48_enter_integer(WA.x));
S48_VECTOR_SET(res, 1, s48_enter_integer(WA.y));
S48_VECTOR_SET(res, 2, s48_enter_integer(WA.width));
S48_VECTOR_SET(res, 3, s48_enter_integer(WA.height));
S48_VECTOR_SET(res, 4, s48_enter_integer(WA.border_width));
S48_VECTOR_SET(res, 5, s48_enter_integer(WA.depth));
S48_VECTOR_SET(res, 6, ENTER_VISUAL(WA.visual));
S48_VECTOR_SET(res, 7, ENTER_WINDOW(WA.root));
S48_VECTOR_SET(res, 8, Bit_To_Symbol(WA.class, Class_Syms));
S48_VECTOR_SET(res, 9, Bit_To_Symbol(WA.bit_gravity, Bit_Grav_Syms));
S48_VECTOR_SET(res, 10, Bit_To_Symbol(WA.win_gravity, Grav_Syms));
S48_VECTOR_SET(res, 11, Bit_To_Symbol(WA.backing_store,
Backing_Store_Syms));
S48_VECTOR_SET(res, 12, s48_enter_integer(WA.backing_planes));
S48_VECTOR_SET(res, 13, ENTER_PIXEL(WA.backing_pixel));
S48_VECTOR_SET(res, 14, WA.save_under ? S48_TRUE : S48_FALSE );
S48_VECTOR_SET(res, 15, ENTER_COLORMAP( WA.colormap ));
S48_VECTOR_SET(res, 16, WA.map_installed ? S48_TRUE : S48_FALSE);
S48_VECTOR_SET(res, 17, Bit_To_Symbol( WA.map_state, Map_State_Syms));
S48_VECTOR_SET(res, 18, ENTER_MASK( WA.all_event_masks )); //?? MASKS?
S48_VECTOR_SET(res, 19, ENTER_MASK( WA.your_event_mask ));
S48_VECTOR_SET(res, 20, ENTER_MASK( WA.do_not_propagate_mask ));
S48_VECTOR_SET(res, 21, WA.override_redirect ? S48_TRUE : S48_FALSE);
S48_VECTOR_SET(res, 22, s48_enter_integer((long)WA.screen)); //??
// WA.screen - ignored in Elk // WA.screen - ignored in Elk
res = s48_cons( WA.overide_redirect ? S48_TRUE : S48_FALSE, res);
res = s48_cons( ENTER_MASK( WA.do_not_propagate_mask ), res);
res = s48_cons( ENTER_MASK( WA.your_event_mask ), res);
res = s48_cons( ENTER_MASK( WA.all_event_mask ), res);
res = s48_cons( Bit_To_Symbol( WA.map_state, Map_State_Syms), res);
res = s48_cons( WA.map_installed ? S48_TRUE : S48_FALSE, res);
res = s48_cons( ENTER_COLORMAP( WA.colormap ), res);
res = s48_cons( WA.save_under ? S48_TRUE : s48_FALSE );
res = s48_cons( ENTER_PIXEL(WA.backing_pixel), res);
res = s48_cons( s48_enter_integer(WA.backing_planes), res);
res = s48_cons( Bit_To_Symbol(WA.backing_store, Backing_Store_Syms),
res);
res = s48_cons( Bit_To_Symbol(WA.win_gravity, Grav_Syms),
res);
res = s48_cons( Bit_To_Symbol(WA.bit_gravity, Bit_Grav_Syms), res);
res = s48_cons( Bit_To_Symbol(WA.class, Class_Syms), res);
res = s48_cons( ENTER_WINDOW(WA.root), res);
res = s48_cons( ENTER_VISUAL(WA.visual), res);
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(); S48_GC_UNPROTECT();
@ -179,9 +173,6 @@ s48_value Get_Window_Attributes(s48_value Xdisplay, s48_value Xwindow) {
s48_value Configure_Window (s48_value Xwindow, s48_value Xdisplay, s48_value Configure_Window (s48_value Xwindow, s48_value Xdisplay,
s48_value alist) { s48_value alist) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay);
Window win = EXTRACT_WINDOW(Xwindow);
unsigned long mask = 0; unsigned long mask = 0;
XWindowChanges WC; XWindowChanges WC;
s48_value l; s48_value l;
@ -219,51 +210,40 @@ s48_value Configure_Window (s48_value Xwindow, s48_value Xdisplay,
} }
} // for } // for
XConfigureWindow (dpy, win, mask, &WC); XConfigureWindow (EXTRACT_DISPLAY(Xdisplay),EXTRACT_WINDOW(Xwindow),
mask, &WC);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Map_Window(s48_value Xwindow, s48_value Xdisplay) { s48_value Map_Window(s48_value Xwindow, s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XMapWindow(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
Window win = EXTRACT_WINDOW(Xwindow);
XMapWindow(dpy, win);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Unmap_Window(s48_value Xwindow, s48_value Xdisplay) { s48_value Unmap_Window(s48_value Xwindow, s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XUnmapWindow(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
Window win = EXTRACT_WINDOW(Xwindow);
XUnmapWindow(dpy, win);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Destroy_Subwindows (s48_value Xwindow, s48_value Xdisplay) { s48_value Destroy_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XDestroySubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
Window win = EXTRACT_WINDOW(Xwindow);
XDestroySubwindows(dpy, win);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Map_Subwindows (s48_value Xwindow, s48_value Xdisplay) { s48_value Map_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XMapSubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
Window win = EXTRACT_WINDOW(Xwindow);
XMapSubwindows(dpy, win);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Unmap_Subwindows (s48_value Xwindow, s48_value Xdisplay) { s48_value Unmap_Subwindows (s48_value Xwindow, s48_value Xdisplay) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XUnmapSubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow));
Window win = EXTRACT_WINDOW(Xwindow);
XUnmapSubwindows(dpy, win);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
s48_value Circulate_Subwindows(s48_value Xwindow, s48_value Xdisplay, s48_value Circulate_Subwindows(s48_value Xwindow, s48_value Xdisplay,
s48_value dir) { s48_value dir) {
Display* dpy = EXTRACT_DISPLAY(Xdisplay); XCirculateSubwindows(EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
Window win = EXTRACT_WINDOW(Xwindow); S48_FALSE_P(dir) ? RaiseLowest : LowerHighest);
long direction = s48_extract_integer(dir);
XCirculateSubwindows(dpy, win, direction ? LowerHighest : RaiseLowest);
return S48_UNSPECIFIC; return S48_UNSPECIFIC;
} }
@ -271,7 +251,6 @@ s48_value Circulate_Subwindows(s48_value Xwindow, s48_value Xdisplay,
/* /*
}
Drawable Get_Drawable (d, dpyp) s48_value d; Display **dpyp; { Drawable Get_Drawable (d, dpyp) s48_value d; Display **dpyp; {
if (TYPE(d) == T_Window) { if (TYPE(d) == T_Window) {
@ -297,94 +276,94 @@ static s48_value P_Get_Geometry (d) s48_value d; {
return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L); return Record_To_Vector (Geometry_Rec, Geometry_Size, Sym_Geo, dpy, ~0L);
} }
*/
static s48_value P_Query_Tree (w) s48_value w; { s48_value Query_Tree (s48_value Xwindow, s48_value Xdisplay) {
Window root, parent, *children; Window root, parent, *children;
Display *dpy;
int i; int i;
unsigned n; unsigned n;
s48_value v, ret; s48_value v, ret;
S48_DECLARE_GC_PROTECT(2); S48_DECLARE_GC_PROTECT(2);
Check_Type (w, T_Window); XQueryTree (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
dpy = WINDOW(w)->dpy; &root, &parent, &children, &n);
Disable_Interrupts;
XQueryTree (dpy, WINDOW(w)->win, &root, &parent, &children, &n);
Enable_Interrupts;
v = ret = S48_NULL;
S48_GC_PROTECT_2 (v, ret);
v = Make_Window (0, dpy, root);
ret = s48_cons (v, S48_NULL);
v = Make_Window (0, dpy, parent);
ret = s48_cons (v, ret);
v = s48_make_vector (n, S48_NULL);
for (i = 0; i < n; i++) {
s48_value x;
x = Make_Window (0, dpy, children[i]); S48_GC_PROTECT_2 (v, ret);
S48_VECTOR_SET(v, i, x;)
ret = S48_NULL;
// vector of child-windows
v = s48_make_vector (n, S48_FALSE);
for (i = 0; i < n; i++) {
S48_VECTOR_SET(v, i, ENTER_WINDOW(children[i]));
} }
ret = s48_cons (v, ret); ret = s48_cons(v, ret);
S48_GC_UNPROTECT;
ret = s48_cons(ENTER_WINDOW(parent), ret);
ret = s48_cons(ENTER_WINDOW(root), ret);
S48_GC_UNPROTECT();
return ret; return ret;
} }
static s48_value P_Translate_Coordinates (src, x, y, dst) s48_value src, x, y, dst; { s48_value Translate_Coordinates (s48_value Xdisplay, s48_value srcXwindow,
s48_value x, s48_value y,
s48_value dstXwindow) {
int rx, ry; int rx, ry;
Window child; Window child;
s48_value l, t, z; s48_value l;
S48_DECLARE_GC_PROTECT(3);
Check_Type (src, T_Window); S48_DECLARE_GC_PROTECT(1);
Check_Type (dst, T_Window);
if (!XTranslateCoordinates (WINDOW(src)->dpy, WINDOW(src)->win, if (!XTranslateCoordinates (EXTRACT_DISPLAY(Xdisplay),
WINDOW(dst)->win, (int)s48_extract_integer (x), (int)s48_extract_integer (y), &rx, &ry, EXTRACT_WINDOW(srcXwindow),
&child)) EXTRACT_WINDOW(dstXwindow),
(int)s48_extract_integer (x),
(int)s48_extract_integer (y),
&rx, &ry, &child))
return S48_FALSE; return S48_FALSE;
l = t = P_Make_List (s48_enter_integer (3), S48_NULL);
S48_GC_PROTECT_3 (l, t, dst); S48_GC_PROTECT_1 (l);
S48_CAR (t) = s48_enter_integer (rx); t = S48_CDR (t);
S48_CAR (t) = s48_enter_integer (ry), t = S48_CDR (t); l = S48_NULL;
z = Make_Window (0, WINDOW(dst)->dpy, child); l = s48_cons( ENTER_WINDOW(child), l );
S48_CAR (t) = z; l = s48_cons( s48_enter_integer(ry), l );
S48_GC_UNPROTECT; l = s48_cons( s48_enter_integer(rx), l );
S48_GC_UNPROTECT();
return l; return l;
} }
static s48_value P_Query_Pointer (win) s48_value win; { s48_value Query_Pointer (s48_value Xdisplay, s48_value Xwindow) {
s48_value l, t, z;
s48_value l;
Bool ret; Bool ret;
Window root, child; Window root, child;
int r_x, r_y, x, y; int r_x, r_y, x, y;
unsigned int mask; unsigned int mask;
S48_DECLARE_GC_PROTECT(3); S48_DECLARE_GC_PROTECT(1);
Check_Type (win, T_Window); ret = XQueryPointer (EXTRACT_DISPLAY(Xdisplay), EXTRACT_WINDOW(Xwindow),
ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child, &root, &child, &r_x, &r_y, &x, &y, &mask);
&r_x, &r_y, &x, &y, &mask);
t = l = P_Make_List (s48_enter_integer (8), S48_NULL); S48_GC_PROTECT_1(l);
S48_GC_PROTECT_3 (l, t, win);
S48_CAR (t) = s48_enter_integer (x); t = S48_CDR (t); l = S48_NULL;
S48_CAR (t) = s48_enter_integer (y); t = S48_CDR (t); l = s48_cons(Bits_To_Symbols ((unsigned long)mask, State_Syms), l);
S48_CAR (t) = ret ? S48_TRUE : S48_FALSE; t = S48_CDR (t); l = s48_cons(ENTER_WINDOW(child), l);
z = Make_Window (0, WINDOW(win)->dpy, root); l = s48_cons(s48_enter_integer(r_y), l);
S48_CAR (t) = z; t = S48_CDR (t); l = s48_cons(s48_enter_integer(r_x), l);
S48_CAR (t) = s48_enter_integer (r_x); t = S48_CDR (t); l = s48_cons(ENTER_WINDOW(root), l);
S48_CAR (t) = s48_enter_integer (r_y); t = S48_CDR (t); l = ret ? S48_TRUE : S48_FALSE;
z = Make_Window (0, WINDOW(win)->dpy, child); l = s48_cons(s48_enter_integer(y), l);
S48_CAR (t) = z; t = S48_CDR (t); l = s48_cons(s48_enter_integer(x), l);
z = Bits_To_Symbols ((unsigned long)mask, 1, State_Syms);
S48_CAR (t) = z; S48_GC_UNPROTECT();
S48_GC_UNPROTECT;
return l; return l;
} }
*/
void s48_init_window(void) { 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(Create_Window);
S48_EXPORT_FUNCTION(Destroy_Window); S48_EXPORT_FUNCTION(Destroy_Window);
S48_EXPORT_FUNCTION(Change_Window_Attributes); S48_EXPORT_FUNCTION(Change_Window_Attributes);
@ -396,5 +375,8 @@ void s48_init_window(void) {
S48_EXPORT_FUNCTION(Map_Subwindows); S48_EXPORT_FUNCTION(Map_Subwindows);
S48_EXPORT_FUNCTION(Unmap_Subwindows); S48_EXPORT_FUNCTION(Unmap_Subwindows);
S48_EXPORT_FUNCTION(Circulate_Subwindows); S48_EXPORT_FUNCTION(Circulate_Subwindows);
S48_EXPORT_FUNCTION(Query_Tree);
S48_EXPORT_FUNCTION(Translate_Coordinates);
S48_EXPORT_FUNCTION(Query_Pointer);
} }

14
c/xlib/xlib.h
View File

@ -29,16 +29,24 @@
*/ */
#define EXTRACT_DISPLAY(x) (Display*)s48_extract_integer(x) #define EXTRACT_DISPLAY(x) (Display*)s48_extract_integer(x)
#define ENTER_DISPLAY(x) s48_enter_integer((long)x)
#define EXTRACT_WINDOW(x) (Window)s48_extract_integer(x) #define EXTRACT_WINDOW(x) (Window)s48_extract_integer(x)
#define ENTER_WINDOW(x) s48_enter_integer((long)x); #define ENTER_WINDOW(x) s48_enter_integer((long)x)
#define EXTRACT_COLOR(x) (XColor*)S48_EXTRACT_VALUE_POINTER(x, XColor) #define EXTRACT_COLOR(x) (XColor*)S48_EXTRACT_VALUE_POINTER(x, XColor)
#define EXTRACT_COLORMAP(x) (Colormap)s48_extract_integer(x) #define EXTRACT_COLORMAP(x) (Colormap)s48_extract_integer(x)
#define ENTER_COLORMAP(x) s48_enter_integer((long)x) #define ENTER_COLORMAP(x) s48_enter_integer((long)x)
#define EXTRACT_PIXEL(x) (unsigned long)s48_extract_integer(x) #define EXTRACT_PIXEL(x) (unsigned long)s48_extract_integer(x)
#define ENTER_PIXEL(x) s48_enter_integer((long)x) #define ENTER_PIXEL(x) s48_enter_integer((long)x)
#define EXTRACT_GC(x) (GC)s48_extract_integer(x) #define EXTRACT_GCONTEXT(x) (GC)s48_extract_integer(x)
#define ENTER_GC(x) s48_enter_integer((long)x) #define ENTER_GCONTEXT(x) s48_enter_integer((long)x)
#define EXTRACT_PIXMAP(x) (Pixmap)s48_extract_integer(x) #define EXTRACT_PIXMAP(x) (Pixmap)s48_extract_integer(x)
#define EXTRACT_DRAWABLE(x) (Drawable)s48_extract_integer(x)
// TODO:
#define ENTER_VISUAL(x) S48_FALSE
#define ENTER_MASK(x) S48_FALSE
#define ENTER_PIXMAP(x) S48_FALSE
#define ENTER_FONT(x) S48_FALSE
#define EXTRACT_FONT(x) (Font)0
/* /*