static status
toRBG(Int *r, Int *g, Int *b, Name model)
{ if ( isDefault(*r) || isDefault(*g) || isDefault(*b) )
fail;
if ( model == NAME_hsv )
{ int ih = valInt(*r) % 360;
int is = valInt(*g);
int iv = valInt(*b);
float R,G,B;
if ( is > 100 )
return errorPce(*g, NAME_unexpectedType, CtoType("0..100"));
if ( iv > 100 )
return errorPce(*g, NAME_unexpectedType, CtoType("0..100"));
if ( ih < 0 )
ih += 360;
HSVToRGB((float)ih/360.0, (float)is/100.0, (float)iv/100.0,
&R, &G, &B);
*r = toInt((int)(R*65535));
*g = toInt((int)(G*65535));
*b = toInt((int)(B*65535));
}
succeed;
}
status
ws_write_stream_data(Stream s, void *data, int len)
{ if ( s->wrfd < 0 )
return errorPce(s, NAME_notOpen);
if ( write(s->wrfd, data, len) != len )
return errorPce(s, NAME_ioError, OsError());
succeed;
}
static status
attributeElevation(Elevation e, Name att, Any val)
{ if ( notNil(e->name) )
return errorPce(e, NAME_readOnly);
return slotObject(e, att, val);
}
static int
x_error_handler(Display *display, XErrorEvent *error)
{ if ( !catchedErrorPce(PCE, NAME_xError) )
{ char msg[1024];
char request[100];
char buf[100];
/* XSetInputFocus() can generate a */
/* BadMatch that is hard to avoid */
if ( error->request_code == X_SetInputFocus &&
error->error_code == BadMatch )
return 0;
XGetErrorText(display, error->error_code, msg, 1024);
sprintf(buf, "%d", error->request_code);
XGetErrorDatabaseText(display, "XRequest", buf,
"Unknown request", request, 100);
Cprintf("X error of failed request: %s\n", msg);
Cprintf("Major opcode of failed request: %d (%s)\n",
error->request_code, request);
Cprintf("Minor opcode of failed request: %d\n", error->minor_code);
Cprintf("Resource id in failed request: 0x%x\n",
(unsigned int) error->resourceid);
Cprintf("Serial number of failed request: %ld\n", error->serial);
errorPce(NIL, NAME_xError);
}
return 0; /* what to return here? */
}
static status
initialiseMenuItem(MenuItem m, Any value, Message msg, Any label,
BoolObj eg, Code cond, Name acc)
{ if ( isDefault(eg) )
eg = OFF;
if ( isDefault(label) && !(label = get(m, NAME_defaultLabel, value, EAV)) )
return errorPce(m, NAME_noDefaultLabel, value);
if ( isDefault(cond) )
cond = NIL;
assign(m, value, value);
assign(m, message, msg);
assign(m, label, label);
assign(m, font, DEFAULT);
assign(m, colour, DEFAULT);
assign(m, selected, OFF);
assign(m, active, ON);
assign(m, condition, cond);
assign(m, end_group, eg);
if ( notDefault(acc) )
assign(m, accelerator, acc);
return labelMenuItem(m, label);
}
static status
initialiseConstraint(Constraint c, Any from, Any to,
Relation relation, Name only)
{ Name lock;
if ( from == to )
return errorPce(c, NAME_cannotConstraintSelf);
assign(c, from, from);
assign(c, to, to);
assign(c, relation, relation);
if ( isDefault(only) )
lock = NAME_none;
else if ( equalName(only, NAME_forwards) )
lock = NAME_backwards;
else
lock = NAME_forwards;
assign(c, locked, lock);
constraintObject(from, c);
constraintObject(to, c);
forwardCreateConstraint(c);
succeed;
}
static status
callCv(CObj host, CPointer function, int argc, Any *argv)
{ status rval;
SendFunc f = (SendFunc) function->pointer;
int n;
for(n=0; n<argc; n++)
if ( isObject(argv[n]) )
addCodeReference(argv[n]);
switch(argc)
{ case 0: rval = (*f)(); break;
case 1: rval = (*f)(argv[0]); break;
case 2: rval = (*f)(argv[0], argv[1]); break;
case 3: rval = (*f)(argv[0], argv[1], argv[2]); break;
case 4: rval = (*f)(argv[0], argv[1], argv[2], argv[3]); break;
case 5: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4]); break;
case 6: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5]); break;
case 7: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6]); break;
case 8: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7]); break;
case 9: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
argv[5], argv[6], argv[7], argv[8]); break;
default:
rval = errorPce(host, NAME_tooManyArguments, argc);
}
for(n=0; n<argc; n++)
if ( isObject(argv[n]) && !isFreedObj(argv[n]) )
delCodeReference(argv[n]);
return rval ? SUCCEED : FAIL;
}
static status
initialiseTileAdjuster(TileAdjuster p, TileObj t)
{ Image img = getClassVariableValueObject(p, NAME_image);
Size size;
CursorObj crs;
BitmapObj bm;
if ( isNil(t->super) )
return errorPce(p, NAME_noSubTile, t);
if ( t->super->orientation == NAME_horizontal )
{ img = getClassVariableValueObject(p, NAME_himage);
crs = getClassVariableValueObject(p, NAME_horizontalResizeCursor);
} else
{ img = getClassVariableValueObject(p, NAME_vimage);
crs = getClassVariableValueObject(p, NAME_verticalResizeCursor);
}
size = getCopySize(img->size);
initialiseWindow((PceWindow) p, NAME_adjuster, size, DEFAULT);
assign(p, pen, ZERO);
assign(p, cursor, crs);
assign(p, orientation, t->super->orientation);
send(p, NAME_display, bm=newObject(ClassBitmap, img, EAV), EAV);
/*send(bm, NAME_cursor, crs, EAV);*/
assign(t, adjuster, p);
assign(p, client, t);
succeed;
}
status
X11ThreadsDisplay(DisplayObj d, BoolObj val)
{ if ( ThePceXtAppContext )
return errorPce(d, NAME_x11Threads);
use_x_init_threads = (val == ON ? TRUE : FALSE);
succeed;
}
status
ws_create_window(PceWindow sw, PceWindow parent)
{ Widget w;
DisplayObj d = getDisplayGraphical((Graphical)sw);
/* create the widget */
{ Arg args[8];
Cardinal n = 0;
int pen = valInt(sw->pen);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Actually, it appears Xt is ignoring the geometry parameters. Hence,
ws_realise_frame() sends ->geometry to all windows.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
XtSetArg(args[n], XtNx, valInt(sw->area->x)); n++;
XtSetArg(args[n], XtNy, valInt(sw->area->y)); n++;
XtSetArg(args[n], XtNwidth, valInt(sw->area->w) - 2*pen); n++;
XtSetArg(args[n], XtNheight, valInt(sw->area->h) - 2*pen); n++;
XtSetArg(args[n], XtNborderWidth, pen); n++;
XtSetArg(args[n], XtNinput, True); n++;
if ( instanceOfObject(sw->background, ClassColour) )
{ XtSetArg(args[n], XtNbackground, getPixelColour(sw->background, d));
n++;
} else
{ Pixmap pm = (Pixmap) getXrefObject(sw->background, d);
XtSetArg(args[n], XtNbackgroundPixmap, pm); n++;
}
DEBUG(NAME_create, Cprintf("Calling XtCreateWidget ..."));
w = XtCreateWidget(strName(sw->name),
canvasWidgetClass,
isDefault(parent) ? widgetFrame(sw->frame)
: widgetWindow(parent),
args, n);
DEBUG(NAME_create, Cprintf("Widget = %p\n", w));
}
if ( !w )
return errorPce(w, NAME_createFailed);
setWidgetWindow(sw, w);
XtAddCallback(w, XtNeventCallback, event_window, sw);
XtAddCallback(w, XtNexposeCallback, expose_window, sw);
XtAddCallback(w, XtNresizeCallback, resize_window, sw);
XtAddCallback(w, XtNdestroyCallback, destroy_window, sw);
if ( notDefault(parent) ) /* make a sub-window */
{ XtManageChild(w);
send(sw, NAME_displayed, ON, EAV);
}
succeed;
}
static Any
get_clipboard_data(DisplayObj d, Name type)
{ HGLOBAL mem;
HENHMETAFILE hmf;
Any rval = FAIL;
OpenClipboard(CLIPBOARDWIN);
if ( type != NAME_winMetafile && (mem = GetClipboardData(CF_UNICODETEXT)) )
{ wchar_t *data = GlobalLock(mem);
wchar_t *copy, *q;
q = copy = pceMalloc((wcslen(data)+1)*sizeof(wchar_t));
for(; *data; data++)
{ if ( *data == '\r' && data[1] == '\n' )
{ data++;
*q++ = '\n';
} else
*q++ = *data;
}
*q = EOS;
rval = WCToString(copy, q-copy);
pceFree(copy);
GlobalUnlock(mem);
} else if ( type != NAME_winMetafile && (mem = GetClipboardData(CF_TEXT)) )
{ char far *data = GlobalLock(mem);
char *copy, *q;
q = copy = pceMalloc(strlen(data));
for(; *data; data++)
{ if ( *data == '\r' && data[1] == '\n' )
{ data++;
*q++ = '\n';
} else
*q++ = *data;
}
*q = EOS;
rval = CtoString(copy);
pceFree(copy);
GlobalUnlock(mem);
} else if ( type != NAME_text && (hmf = GetClipboardData(CF_ENHMETAFILE)) )
{ HENHMETAFILE copy = CopyEnhMetaFile(hmf, NULL);
if ( !copy )
{ errorPce(d, NAME_winMetafile, CtoName("CopyEnhMetaFile"), APIError());
fail;
}
rval = CtoWinMetafile(copy);
DeleteEnhMetaFile(hmf);
}
CloseClipboard();
return rval;
}
Any
cToPceInteger(intptr_t i)
{ Int n = toInt(i);
if ( valInt(n) != i )
{ errorPce(PCE, NAME_intRange);
fail;
}
return n;
}
static status
posixValueDate(Date d, Real r)
{ time_t v = (time_t)valReal(r);
double diff = (double) v - valReal(r);
if ( diff < -1.0 || diff > 1.0 )
return errorPce(d, NAME_intRange);
d->unix_date = v;
succeed;
}
void *
pceXtAppContext(void * ctx)
{ if ( ThePceXtAppContext == NULL )
{ if ( ctx != NULL )
{ ThePceXtAppContext = ctx;
XSetErrorHandler(x_error_handler);
} else
{
#if defined(_REENTRANT) && defined(HAVE_XINITTHREADS)
if ( XPCE_mt == TRUE )
{ if ( use_x_init_threads )
XInitThreads();
} else
{ XPCE_mt = -1;
}
#else
XPCE_mt = -1;
#endif
XtToolkitInitialize();
XSetErrorHandler(x_error_handler);
if ( (ThePceXtAppContext = XtCreateApplicationContext()) == NULL )
{ errorPce(TheDisplayManager(), NAME_noApplicationContext);
fail;
}
if ( !XtSetLanguageProc(ThePceXtAppContext, NULL, NULL) )
{ errorPce(TheDisplayManager(), NAME_noLocaleSupport,
CtoName(setlocale(LC_ALL, NULL)));
fail;
}
}
}
return ThePceXtAppContext;
}
int
ws_provide_selection(int format)
{ DisplayObj d = CurrentDisplay(NIL);
Hyper h;
Function msg;
Name which = NAME_primary;
Name hypername = getAppendName(which, NAME_selectionOwner);
Name type;
if ( d && notNil(d) &&
(h = getFindHyperObject(d, hypername, DEFAULT)) &&
(type = getAttributeObject(h, NAME_type)) &&
(msg = getAttributeObject(h, NAME_convertFunction)) &&
(msg = checkType(msg, TypeFunction, NIL)) )
{ Any val;
DEBUG(NAME_selection, Cprintf("Provide %s selection of type %s\n",
pp(which), pp(type)));
if ( !(val = getForwardReceiverFunction(msg, h->to, which, type, EAV)) )
return FALSE;
DEBUG(NAME_selection, Cprintf("Got %s\n", pp(val)));
if ( type == NAME_text )
{ CharArray ca = checkType(val, TypeCharArray, NIL);
if ( ca )
{ String s = &ca->data;
HGLOBAL mem = ws_string_to_global_mem(s);
if ( mem )
SetClipboardData(CF_UNICODETEXT, mem);
return TRUE;
}
} else if ( type == NAME_emf || type == NAME_wmf )
{ Any mf = checkType(val, nameToType(NAME_winMetafile), NIL);
if ( mf )
{ DEBUG(NAME_selection, Cprintf("Providing win_metafile\n"));
return ws_on_clipboard_metafile(mf, type);
}
} else
return errorPce(d, NAME_noSelectionType, type);
}
return FALSE;
}
static Any
getCatchAllHostv(Host h, Name selector, int argc, Any *argv)
{ Any rval;
if ( h->callBack == OFF )
{ errorPce(h, NAME_noCallBack);
fail;
}
if ( !(rval = getCallHostv(h, selector, argc, argv)) &&
PCE->last_error == NAME_noBehaviour )
assign(PCE, last_error, NIL);
answer(rval);
}
static status
typedIntItem(IntItem ii, EventId id)
{ CharArray save = getCopyCharArray(ii->value_text->string);
status rval = typedTextItem((TextItem)ii, id);
if ( rval &&
!checkType(ii->value_text->string, TypeInt, NIL) &&
getSizeCharArray(ii->value_text->string) != ZERO )
{ displayedValueTextItem((TextItem)ii, save);
return errorPce(ii, NAME_cannotConvertText,
ii->value_text->string, ii->type);
}
doneObject(save);
return rval;
}
static status
initialiseDirectory(Directory d, Name name)
{ char path[MAXPATHLEN];
Name expanded;
const char *ufn;
if ( !(expanded = expandFileName(name)) )
fail;
ufn = nameToUTF8(expanded);
if ( absolutePath(ufn, path, sizeof(path)) < 0 )
return errorPce(d, NAME_representation, NAME_nameTooLong);
assign(d, path, UTF8ToName(path));
assign(d, name, UTF8ToName(baseName(ufn)));
d->modified = MODIFIED_NOT_SET;
succeed;
}
static status
initialiseReal(Real r, Any arg)
{ double v;
setFlag(r, F_ISREAL);
if ( isInteger(arg) )
{ v = (double)valInt(arg);
} else if ( instanceOfObject(arg, ClassNumber) )
{ v = (double)((Number)arg)->value;
} else if ( instanceOfObject(arg, ClassReal) )
{ Real a = arg;
return valueReal(r, a);
} else
return errorPce(ClassReal, NAME_cannotConvert, arg);
setReal(r, v);
succeed;
}
Any
ws_event_in_subwindow(EventObj ev, Any root)
{ DisplayObj d = getDisplayEvent(ev);
DisplayWsXref r = d->ws_ref;
Window src_w = XtWindow(widgetWindow(ev->window));
int dx, dy;
Window child;
int root_is_display;
if ( isDefault(root) )
root = d;
if ( (root_is_display = instanceOfObject(root, ClassDisplay)) )
{ XWindowAttributes atts;
int depth = MAX_DECORATION_NESTING;
if ( d != root )
{ errorPce(ev, NAME_notSameDisplay, root);
fail;
}
XGetWindowAttributes(r->display_xref, XtWindow(r->shell_xref), &atts);
XTranslateCoordinates(r->display_xref, src_w, atts.root,
valInt(ev->x), valInt(ev->y),
&dx, &dy, &child);
#if 0
DEBUG(NAME_pointer,
/* TEST STUFF */
({ Window rr, cr;
int rx, ry, wx, wy, mask;
if ( XQueryPointer(r->display_xref, atts.root, &rr, &cr,
&rx, &ry, &wx, &wy, &mask) )
{ Cprintf("XTranslateCoordinates --> %d\nXQueryPointer --> %d\n",
child, cr);
}
}));
static status
initialiseVar(Var v, Type type, Name name, Any value)
{ if ( isDefault(type) )
type = TypeUnchecked;
if ( isDefault(name) ) /* local var */
name = NIL;
assign(v, name, name);
assign(v, type, type);
assign(v, global_value, value);
v->value = value;
if ( isObject(value) )
addCodeReference(value);
if ( notNil(name) )
{ if ( getMemberHashTable(VarTable, name) )
errorPce(v, NAME_redeclaredVar);
appendHashTable(VarTable, name, v);
protectObject(v);
}
return initialiseFunction((Function) v);
}
static void
setupSockets(void)
{ static int initialised = 0;
if ( !initialised )
{
#ifdef HAVE_WINSOCK
WSADATA data;
#ifdef USE_WINSOCK2
WORD wversion = MAKEWORD(2, 0);
#else
WORD wversion = MAKEWORD(1, 1);
#endif
if ( WSAStartup(wversion, &data) != 0 )
errorPce(NIL, NAME_socket, NAME_initialise, SockError());
DEBUG(NAME_socket,
Cprintf("WSAStartup(): wVersion = %d.%d, wHighVersion = %d.%d\n",
data.wVersion >> 8, data.wVersion & 0xff,
data.wHighVersion >> 8, data.wHighVersion & 0xff);
Cprintf("Description: %s\n", data.szDescription);
Cprintf("Status: %s\n", data.szSystemStatus);
);
status
ws_own_selection(DisplayObj d, Name selection, Name type)
{ HWND hwnd = CLIPBOARDWIN;
UINT format;
if ( type == NAME_emf )
format = CF_ENHMETAFILE;
else if ( type == NAME_wmf )
format = CF_METAFILEPICT;
else if ( type == NAME_text)
format = CF_UNICODETEXT;
else
return errorPce(d, NAME_noSelectionType, type);
DEBUG(NAME_selection, Cprintf("%s becomes owner of %selection, type %s\n",
pp(d), pp(selection), pp(type)));
OpenClipboard(hwnd);
EmptyClipboard();
SetClipboardData(format, NULL);
CloseClipboard();
succeed;
}
IOSTREAM *
Sopen_object(Any obj, const char *mode)
{ if ( instanceOfObject(obj, ClassFile) )
{ Name name = getOsNameFile(obj);
IOSTREAM *s;
if ( (s=Sopen_file(nameToFN(name), mode)) )
{ if ( !strchr(mode, 'b') )
{ FileObj f = obj;
Name oldstat = f->status;
IOSTREAM *ofd = f->fd;
int rc;
/* HACKS */
f->status = (mode[0] == 'r' ? NAME_read : NAME_write);
f->fd = s;
switch(mode[0])
{ case 'r':
{ if ( (rc = doBOMFile(f)) )
setStreamEncodingSourceSink(obj, s);
break;
}
case 'w':
{ setStreamEncodingSourceSink(obj, s);
rc = doBOMFile(f);
break;
}
default:
{ setStreamEncodingSourceSink(obj, s);
rc = 0;
}
}
s->newline = (f->newline_mode == NAME_posix ? SIO_NL_POSIX :
f->newline_mode == NAME_dos ? SIO_NL_DOS :
SIO_NL_DETECT);
f->fd = ofd;
f->status = oldstat;
if ( !rc )
return NULL;
}
return s;
}
errorPce(obj, NAME_openFile,
mode[0] == 'r' ? NAME_read : NAME_write,
getOsErrorPce(PCE));
return s;
} else if ( instanceOfObject(obj, ClassRC) &&
TheCallbackFunctions.rc_open )
{ IOSTREAM *s;
RC rc = obj;
char *rc_class;
if ( notDefault(rc->rc_class) )
rc_class = strName(rc->rc_class);
else
rc_class = NULL;
if ( notNil(rc->context) && TheCallbackFunctions.setHostContext )
{ Any savedcontext =
(*TheCallbackFunctions.setHostContext)(rc->context);
s = (*TheCallbackFunctions.rc_open)(strName(rc->name),
rc_class,
mode);
(*TheCallbackFunctions.setHostContext)(savedcontext);
} else
s = (*TheCallbackFunctions.rc_open)(strName(rc->name),
rc_class,
mode);
if ( !s )
errorPce(obj, NAME_openFile,
mode[0] == 'r' ? NAME_read : NAME_write,
getOsErrorPce(PCE));
return s;
} else
{ int flags = SIO_TEXT|SIO_RECORDPOS;
OpenObject h;
IOSTREAM *stream;
switch(mode[0])
{ case 'r':
flags |= SIO_INPUT;
break;
case 'w':
flags |= SIO_OUTPUT;
break;
default:
errno = EINVAL;
return NULL;
}
for(mode++; *mode; mode++)
{ switch(*mode)
{ case 'b': /* binary */
flags &= ~SIO_TEXT;
break;
case 'r': /* no record */
flags &= ~SIO_RECORDPOS;
break;
default:
errno = EINVAL;
return NULL;
}
}
h = alloc(sizeof(*h));
h->point = 0;
h->object = obj;
addCodeReference(obj);
stream = Snew(h, flags, &Sobjectfunctions);
if ( (flags&SIO_TEXT) )
stream->encoding = ENC_WCHAR; /* see comment above */
else
stream->encoding = ENC_OCTET;
h->encoding = stream->encoding;
return stream;
}
}
static void
sigPipeSocket(void)
{ errorPce(PCE, NAME_brokenPipe, 0);
}
static status
initialiseBool(BoolObj b)
{ return errorPce(classOfObject(b), NAME_cannotCreateInstances);
}