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; }