int parse_vector (Tcl_Obj * const obj, std::vector<float> &vec, Tcl_Interp *interp)
{
Tcl_Obj **data;
int num;
double d;
if (Tcl_ListObjGetElements(interp, obj, &num, &data) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing arguments", TCL_STATIC);
return -1;
}
vec.resize(num);
for (int i = 0; i < num; i++) {
if (Tcl_GetDoubleFromObj(interp, data[i], &d) != TCL_OK) {
Tcl_SetResult(interp, (char *) "Cgmap: error parsing vector element as floating-point", TCL_STATIC);
return -1;
}
// Tcl gives us doubles, make them float
vec[i] = float (d);
}
return num;
}
static int
MyInitTkStubs (Tcl_Interp *ip)
{
if (Tcl_PkgRequireEx(ip, "Tk", "8.1", 0, (ClientData*) &tkStubsPtr) == NULL) return 0;
if (tkStubsPtr == NULL || tkStubsPtr->hooks == NULL) {
Tcl_SetResult(ip, "This extension requires Tk stubs-support.", TCL_STATIC);
return 0;
}
tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs;
tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs;
tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs;
tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs;
return 1;
}
MODULE_SCOPE int
TclpLoadMemory(
Tcl_Interp *interp, /* Used for error reporting. */
void *buffer, /* Dummy: unused by this implementation */
int size, /* Dummy: unused by this implementation */
int codeSize, /* Dummy: unused by this implementation */
Tcl_LoadHandle *loadHandle, /* Dummy: unused by this implementation */
Tcl_FSUnloadFileProc **unloadProcPtr)
/* Dummy: unused by this implementation */
{
Tcl_SetResult(interp, "dynamic loading from memory is not available "
"on this system", TCL_STATIC);
return TCL_ERROR;
}
static VALUE rb_tcl_interp_send_begin(VALUE args) {
VALUE obj = rb_ary_entry(args, 0);
VALUE interp_receive_args = rb_ary_entry(args, 1);
VALUE result = rb_funcall2(obj, rb_intern("interp_receive"), RARRAY_LEN(interp_receive_args), RARRAY_PTR(interp_receive_args));
tcl_interp_struct *tcl_interp;
Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
char *tcl_result = strdup(RSTRING_PTR(rb_value_to_s(result)));
Tcl_SetResult(tcl_interp->interp, tcl_result, (Tcl_FreeProc *)free);
return Qtrue;
}
static TclHashTable *get_hash_table(Tcl_Interp *interp,
char *type)
{
static Tcl_HashTable *hash_table = 0;
if (! hash_table) {
if (! (hash_table = malloc(sizeof(*hash_table)))) {
Tcl_SetResult(interp, memory_error, TCL_STATIC);
return 0;
}
Tcl_InitHashTable(hash_table, TCL_STRING_KEYS);
}
return hash_table;
}
int ScriptTcl::Tcl_replicaDcdFile(ClientData clientData,
Tcl_Interp *interp, int argc, char *argv[]) {
#ifdef MEM_OPT_VERSION
Tcl_SetResult(interp,"replicaDcdFile not supported in memory-optimized builds",TCL_VOLATILE);
return TCL_ERROR;
#endif
ScriptTcl *script = (ScriptTcl *)clientData;
script->initcheck();
int index;
int cmpoff;
if (argc < 2 || argc > 3 || ((cmpoff = strcmp(argv[1],"off")) != 0 && sscanf(argv[1],"%d",&index) != 1) ) {
Tcl_SetResult(interp,"args: <index>|off ?<filename>?",TCL_VOLATILE);
return TCL_ERROR;
}
if ( argc == 2 ) {
if ( cmpoff == 0 ) Node::Object()->output->replicaDcdOff();
else Node::Object()->output->setReplicaDcdIndex(index);
} else if ( argc == 3 ) {
Node::Object()->output->replicaDcdInit(index,argv[2]);
script->barrier();
}
return TCL_OK;
}
/* ********************************************************
Nwrite_tif -
Save current GL screen to a TIFF file.
Arguments:
String - name of file to save to.
Returns:
None.
Side Effects:
Saves the current GL screen to the given file.
******************************************************** */
int Nwrite_tif_cmd(Nv_data * data, /* Local data */
Tcl_Interp * interp, /* Current interpreter */
int argc, /* Number of arguments */
char **argv /* Argument strings */
)
{
/* Parse arguments */
if (argc != 2) {
Tcl_SetResult(interp, "Error: should be Nwrite_ppm file_name", TCL_VOLATILE);
return (TCL_ERROR);
}
#ifdef HAVE_TIFFIO_H
/* Call the function */
GS_write_tif(argv[1]);
#else
Tcl_SetResult(interp, "Error: no TIFF support", TCL_VOLATILE);
return (TCL_ERROR);
#endif
return (TCL_OK);
}
static VALUE rb_tcl_interp_send_rescue(VALUE args, VALUE error_info) {
VALUE obj = rb_ary_entry(args, 0);
tcl_interp_struct *tcl_interp;
Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
char *tcl_result = strdup(RSTRING_PTR(rb_value_to_s(error_info)));
Tcl_SetResult(tcl_interp->interp, tcl_result, (Tcl_FreeProc *)free);
if (rb_obj_is_kind_of(error_info, rb_eSystemExit)) {
tcl_interp->exit_exception = error_info;
}
return Qfalse;
}
int tcl_pmepot_add(ClientData nodata, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]) {
int cell_count, atom_count, sub_count, i, j;
Tcl_Obj **cell_list, **atom_list, **sub_list;
float cell[12], *atoms;
double d;
pmepot_data *data;
if ( objc != 4 ) {
Tcl_SetResult(interp,"args: handle {{o...} {a...} {b...} {c...}} {{x y z q}...}",TCL_VOLATILE);
return TCL_ERROR;
}
data = Tcl_GetAssocData(interp, Tcl_GetString(objv[1]), 0);
if ( ! data ) {
Tcl_SetResult(interp,"Pmepot bug: unable to access handle.",TCL_VOLATILE);
return TCL_ERROR;
}
if ( Tcl_ListObjGetElements(interp,objv[2],&cell_count,&cell_list) != TCL_OK ) return TCL_ERROR;
if ( cell_count != 4 ) {
Tcl_SetResult(interp,"cell format: {{ox oy oz} {ax ay az} {bx by bz} {cx cy cz}}",TCL_VOLATILE);
return TCL_ERROR;
}
for ( i=0; i<4; ++i ) {
if ( Tcl_ListObjGetElements(interp,cell_list[i],&sub_count,&sub_list) != TCL_OK ) return TCL_ERROR;
if ( sub_count != 3 ) {
Tcl_SetResult(interp,"cell format: {{ox oy oz} {ax ay az} {bx by bz} {cx cy cz}}",TCL_VOLATILE);
return TCL_ERROR;
}
for ( j=0; j<3; ++j ) {
if ( Tcl_GetDoubleFromObj(interp,sub_list[j],&d) != TCL_OK ) return TCL_ERROR;
cell[3*i+j] = d;
}
}
if ( Tcl_ListObjGetElements(interp,objv[3],&atom_count,&atom_list) != TCL_OK ) return TCL_ERROR;
atoms = malloc(atom_count*4*sizeof(float));
for ( i=0; i<atom_count; ++i ) {
if ( Tcl_ListObjGetElements(interp,atom_list[i],&sub_count,&sub_list) != TCL_OK ) { free(atoms); return TCL_ERROR; }
if ( sub_count != 4 ) {
Tcl_SetResult(interp,"atoms format: {{x y z q}...}",TCL_VOLATILE);
free(atoms); return TCL_ERROR;
}
for ( j=0; j<4; ++j ) {
if ( Tcl_GetDoubleFromObj(interp,sub_list[j],&d) != TCL_OK ) { free(atoms); return TCL_ERROR; }
atoms[4*i+j] = d;
}
}
if ( pmepot_add(data,cell,atom_count,atoms) ) {
Tcl_SetResult(interp,"Pmepot bug: pmepot_add failed.",TCL_VOLATILE);
free(atoms);
return TCL_ERROR;
}
free(atoms);
return TCL_OK;
}
/*******************************************************************************
* dhsSysOpenTcl ( ... )
* Use: set sID [dhs::SysOpen <systemID>]
*******************************************************************************/
static int dhsSysOpenTcl ( ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) {
/* declare local scope variable and initialize them */
dhsHandle sID=(dhsHandle)0;
int whoami=0;
long lstat=0;
char obsID[DHS_IMPL_MAXSTR];
(void) memset(obsID,'\0',DHS_IMPL_MAXSTR);
/* initialize static variables */
(void) memset(response,'\0',MAXMSG);
(void) memset(result,'\0',DHS_RESULT_LEN);
/* check systemID */
if ( Tcl_GetInt(interp,argv[1],&whoami) != TCL_OK ) {
(void) sprintf(result,"%s","dhsSysOpenTcl-E-bad system id\n");
(void) Tcl_SetResult(interp,result,TCL_STATIC);
return TCL_ERROR;
}
#ifdef DEBUGTCL
(void) fprintf(stderr,"dhs::SysOpen>> whoami=%d (0x%x)\n",(XLONG)whoami,(unsigned XLONG)whoami); (void) fflush(stderr);
#endif
/* execute the dhs function */
dhsSysOpen(&lstat,response,&sID,(long)whoami);
if ( STATUS_BAD(lstat) ) {
(void) Tcl_SetResult(interp,response,TCL_STATIC);
return TCL_ERROR;
}
#ifdef DEBUGTCL
(void) fprintf(stderr,"dhs::SysOpen>> lstat=%ld, sID=%d\n",lstat,(int)sID); (void) fflush(stderr);
#endif
/* return result */
(void) sprintf(result,"%d",(int)sID);
#ifdef DEBUGTCL
(void) fprintf(stderr,"dhs::SysOpen>> response=\"%s\"\n",response); (void) fflush(stderr);
(void) fprintf(stderr,"dhs::SysOpen>> result=\"%s\"\n",result); (void) fflush(stderr);
#endif
(void) Tcl_SetResult(interp,result,TCL_STATIC);
return TCL_OK;
}
static int UUTCLFUNC
uutcl_EncodeToFile (ClientData clientData, Tcl_Interp *interp,
int argc, char *argv[])
{
int encoding=UU_ENCODED, linperfile=0, res;
char errstring[256], olddir[256];
if (argc < 3 || argc > 10) {
Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
return TCL_ERROR;
}
uutcl_UpdateParameter (interp);
if (uutcl_GetEncodeParams (interp, argc, argv,
7, &encoding,
6, &linperfile) != TCL_OK)
return TCL_ERROR;
UUGetOption (UUOPT_SAVEPATH, NULL, olddir, 256);
UUSetOption (UUOPT_SAVEPATH, 0, argv[2]);
if ((res = UUEncodeToFile (NULL, argv[1], encoding,
(argc>3) ? argv[3] : NULL,
(argc>2) ? argv[2] : NULL,
linperfile)) != UURET_OK) {
UUSetOption (UUOPT_SAVEPATH, 0, olddir);
sprintf (errstring, "error while encoding %s to file: %s (%s)", argv[1],
UUstrerror(res),
(res==UURET_IOERR)?
strerror(UUGetOption(UUOPT_ERRNO,NULL,NULL,0)):"");
Tcl_SetResult (interp, errstring, TCL_VOLATILE);
return TCL_ERROR;
}
UUSetOption (UUOPT_SAVEPATH, 0, olddir);
return TCL_OK;
}
static int
getresid(Tcl_Interp *interp, CONST84 char *id, Pg_ConnectionId ** connid_p)
{
Tcl_Channel conn_chan;
char *mark;
int resid;
Pg_ConnectionId *connid;
if (!(mark = strchr(id, '.')))
return -1;
*mark = '\0';
conn_chan = Tcl_GetChannel(interp, id, 0);
*mark = '.';
if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
{
Tcl_SetResult(interp, "Invalid connection handle", TCL_STATIC);
return -1;
}
if (Tcl_GetInt(interp, mark + 1, &resid) == TCL_ERROR)
{
Tcl_SetResult(interp, "Poorly formated result handle", TCL_STATIC);
return -1;
}
connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);
if (resid < 0 || resid >= connid->res_max || connid->results[resid] == NULL)
{
Tcl_SetResult(interp, "Invalid result handle", TCL_STATIC);
return -1;
}
*connid_p = connid;
return resid;
}
int Noff_screen_cmd(Nv_data * data, /* Local data */
Tcl_Interp * interp, /* Current interpreter */
int argc, /* Number of arguments */
char **argv /* Argument strings */
)
{
int flag;
int x, y;
int width, height, maxx, maxy;
/* Parse arguments */
if (argc != 2) {
Tcl_SetResult(interp, "Error: should be Noff_screen flag", TCL_VOLATILE);
return (TCL_ERROR);
}
flag = atoi(argv[1]);
GS_zoom_setup(&x, &y, &width, &height, &maxx, &maxy);
if (flag == 1) {
if (Create_OS_Ctx(width, height) == -1) {
Tcl_SetResult(interp, "Error: Off screen context returned error", TCL_VOLATILE);
return (TCL_ERROR);
}
}
else {
if (Destroy_OS_Ctx() == -1) {
Tcl_SetResult(interp, "Error: Destroy context returned error", TCL_VOLATILE);
return (TCL_ERROR);
}
}
return (TCL_OK);
}
/* after initial data has been loaded, & maybe again later */
int Nget_height_cmd(Nv_data * data, Tcl_Interp * interp, /* Current interpreter. */
int argc, char **argv)
{
float longdim, exag, texag, hmin, hmax;
int nsurfs, i, *surf_list;
char min[128];
char max[128];
char val[128];
float fmin, fmax;
char *list[4];
surf_list = GS_get_surf_list(&nsurfs);
if (nsurfs) {
GS_get_longdim(&longdim);
GS_get_zrange_nz(&hmin, &hmax);
exag = 0.0;
for (i = 0; i < nsurfs; i++) {
if (GS_get_exag_guess(surf_list[i], &texag) > -1)
if (texag)
exag = texag > exag ? texag : exag;
}
if (exag == 0.0)
exag = 1.0;
fmin = hmin - (2. * longdim / exag);
fmax = hmin + (3 * longdim / exag);
}
else {
fmax = 10000.0;
fmin = 0.0;
}
/* The one decimal place of accuracy is necessary to force Tcl to */
/* parse these values as floating point rather than integers. This */
/* avoids problems with integers which are too large to represent. */
sprintf(min, "%.1f", fmin);
sprintf(max, "%.1f", fmax);
sprintf(val, "%.1f", fmin + (fmax - fmin) / 2.0);
list[0] = val;
list[1] = min;
list[2] = max;
list[3] = NULL;
Tcl_SetResult(interp, Tcl_Merge(3, list), TCL_DYNAMIC);
return TCL_OK;
}
SWIG_Tcl_ConvertPtrFromString(Tcl_Interp *interp, char *c, void **ptr, swig_type_info *ty, int flags) {
swig_type_info *tc;
/* Pointer values must start with leading underscore */
while (*c != '_') {
*ptr = (void *) 0;
if (strcmp(c,"NULL") == 0) return TCL_OK;
/* Hmmm. It could be an object name. */
if (Tcl_VarEval(interp,c," cget -this", (char *) NULL) == TCL_OK) {
Tcl_Obj *result = Tcl_GetObjResult(interp);
c = Tcl_GetStringFromObj(result, NULL);
continue;
}
Tcl_ResetResult(interp);
if (flags & SWIG_POINTER_EXCEPTION)
Tcl_SetResult(interp, (char *) "Type error. Expected a pointer", TCL_STATIC);
return TCL_ERROR;
}
c++;
c = SWIG_UnpackData(c,ptr,sizeof(void *));
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if ((!tc) && (flags & SWIG_POINTER_EXCEPTION)) {
Tcl_SetResult(interp, (char *) "Type error. Expected ", TCL_STATIC);
Tcl_AppendElement(interp, (char *) ty->name);
return TCL_ERROR;
} else if (!tc) {
Tcl_ResetResult(interp);
return TCL_ERROR;
}
if (flags & SWIG_POINTER_DISOWN) {
SWIG_Disown((void *) *ptr);
}
*ptr = SWIG_TypeCast(tc,(void *) *ptr);
}
return TCL_OK;
}
/*******************************************************************************
* dhsSysCloseTcl ( ... )
* Use: set dhsStat [dhs::SysClose <sID>]
*******************************************************************************/
static int dhsSysCloseTcl ( ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) {
/* declare local scope variable and initialize them */
dhsHandle sID=(dhsHandle)0;
int ival=0;
long lstat=0;
/* initialize static variables */
(void) memset(response,'\0',MAXMSG);
(void) memset(result,'\0',DHS_RESULT_LEN);
/* check handle */
if ( Tcl_GetInt(interp,argv[1],&ival) != TCL_OK ) {
(void) sprintf(result,"%s","dhsSysCloseTcl-E-bad handle\n");
(void) Tcl_SetResult(interp,result,TCL_STATIC);
return TCL_ERROR;
}
sID = (dhsHandle)ival;
#ifdef DEBUGTCL
(void) fprintf(stderr,"dhs::SysClose>> sID=%d\n",(int)sID); (void) fflush(stderr);
#endif
/* execute the dhs function */
dhsSysClose(&lstat,response,sID);
if ( STATUS_BAD(lstat) ) {
(void) Tcl_SetResult(interp,response,TCL_STATIC);
return TCL_ERROR;
}
#ifdef DEBUGTCL
(void) fprintf(stderr,"dhs::SysClose>> lstat=%ld\n",lstat); (void) fflush(stderr);
#endif
/* return result */
(void) sprintf(result,"%ld",lstat);
#ifdef DEBUGTCL
(void) fprintf(stderr,"dhs::SysClose>> response=\"%s\"\n",response); (void) fflush(stderr);
(void) fprintf(stderr,"dhs::SysClose>> result=\"%s\"\n",result); (void) fflush(stderr);
#endif
(void) Tcl_SetResult(interp,result,TCL_STATIC);
return TCL_OK;
}
/*******************************************************************************
* dhsHelpTcl ( ... )
* Use: dhs::help
*******************************************************************************/
static int dhsHelpTcl ( ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) {
/* declare local scope variable and initialize them */
int ic=0, nc=0, room=DHS_TRUE;
/* initialize static variables */
(void) memset(response,'\0',MAXMSG);
(void) memset(result,'\0',DHS_RESULT_LEN);
/* write out everything else */
for ( ic=0; ic<NM_NUM; ic++ ) {
if ( ! (room=( (DHS_HELP_LEN-nc) > (DHS_NAME_LEN+(DHS_ITEM_LEN*2)) ? DHS_TRUE : DHS_FALSE )) ) break;
nc += sprintf((char *)&response[nc],"%s %s %s\n",NM[ic].item,HP[ic].item,EG[ic].item);
}
/* set result and return */
(void) Tcl_SetResult(interp,response,TCL_STATIC);
return TCL_OK;
}
int NS(pErrorFromMq) (
Tcl_Interp * interp,
struct MqS * const mqctx
)
{
Tcl_Obj *objv[4];
objv[0] = Tcl_NewStringObj ("TCLMSGQUE", -1);
objv[1] = Tcl_NewIntObj (MqErrorGetNumI(mqctx));
objv[2] = Tcl_NewIntObj (MqErrorGetCodeI(mqctx));
objv[3] = Tcl_NewStringObj (MqErrorGetText(mqctx), -1);
Tcl_SetObjErrorCode (interp, Tcl_NewListObj (4, objv));
Tcl_SetResult(interp, (MQ_STR) MqErrorGetText(mqctx), TCL_VOLATILE);
MqErrorReset(mqctx);
return TCL_ERROR;
}
/* ********************************************************
Nmove_key --
Move a keyframe.
Arguments:
Floating point old position (i.e. time)
Floating point precision
Floating point new position (i.e. time)
Returns:
Number of keys moved (either 1 or 0)
Side Effects:
Moves the specified key from old_position +- precision
to new_position +- precision
******************************************************** */
int Nmove_key_cmd(Nv_data * data, /* Local data */
Tcl_Interp * interp, /* Current interpreter */
int argc, /* Number of arguments */
char **argv /* Argument strings */
)
{
/* Parse arguments */
double new_pos, old_pos, precis;
int num_moved;
char tmp[10];
if (argc != 4) {
Tcl_SetResult(interp, "Error: should be Nmove_key oldpos precis newpos", TCL_VOLATILE);
return (TCL_ERROR);
}
if (Tcl_GetDouble(interp, argv[1], &old_pos) != TCL_OK)
return TCL_ERROR;
if (Tcl_GetDouble(interp, argv[2], &precis) != TCL_OK)
return TCL_ERROR;
if (Tcl_GetDouble(interp, argv[3], &new_pos) != TCL_OK)
return TCL_ERROR;
/* Call the function */
num_moved = GK_move_key((float)old_pos, (float)precis, (float)new_pos);
G_debug(3, "Arguments to move_key %f %f %f\n",
(float)old_pos, (float)precis, (float)new_pos);
G_debug(3, "Frames moved = %d\n", num_moved);
sprintf(tmp, "%d", num_moved);
Tcl_SetResult(interp, tmp, TCL_VOLATILE);
return (TCL_OK);
}
int fbsql_selectdb(Tcl_Interp *interp, int sql_number, int argc, char **argv) {
char *database = NULL;
/* check a database name argument has been specified */
if (argc <= 0 || argv[0] == NULL) {
Tcl_SetResult(interp, "sql selectdb database_name; no database name was specified.", TCL_STATIC);
return TCL_ERROR;
}
/* check that we are connected to a mysql server */
if (!connection[sql_number].CONNECTED) {
Tcl_SetResult(interp, "sql query statement; you are not connected to a mysql server yet (sql connect).", TCL_STATIC);
return TCL_ERROR;
}
database = argv[0];
if (mysql_select_db(&connection[sql_number].mysql,database)) {
output_error(interp,sql_number);
return TCL_ERROR;
} else {
return TCL_OK;
}
}
int ScriptTcl::Tcl_replicaAtomSend(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) {
ScriptTcl *script = (ScriptTcl *)clientData;
script->initcheck();
if ( ! Node::Object()->simParameters->replicaUniformPatchGrids ) {
Tcl_SetResult(interp,"replicaUniformPatchGrids is required for atom exchange",TCL_VOLATILE);
return TCL_ERROR;
}
if ( argc != 2 ) {
Tcl_SetResult(interp,"bad arg count; args: dest",TCL_VOLATILE);
return TCL_ERROR;
}
int dest = -1;
if ( sscanf(argv[1], "%d", &dest) != 1 ) {
Tcl_SetResult(interp,"bad dest; args: dest",TCL_VOLATILE);
return TCL_ERROR;
}
#if CMK_HAS_PARTITION
replica_send((char*)&(script->state->lattice), sizeof(Lattice), dest, CkMyPe());
#endif
char str[40];
sprintf(str, "%d", dest);
script->setParameter("scriptArg1", str);
CkpvAccess(_qd)->create(PatchMap::Object()->numPatches());
script->runController(SCRIPT_ATOMSEND);
#if CMK_HAS_PARTITION
ControllerState *cstate = script->state->controller;
replica_send((char*)cstate, sizeof(ControllerState), dest, CkMyPe());
#endif
return TCL_OK;
}
/** \brief create the <B>msgque help</B> subcommand
*
* \tclmsgque_man
*
* \param[in] interp current Tcl interpreter
* \param[in] objc number of objects in \e objv
* \param[in] objv array of \e Tcl_Obj objects
* \return Tcl error-code
*/
static int NS(Help) (
Tcl_Interp * interp,
int objc,
struct Tcl_Obj *const *objv
)
{
MQ_CST str;
struct MqBufferS *buf = MqBufferCreate(MQ_ERROR_PANIC, 1000);
MqBufferAppendC(buf, "usage: tclmsgque help\n\n");
MqBufferAppendC(buf, MqHelpMsgque());
MqBufferGetC(buf, &str);
Tcl_SetResult (interp, (MQ_STR)str, TCL_VOLATILE);
MqBufferDelete(&buf);
return TCL_OK;
}
static int UUTCLFUNC
uutcl_DecodeFile (ClientData clientData, Tcl_Interp *interp,
int argc, char *argv[])
{
char tmpstring[256];
uulist *iter;
int res;
uutcl_UpdateParameter (interp);
if (argc < 2 || argc > 3) {
sprintf (tmpstring,
"wrong # args: should be \"%s number ?targetname?\"",
argv[0]);
Tcl_SetResult (interp, tmpstring, TCL_VOLATILE);
return TCL_ERROR;
}
if ((iter = UUGetFileListItem (atoi (argv[1]))) == NULL) {
Tcl_SetResult (interp, "invalid file number", TCL_STATIC);
return TCL_ERROR;
}
if ((res = UUDecodeFile (iter, (argc==3)?argv[2]:NULL)) != UURET_OK) {
sprintf (tmpstring, "Error while decoding %s (%s): %s (%s)",
(iter->filename) ? iter->filename : "",
(iter->subfname) ? iter->subfname : "",
UUstrerror (res),
(res==UURET_IOERR)?
strerror(UUGetOption(UUOPT_ERRNO,NULL,NULL,0)):"");
Tcl_SetResult (interp, tmpstring, TCL_VOLATILE);
return TCL_ERROR;
}
return TCL_OK;
}
int
Tk_ConfigureValue(
Tcl_Interp *interp, /* Interpreter for error reporting. */
Tk_Window tkwin, /* Window corresponding to widgRec. */
Tk_ConfigSpec *specs, /* Describes legal options. */
char *widgRec, /* Record whose fields contain current values
* for options. */
CONST char *argvName, /* Gives the command-line name for the option
* whose value is to be returned. */
int flags) /* Used to specify additional flags that must
* be present in config specs for them to be
* considered. */
{
Tk_ConfigSpec *specPtr;
int needFlags, hateFlags;
Tcl_FreeProc *freeProc;
CONST char *result;
char buffer[200];
needFlags = flags & ~(TK_CONFIG_USER_BIT - 1);
if (Tk_Depth(tkwin) <= 1) {
hateFlags = TK_CONFIG_COLOR_ONLY;
} else {
hateFlags = TK_CONFIG_MONO_ONLY;
}
/*
* Get the build of the config for this interpreter.
*/
specs = GetCachedSpecs(interp, specs);
specPtr = FindConfigSpec(interp, specs, argvName, needFlags, hateFlags);
if (specPtr == NULL) {
return TCL_ERROR;
}
result = FormatConfigValue(interp, tkwin, specPtr, widgRec, buffer,
&freeProc);
Tcl_SetResult(interp, (char *) result, TCL_VOLATILE);
if (freeProc != NULL) {
if ((freeProc == TCL_DYNAMIC) || (freeProc == (Tcl_FreeProc *) free)) {
ckfree((char *)result);
} else {
(*freeProc)((char *)result);
}
}
return TCL_OK;
}
int ScriptTcl::Tcl_reinitvels(ClientData clientData,
Tcl_Interp *interp, int argc, char *argv[]) {
ScriptTcl *script = (ScriptTcl *)clientData;
script->initcheck();
if (argc != 2) {
Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
return TCL_ERROR;
}
char *temp = argv[1];
script->setParameter("initialTemp",temp);
script->runController(SCRIPT_REINITVELS);
return TCL_OK;
}
int ScriptTcl::Tcl_rescalevels(ClientData clientData,
Tcl_Interp *interp, int argc, char *argv[]) {
ScriptTcl *script = (ScriptTcl *)clientData;
script->initcheck();
if (argc != 2) {
Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
return TCL_ERROR;
}
char *factor = argv[1];
script->setParameter("scriptArg1",factor);
script->runController(SCRIPT_RESCALEVELS);
return TCL_OK;
}
// return info about the graphics with a given id
static int tcl_graphics_info(MoleculeGraphics *gmol,
int argc, const char *argv[],
Tcl_Interp *interp)
{
if (argc != 1) {
Tcl_SetResult(interp, (char *) "graphics: info takes one parameter, the index", TCL_STATIC);
return TCL_ERROR;
}
int id;
if (Tcl_GetInt(interp, argv[0], &id) != TCL_OK) {
return TCL_ERROR;
}
// since either NULL or a static char * is returned, this will work
Tcl_AppendResult(interp, gmol->info_id(id), NULL);
return TCL_OK;
}
// turn them on or off
static int tcl_graphics_materials(MoleculeGraphics *gmol,
int argc, const char *argv[],
Tcl_Interp *interp)
{
MUST_HAVE(1, "materials");
int val;
if (Tcl_GetBoolean(interp, argv[0], &val) != TCL_OK) {
return TCL_ERROR;
}
// enable/disable materials
char tmpstring[64];
sprintf(tmpstring, "%d", gmol->use_materials(val));
Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
return TCL_OK;
}
// only has coordinates
static int tcl_graphics_pickpoint(MoleculeGraphics *gmol,
int argc, const char *argv[],
Tcl_Interp *interp)
{
MUST_HAVE(1, "pickpoint");
float vals[3];
if (tcl_get_vector(argv[0], vals+0, interp) != TCL_OK) {
return TCL_ERROR;
}
// we've got a point, so add it
char tmpstring[64];
sprintf(tmpstring, "%d", gmol->add_pickpoint(vals+0));
Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
return TCL_OK;
}
int Ng_SingularPointMS (ClientData clientData,
Tcl_Interp * interp,
int argc, tcl_const char *argv[])
{
CSGeometry * geometry = dynamic_cast<CSGeometry*> (ng_geometry.get());
if (!geometry)
{
Tcl_SetResult (interp, err_needscsgeometry, TCL_STATIC);
return TCL_ERROR;
}
// double globh = mparam.maxh;
for (int i = 1; i <= geometry->singpoints.Size(); i++)
geometry->singpoints.Get(i)->SetMeshSize (*mesh, 1e99 /* globh */ );
return TCL_OK;
}