static int readchar(Tcl_Channel f)
{
char c;
if (Tcl_Read(f, &c, 1) != 1) {
return (Tcl_Eof(f)) ? 0 : -1;
}
return c;
}
/* ARGSUSED */
int
Tcl_EofObjCmd(
ClientData unused, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_Eof(chan)));
return TCL_OK;
}
/* ARGSUSED */
int
Tcl_GetsObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to read from. */
int lineLen; /* Length of line just read. */
int mode; /* Mode in which channel is opened. */
Tcl_Obj *linePtr, *chanObjPtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
return TCL_ERROR;
}
chanObjPtr = objv[1];
if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
return TCL_ERROR;
}
if ((mode & TCL_READABLE) == 0) {
Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
"\" wasn't opened for reading", NULL);
return TCL_ERROR;
}
linePtr = Tcl_NewObj();
lineLen = Tcl_GetsObj(chan, linePtr);
if (lineLen < 0) {
if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
Tcl_DecrRefCount(linePtr);
/*
* TIP #219. Capture error messages put by the driver into the
* bypass area and put them into the regular interpreter result.
* Fall back to the regular message if nothing was found in the
* bypass.
*/
if (!TclChanCaughtErrorBypass(interp, chan)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error reading \"",
TclGetString(chanObjPtr), "\": ",
Tcl_PosixError(interp), NULL);
}
return TCL_ERROR;
}
lineLen = -1;
}
if (objc == 3) {
if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
return TCL_OK;
} else {
Tcl_SetObjResult(interp, linePtr);
}
return TCL_OK;
}
void TclTextInterp::doEvent() {
if (!done_waiting())
return;
// no recursive calls to TclEvalObj; this prevents
// display update ui from messing up Tcl.
if (callLevel)
return;
Tcl_Channel inChannel = Tcl_GetStdChannel(TCL_STDIN);
Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
if (needPrompt && consoleisatty) {
#if TCL_MINOR_VERSION >= 4
if (gotPartial) {
Tcl_WriteChars(outChannel, "? ", -1);
} else {
Tcl_WriteChars(outChannel, VMD_CMD_PROMPT, -1);
}
#else
if (gotPartial) {
Tcl_Write(outChannel, "? ", -1);
} else {
Tcl_Write(outChannel, VMD_CMD_PROMPT, -1);
}
#endif
#if defined(VMDTKCON)
vmdcon_purge();
#endif
Tcl_Flush(outChannel);
needPrompt = 0;
}
#if defined(VMD_NANOHUB)
return;
#endif
//
// MPI builds of VMD cannot try to read any command input from the
// console because it creates shutdown problems, at least with MPICH.
// File-based command input is fine however.
//
// For the time being, the Android builds won't attempt to get any
// console input. Any input we're going to get is going to come via
// some means other than stdin, such as a network socket, text box, etc.
//
if (ignorestdin)
return;
if (!vmd_check_stdin())
return;
//
// event loop based on tclMain.c
//
// According to the Tcl docs, GetsObj returns -1 on error or EOF.
int length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
if (Tcl_Eof(inChannel)) {
// exit if we're not a tty, or if eofexit is set
if ((!consoleisatty) || app->get_eofexit())
app->VMDexit("", 0, 0);
} else {
msgErr << "Error reading Tcl input: " << Tcl_ErrnoMsg(Tcl_GetErrno())
<< sendmsg;
}
return;
}
needPrompt = 1;
// add the newline removed by Tcl_GetsObj
Tcl_AppendToObj(commandPtr, "\n", 1);
char *stringrep = Tcl_GetStringFromObj(commandPtr, NULL);
if (!Tcl_CommandComplete(stringrep)) {
gotPartial = 1;
return;
}
gotPartial = 0;
callLevel++;
#if defined(VMD_NANOHUB)
Tcl_EvalObjEx(interp, commandPtr, 0);
#else
Tcl_RecordAndEvalObj(interp, commandPtr, 0);
#endif
callLevel--;
#if TCL_MINOR_VERSION >= 4
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
#else
// XXX this crashes Tcl 8.5.[46] with an internal panic
Tcl_SetObjLength(commandPtr, 0);
#endif
// if ok, send to stdout; if not, send to stderr
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
if (length > 0) {
vmdcon_append(VMDCON_ALWAYS, bytes,length);
vmdcon_append(VMDCON_ALWAYS, "\n", 1);
}
vmdcon_purge();
#else
if (length > 0) {
#if TCL_MINOR_VERSION >= 4
Tcl_WriteChars(outChannel, bytes, length);
Tcl_WriteChars(outChannel, "\n", 1);
#else
Tcl_Write(outChannel, bytes, length);
Tcl_Write(outChannel, "\n", 1);
#endif
}
Tcl_Flush(outChannel);
#endif
}
/*
** This routine runs first.
*/
int main(int argc, char **argv){
Tcl_Interp *interp;
char *args;
char buf[100];
int tty;
char TCLdir[20];
char TKdir[20];
char autopath[20];
char sourceCmd[80];
#ifdef WITHOUT_TK
Tcl_Obj *resultPtr;
Tcl_Obj *commandPtr = NULL;
char buffer[1000];
int code, gotPartial, length;
Tcl_Channel inChannel, outChannel, errChannel;
#endif
/* Create a Tcl interpreter
*/
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
if( Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1)==0 ){
return 1;
}
args = Tcl_Merge(argc-1, (CONST84 char * CONST *)argv+1);
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
ckfree(args);
sprintf(buf, "%d", argc-1);
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* We have to initialize the virtual filesystem before calling
** Tcl_Init(). Otherwise, Tcl_Init() will not be able to find
** its startup script files.
*/
Zvfs_Init(interp);
Tcl_SetVar(interp, "extname", "", TCL_GLOBAL_ONLY);
Zvfs_Mount(interp, (char *)Tcl_GetNameOfExecutable(), "/");
sprintf(TCLdir, "%s/tcl", mountPt);
Tcl_SetVar2(interp, "env", "TCL_LIBRARY", TCLdir, TCL_GLOBAL_ONLY);
sprintf(TKdir, "%s/tk", mountPt);
Tcl_SetVar2(interp, "env", "TK_LIBRARY", TKdir, TCL_GLOBAL_ONLY);
/* Initialize Tcl and Tk
*/
if( Tcl_Init(interp) ) return TCL_ERROR;
sprintf(autopath, " %s", TCLdir);
Tcl_SetVar(interp, "auto_path", autopath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_SetVar(interp, "tcl_libPath", TCLdir, TCL_GLOBAL_ONLY);
#ifdef WITHOUT_TK
Tcl_SetVar(interp, "extname", "tclsh", TCL_GLOBAL_ONLY);
#else
Tk_InitConsoleChannels(interp);
if ( Tk_Init(interp) ) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp,"Tk", Tk_Init, 0);
Tk_CreateConsoleWindow(interp);
#endif
/* Start up all extensions.
*/
#if defined(__WIN32__)
/* DRL - Do the standard Windows extentions */
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Registry", Registry_Init, 0);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Dde", Dde_Init, 0);
#endif
#ifndef WITHOUT_TDOM
if (Tdom_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tdom", Tdom_Init, Tdom_SafeInit);
#endif
#ifndef WITHOUT_TLS
if (Tls_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tls", Tls_Init, Tls_SafeInit);
#endif
/*
#ifndef WITHOUT_MKZIPLIB
if (Mkziplib_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Mkziplib", Mkziplib_Init, Mkziplib_SafeInit);
#endif
*/
#ifndef WITHOUT_XOTCL
if (Xotcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Xotcl", Xotcl_Init, Xotcl_SafeInit);
/*
if (Xotclexpat_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "xotclexpat", Xotclexpat_Init, 0);
*/
/*
if (Xotclsdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclsdbm", Xotclsdbm_Init, Xotclsdbm_SafeInit);
/*
if (Xotclgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
*/
// Tcl_StaticPackage(interp, "xotclgdbm", Xotclgdbm_Init, Xotclgdbm_SafeInit);
#endif
#ifndef WITHOUT_TGDBM
if (Tgdbm_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tgdbm", Tgdbm_Init, 0);
#endif
#ifndef WITHOUT_THREAD
if (Thread_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Thread", Thread_Init, 0);
#endif
#if !defined(WITHOUT_TK) && !defined(WITHOUT_WINICO) && (defined(__WIN32__) || defined(_WIN32))
if (Winico_Init(interp) == TCL_ERROR) return TCL_ERROR;
Tcl_StaticPackage(interp, "Winico", Winico_Init, Winico_SafeInit);
#endif
/* Add some freeWrap commands */
if (Freewrap_Init(interp) == TCL_ERROR) return TCL_ERROR;
/* After all extensions are registered, start up the
** program by running freewrapCmds.tcl.
*/
sprintf(sourceCmd, "source %s/freewrapCmds.tcl", mountPt);
Tcl_Eval(interp, sourceCmd);
#ifndef WITHOUT_TK
/*
* Loop infinitely, waiting for commands to execute. When there
* are no windows left, Tk_MainLoop returns and we exit.
*/
Tk_MainLoop();
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
#else
/*
* Process commands from stdin until there's an end-of-file. Note
* that we need to fetch the standard channels again after every
* eval, since they may have been changed.
*/
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
gotPartial = 0;
while (1) {
if (tty) {
Tcl_Obj *promptCmdPtr;
promptCmdPtr = Tcl_GetVar2Ex(interp,
(gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
NULL, TCL_GLOBAL_ONLY);
if (promptCmdPtr == NULL) {
defaultPrompt:
if (!gotPartial && outChannel) {
Tcl_WriteChars(outChannel, "% ", 2);
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
goto defaultPrompt;
}
}
if (outChannel) {
Tcl_Flush(outChannel);
}
}
if (!inChannel) {
goto done;
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
goto done;
}
if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
goto done;
}
/*
* Add the newline removed by Tcl_GetsObj back to the string.
*/
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
gotPartial = 1;
continue;
}
gotPartial = 0;
code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
Tcl_WriteObj(outChannel, resultPtr);
Tcl_WriteChars(outChannel, "\n", 1);
}
}
}
/*
* Rather than calling exit, invoke the "exit" command so that
* users can replace "exit" with some other command to do additional
* cleanup on exit. The Tcl_Eval call should never return.
*/
done:
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
sprintf(buffer, "exit %d", 0);
Tcl_Eval(interp, buffer);
#endif
return TCL_OK;
}
int
TclInterpreter::run() {
/*
* If a script file was specified then just source that file
* and quit.
*/
if (tclStartupScriptFileName != NULL) {
code = Tcl_EvalFile(interp, tclStartupScriptFileName);
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
/*
* The following statement guarantees that the errorInfo
* variable is set properly.
*/
Tcl_AddErrorInfo(interp, "");
Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
NULL, TCL_GLOBAL_ONLY));
Tcl_WriteChars(errChannel, "\n", 1);
}
exitCode = 1;
}
return 0;
}
else {
/*
const char *pwd = getInterpPWD(interp);
simulationInfo.start();
simulationInfo.addInputFile(tclStartupScriptFileName, pwd);
*/
/*
* We're running interactively. Source a user-specific startup
* file if the application specified one and if the file exists.
*/
Tcl_DStringFree(&argString);
Tcl_SourceRCFile(interp);
/*
* Process commands from stdin until there's an end-of-file. Note
* that we need to fetch the standard channels again after every
* eval, since they may have been changed.
*/
/*
if (simulationInfoOutputFilename != 0) {
simulationInfo.start();
}
*/
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
gotPartial = 0;
while (1) {
if (tty) {
Tcl_Obj *promptCmdPtr;
char one[12] = "tcl_prompt1";
char two[12] = "tcl_prompt2";
promptCmdPtr = Tcl_GetVar2Ex(interp,
(gotPartial ? one : two),
NULL, TCL_GLOBAL_ONLY);
if (promptCmdPtr == NULL) {
defaultPrompt:
if (!gotPartial && outChannel) {
Tcl_WriteChars(outChannel, "OpenSees > ", 11);
}
} else {
code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
Tcl_AddErrorInfo(interp,
"\n (script that generates prompt)");
goto defaultPrompt;
}
}
if (outChannel) {
Tcl_Flush(outChannel);
}
}
if (!inChannel) {
return 0;
// goto done;
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
return 0; //goto done;
}
if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
return 0; // goto done;
}
/*
* Add the newline removed by Tcl_GetsObj back to the string.
*/
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
gotPartial = 1;
continue;
}
gotPartial = 0;
code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
Tcl_WriteObj(outChannel, resultPtr);
Tcl_WriteChars(outChannel, "\n", 1);
}
}
#ifdef TCL_MEM_DEBUG
if (tclMemDumpFileName != NULL) {
Tcl_DecrRefCount(commandPtr);
Tcl_DeleteInterp(interp);
Tcl_Exit(0);
}
#endif
}
}
return 0;
}
int tclcommand_readmd(ClientData dummy, Tcl_Interp *interp,
int argc, char **argv)
{
char *row;
int pos_row[3] = { -1 }, v_row[3] = { -1 },
#ifdef DIPOLES
dip_row[3] = { -1 },
#endif
f_row[3] = { -1 };
int av_pos = 0, av_v = 0,
#ifdef DIPOLES
av_dip=0,
#endif
#ifdef MASS
av_mass=0,
#endif
#ifdef SHANCHEN
av_solvation=0,
#endif
av_f = 0,
#ifdef ELECTROSTATICS
av_q = 0,
#endif
av_type = 0;
int node, i;
struct MDHeader header;
Particle data;
int tcl_file_mode;
Tcl_Channel channel;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " <file>\"",
(char *) NULL);
return (TCL_ERROR);
}
if ((channel = Tcl_GetChannel(interp, argv[1], &tcl_file_mode)) == NULL)
return (TCL_ERROR);
/* tune channel to binary translation, e.g. none */
Tcl_SetChannelOption(interp, channel, "-translation", "binary");
Tcl_Read(channel, (char *)&header, sizeof(header));
/* check token */
if (strncmp(header.magic, MDMAGIC, 4) || header.n_rows < 0) {
Tcl_AppendResult(interp, "data file \"", argv[1],
"\" does not contain tcl MD data",
(char *) NULL);
return (TCL_ERROR);
}
if (!particle_node)
build_particle_node();
/* parse rows */
row = (char*)malloc(header.n_rows*sizeof(char));
for (i = 0; i < header.n_rows; i++) {
Tcl_Read(channel, (char *)&row[i], sizeof(char));
switch (row[i]) {
case POSX: pos_row[0] = i; break;
case POSY: pos_row[1] = i; break;
case POSZ: pos_row[2] = i; break;
case VX: v_row[0] = i; break;
case VY: v_row[1] = i; break;
case VZ: v_row[2] = i; break;
#ifdef DIPOLES
case MX: dip_row[0] = i; break;
case MY: dip_row[1] = i; break;
case MZ: dip_row[2] = i; break;
#endif
case FX: f_row[0] = i; break;
case FY: f_row[1] = i; break;
case FZ: f_row[2] = i; break;
#ifdef MASS
case MASSES: av_mass = 1; break;
#endif
#ifdef SHANCHEN
case SOLVATION: av_solvation = 1; break;
#endif
#ifdef ELECTROSTATICS
case Q: av_q = 1; break;
#endif
case TYPE: av_type = 1; break;
}
}
/* *_row[0] tells if * data is completely available -
* otherwise we ignore it */
if (pos_row[0] != -1 && pos_row[1] != -1 && pos_row[2] != -1) {
av_pos = 1;
}
if (v_row[0] != -1 && v_row[1] != -1 && v_row[2] != -1) {
av_v = 1;
}
if (f_row[0] != -1 && f_row[1] != -1 && f_row[2] != -1) {
av_f = 1;
}
#ifdef DIPOLES
if (dip_row[0] != -1 && dip_row[1] != -1 && dip_row[2] != -1) {
av_dip = 1;
}
#endif
while (!Tcl_Eof(channel)) {
Tcl_Read(channel, (char *)&data.p.identity, sizeof(int));
if (data.p.identity == -1)
break;
/* printf("id=%d\n", data.identity); */
if (data.p.identity < 0) {
Tcl_AppendResult(interp, "illegal data format in data file \"", argv[1],
"\", perhaps wrong file?",
(char *) NULL);
free(row);
return (TCL_ERROR);
}
for (i = 0; i < header.n_rows; i++) {
switch (row[i]) {
case POSX: Tcl_Read(channel, (char *)&data.r.p[0], sizeof(double)); break;
case POSY: Tcl_Read(channel, (char *)&data.r.p[1], sizeof(double)); break;
case POSZ: Tcl_Read(channel, (char *)&data.r.p[2], sizeof(double)); break;
case VX: Tcl_Read(channel, (char *)&data.m.v[0], sizeof(double)); break;
case VY: Tcl_Read(channel, (char *)&data.m.v[1], sizeof(double)); break;
case VZ: Tcl_Read(channel, (char *)&data.m.v[2], sizeof(double)); break;
case FX: Tcl_Read(channel, (char *)&data.f.f[0], sizeof(double)); break;
case FY: Tcl_Read(channel, (char *)&data.f.f[1], sizeof(double)); break;
case FZ: Tcl_Read(channel, (char *)&data.f.f[2], sizeof(double)); break;
case MASSES:
#ifdef MASS
Tcl_Read(channel, (char *)&data.p.mass, sizeof(double)); break;
#else
{
double dummy_mass;
Tcl_Read(channel, (char *)&dummy_mass, sizeof(double)); break;
}
#endif
#ifdef ELECTROSTATICS
case Q: Tcl_Read(channel, (char *)&data.p.q, sizeof(double)); break;
#endif
#ifdef DIPOLES
case MX: Tcl_Read(channel, (char *)&data.r.dip[0], sizeof(double)); break;
case MY: Tcl_Read(channel, (char *)&data.r.dip[1], sizeof(double)); break;
case MZ: Tcl_Read(channel, (char *)&data.r.dip[2], sizeof(double)); break;
#endif
case TYPE: Tcl_Read(channel, (char *)&data.p.type, sizeof(int)); break;
}
}
node = (data.p.identity <= max_seen_particle) ? particle_node[data.p.identity] : -1;
if (node == -1) {
if (!av_pos) {
Tcl_AppendResult(interp, "new particle without position data",
(char *) NULL);
free(row);
return (TCL_ERROR);
}
}
if (av_pos)
place_particle(data.p.identity, data.r.p);
#ifdef MASS
if (av_mass)
set_particle_mass(data.p.identity, data.p.mass);
#endif
#ifdef SHANCHEN
if (av_solvation)
set_particle_solvation(data.p.identity, data.p.solvation);
#endif
#ifdef ELECTROSTATICS
if (av_q)
set_particle_q(data.p.identity, data.p.q);
#endif
#ifdef DIPOLES
if (av_dip)
set_particle_dip(data.p.identity, data.r.dip);
#endif
if (av_v)
set_particle_v(data.p.identity, data.m.v);
if (av_f)
set_particle_f(data.p.identity, data.f.f);
if (av_type)
set_particle_type(data.p.identity, data.p.type);
}
free(row);
return TCL_OK;
}
static int
FileReadPPM(
Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
Tcl_Channel chan, /* The image file, open for reading. */
CONST char *fileName, /* The name of the image file. */
Tcl_Obj *format, /* User-specified format string, or NULL. */
Tk_PhotoHandle imageHandle, /* The photo image to write into. */
int destX, int destY, /* Coordinates of top-left pixel in photo
* image to be written to. */
int width, int height, /* Dimensions of block of photo image to be
* written to. */
int srcX, int srcY) /* Coordinates of top-left pixel to be used in
* image being read. */
{
int fileWidth, fileHeight, maxIntensity;
int nLines, nBytes, h, type, count;
unsigned char *pixelPtr;
Tk_PhotoImageBlock block;
type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity);
if (type == 0) {
Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"",
fileName, "\"", NULL);
return TCL_ERROR;
}
if ((fileWidth <= 0) || (fileHeight <= 0)) {
Tcl_AppendResult(interp, "PPM image file \"", fileName,
"\" has dimension(s) <= 0", NULL);
return TCL_ERROR;
}
if ((maxIntensity <= 0) || (maxIntensity >= 256)) {
char buffer[TCL_INTEGER_SPACE];
sprintf(buffer, "%d", maxIntensity);
Tcl_AppendResult(interp, "PPM image file \"", fileName,
"\" has bad maximum intensity value ", buffer, NULL);
return TCL_ERROR;
}
if ((srcX + width) > fileWidth) {
width = fileWidth - srcX;
}
if ((srcY + height) > fileHeight) {
height = fileHeight - srcY;
}
if ((width <= 0) || (height <= 0)
|| (srcX >= fileWidth) || (srcY >= fileHeight)) {
return TCL_OK;
}
if (type == PGM) {
block.pixelSize = 1;
block.offset[0] = 0;
block.offset[1] = 0;
block.offset[2] = 0;
} else {
block.pixelSize = 3;
block.offset[0] = 0;
block.offset[1] = 1;
block.offset[2] = 2;
}
block.offset[3] = 0;
block.width = width;
block.pitch = block.pixelSize * fileWidth;
if (Tk_PhotoExpand(interp, imageHandle,
destX + width, destY + height) != TCL_OK) {
return TCL_ERROR;
}
if (srcY > 0) {
Tcl_Seek(chan, (Tcl_WideInt)(srcY * block.pitch), SEEK_CUR);
}
nLines = (MAX_MEMORY + block.pitch - 1) / block.pitch;
if (nLines > height) {
nLines = height;
}
if (nLines <= 0) {
nLines = 1;
}
nBytes = nLines * block.pitch;
pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
block.pixelPtr = pixelPtr + srcX * block.pixelSize;
for (h = height; h > 0; h -= nLines) {
if (nLines > h) {
nLines = h;
nBytes = nLines * block.pitch;
}
count = Tcl_Read(chan, (char *) pixelPtr, nBytes);
if (count != nBytes) {
Tcl_AppendResult(interp, "error reading PPM image file \"",
fileName, "\": ",
Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp),
NULL);
ckfree((char *) pixelPtr);
return TCL_ERROR;
}
if (maxIntensity != 255) {
unsigned char *p;
for (p = pixelPtr; count > 0; count--, p++) {
*p = (((int) *p) * 255)/maxIntensity;
}
}
block.height = nLines;
if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY,
width, nLines, TK_PHOTO_COMPOSITE_SET) != TCL_OK) {
ckfree((char *) pixelPtr);
return TCL_ERROR;
}
destY += nLines;
}
ckfree((char *) pixelPtr);
return TCL_OK;
}
static int
TransformInputProc(
ClientData instanceData,
char *buf,
int toRead,
int *errorCodePtr)
{
TransformChannelData *dataPtr = instanceData;
int gotBytes, read, copied;
Tcl_Channel downChan;
/*
* Should assert(dataPtr->mode & TCL_READABLE);
*/
if (toRead == 0) {
/*
* Catch a no-op.
*/
return 0;
}
gotBytes = 0;
downChan = Tcl_GetStackedChannel(dataPtr->self);
while (toRead > 0) {
/*
* Loop until the request is satisfied (or no data is available from
* below, possibly EOF).
*/
copied = ResultCopy(&dataPtr->result, UCHARP(buf), toRead);
toRead -= copied;
buf += copied;
gotBytes += copied;
if (toRead == 0) {
/*
* The request was completely satisfied from our buffers. We can
* break out of the loop and return to the caller.
*/
return gotBytes;
}
/*
* Length (dataPtr->result) == 0, toRead > 0 here. Use the incoming
* 'buf'! as target to store the intermediary information read from
* the underlying channel.
*
* Ask the tcl level how much data it allows us to read from the
* underlying channel. This feature allows the transform to signal EOF
* upstream although there is none downstream. Useful to control an
* unbounded 'fcopy', either through counting bytes, or by pattern
* matching.
*/
ExecuteCallback(dataPtr, NULL, A_QUERY_MAXREAD, NULL, 0,
TRANSMIT_NUM /* -> maxRead */, P_PRESERVE);
if (dataPtr->maxRead >= 0) {
if (dataPtr->maxRead < toRead) {
toRead = dataPtr->maxRead;
}
} /* else: 'maxRead < 0' == Accept the current value of toRead. */
if (toRead <= 0) {
return gotBytes;
}
/*
* Get bytes from the underlying channel.
*/
read = Tcl_ReadRaw(downChan, buf, toRead);
if (read < 0) {
/*
* Report errors to caller. EAGAIN is a special situation. If we
* had some data before we report that instead of the request to
* re-try.
*/
if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
return gotBytes;
}
*errorCodePtr = Tcl_GetErrno();
return -1;
} else if (read == 0) {
/*
* Check wether we hit on EOF in the underlying channel or not. If
* not differentiate between blocking and non-blocking modes. In
* non-blocking mode we ran temporarily out of data. Signal this
* to the caller via EWOULDBLOCK and error return (-1). In the
* other cases we simply return what we got and let the caller
* wait for more. On the other hand, if we got an EOF we have to
* convert and flush all waiting partial data.
*/
if (!Tcl_Eof(downChan)) {
if ((gotBytes == 0) && (dataPtr->flags & CHANNEL_ASYNC)) {
*errorCodePtr = EWOULDBLOCK;
return -1;
}
return gotBytes;
}
if (dataPtr->readIsFlushed) {
/*
* Already flushed, nothing to do anymore.
*/
return gotBytes;
}
dataPtr->readIsFlushed = 1;
ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
TRANSMIT_IBUF, P_PRESERVE);
if (ResultEmpty(&dataPtr->result)) {
/*
* We had nothing to flush.
*/
return gotBytes;
}
continue; /* at: while (toRead > 0) */
} /* read == 0 */
/*
* Transform the read chunk and add the result to our read buffer
* (dataPtr->result).
*/
if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
*errorCodePtr = EINVAL;
return -1;
}
} /* while toRead > 0 */
return gotBytes;
}
