246 lines
8.3 KiB
C
246 lines
8.3 KiB
C
#include "xlib.h"
|
|
#include "scheme48.h"
|
|
|
|
unsigned long AList_To_GCValues(s48_value alist, XGCValues* GCV) {
|
|
unsigned long mask;
|
|
s48_value l;
|
|
char* cname;
|
|
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));
|
|
|
|
if (cname == "function") {
|
|
GCV->function = Symbols_To_Bits(value, 0, Func_Syms);
|
|
mask |= GCFunction;
|
|
} else if (cname == "plane-mask") {
|
|
GCV->plane_mask = EXTRACT_PIXEL(value);
|
|
mask |= GCPlaneMask;
|
|
} else if (cname == "foreground") {
|
|
GCV->foreground = EXTRACT_PIXEL(value);
|
|
mask |= GCForeground;
|
|
} else if (cname == "background") {
|
|
GCV->background = EXTRACT_PIXEL(value);
|
|
mask |= GCBackground;
|
|
} else if (cname == "line-width") {
|
|
GCV->line_width = s48_extract_integer(value);
|
|
mask |= GCLineWidth;
|
|
} else if (cname == "line-style") {
|
|
GCV->line_style = Symbol_To_Bit(value,Line_Style_Syms);
|
|
mask |= GCLineStyle;
|
|
} else if (cname == "cap-style") {
|
|
GCV->cap_style = Symbol_To_Bit(value, Cap_Style_Syms);
|
|
mask |= GCCapStyle;
|
|
} else if (cname == "join-style") {
|
|
GCV->join_style = Symbol_To_Bit(value, Join_Style_Syms);
|
|
mask |= GCJoinStyle;
|
|
} else if (cname == "fill-style") {
|
|
GCV->fill_style = Symbol_To_Bit(value, Fill_Style_Syms);
|
|
mask |= GCFillStyle;
|
|
} else if (cname == "fill-rule") {
|
|
GCV->fill_rule = Symbol_To_Bit(value, Fill_Rule_Syms);
|
|
mask |= GCFillRule;
|
|
} else if (cname == "arc-mode") {
|
|
GCV->arc_mode = Symbol_To_Bit(value, Arc_Mode_Syms);
|
|
mask |= GCArcMode;
|
|
} else if (cname == "tile") {
|
|
GCV->tile = EXTRACT_PIXMAP(value);
|
|
mask |= GCTile;
|
|
} else if (cname == "stipple") {
|
|
GCV->stipple = EXTRACT_PIXMAP(value);
|
|
mask |= GCStipple;
|
|
} else if (cname == "ts-x") {
|
|
GCV->ts_x_origin = s48_extract_integer(value);
|
|
mask |= GCTileStipXOrigin;
|
|
} else if (cname == "ts-y") {
|
|
GCV->ts_y_origin = s48_extract_integer(value);
|
|
mask |= GCTileStipYOrigin;
|
|
} else if (cname == "font") {
|
|
GCV->font = EXTRACT_FONT(value);
|
|
mask |= GCFont;
|
|
} else if (cname == "subwindow-mode") {
|
|
GCV->subwindow_mode = Symbol_To_Bit(value, Subwin_Mode_Syms);
|
|
mask |= GCSubwindowMode;
|
|
} else if (cname == "exposures") {
|
|
GCV->graphics_exposures = !S48_FALSE_P(value);
|
|
mask |= GCGraphicsExposures;
|
|
} else if (cname == "clip-x") {
|
|
GCV->clip_x_origin = s48_extract_integer(value);
|
|
mask |= GCClipXOrigin;
|
|
} else if (cname == "clip-y") {
|
|
GCV->clip_y_origin = s48_extract_integer(value);
|
|
mask |= GCClipYOrigin;
|
|
} else if (cname == "clip-mask") {
|
|
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;
|
|
}
|
|
// else error ??
|
|
} // for
|
|
|
|
return mask;
|
|
}
|
|
|
|
s48_value Create_Gc(s48_value Xdisplay, s48_value Xdrawable, s48_value args) {
|
|
XGCValues GCV;
|
|
unsigned long mask = AList_To_GCValues(args, &GCV);
|
|
|
|
GC Xgcontext = XCreateGC(EXTRACT_DISPLAY(Xdisplay),
|
|
EXTRACT_DRAWABLE(Xdrawable),
|
|
mask, &GCV);
|
|
|
|
return ENTER_GCONTEXT(Xgcontext);
|
|
}
|
|
|
|
s48_value Copy_Gc(s48_value Xdisplay, s48_value Xsource, s48_value Xdest) {
|
|
XCopyGC(EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xsource),
|
|
~0L, EXTRACT_GCONTEXT(Xdest));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Free_Gc(s48_value Xgcontext, s48_value Xdisplay) {
|
|
XFreeGC(EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xgcontext));
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
#define ValidGCValuesBits \
|
|
(GCFunction | GCPlaneMask | GCForeground | GCBackground | GCLineWidth |\
|
|
GCLineStyle | GCCapStyle | GCJoinStyle | GCFillStyle | GCFillRule |\
|
|
GCTile | GCStipple | GCTileStipXOrigin | GCTileStipYOrigin | GCFont |\
|
|
GCSubwindowMode | GCGraphicsExposures | GCClipXOrigin | GCClipYOrigin |\
|
|
GCDashOffset | GCArcMode)
|
|
|
|
s48_value Get_Gc_Values (s48_value Xgcontext, s48_value Xdisplay) {
|
|
unsigned long mask = ValidGCValuesBits;
|
|
|
|
XGCValues GCV;
|
|
s48_value res;
|
|
S48_DECLARE_GC_PROTECT(1);
|
|
|
|
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;
|
|
}
|
|
|
|
s48_value Change_Gc (s48_value Xgcontext, s48_value Xdisplay, s48_value args) {
|
|
XGCValues GCV;
|
|
unsigned long mask = AList_To_GCValues(args, &GCV);
|
|
|
|
XChangeGC(EXTRACT_DISPLAY(Xdisplay), EXTRACT_GCONTEXT(Xgcontext),
|
|
mask, &GCV);
|
|
|
|
return S48_UNSPECIFIC;
|
|
}
|
|
|
|
s48_value Set_Gcontext_Dashlist(s48_value Xgcontext, s48_value Xdisplay,
|
|
s48_value dashoffset, s48_value dashlist) {
|
|
int n = S48_VECTOR_LENGTH(dashlist);
|
|
char v[n];
|
|
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);
|
|
}
|