TclCommands.C

00001 /***************************************************************************
00002 *cr 
00003 *cr (C) Copyright 1995-2019 The Board of Trustees of the 
00004 *cr University of Illinois 
00005 *cr All Rights Reserved 
00006 *cr 
00007 ***************************************************************************/
00008 
00009 /***************************************************************************
00010 * RCS INFORMATION:
00011 *
00012 * $RCSfile: TclCommands.C,v $
00013 * $Author: johns $ $Locker: $ $State: Exp $
00014 * $Revision: 1.170 $ $Date: 2020年07月23日 03:27:52 $
00015 *
00016 ***************************************************************************
00017 * DESCRIPTION:
00018 * Tcl <--> VMD interface commands used for the analysis and 
00019 * manipulation of structures
00020 *
00021 ***************************************************************************/
00022 
00023 #include <stdlib.h> 
00024 #include <string.h>
00025 #include <errno.h>
00026 #include "tcl.h"
00027 #include "MoleculeList.h"
00028 #include "TclCommands.h"
00029 #include "SymbolTable.h"
00030 #include "VMDApp.h"
00031 
00032 #include "config.h"
00033 #if defined(VMDTKCON)
00034 #include "JString.h"
00035 #include "vmdconsole.h"
00036 #endif
00037 
00038 #include "Inform.h"
00039 #include "MolFilePlugin.h"
00040 #include "CommandQueue.h"
00041 #include "Measure.h"
00042 
00044 // given a string, return the indicated molecule.
00045 // String can be a number or 'top'
00046 
00047 static Molecule *find_molecule(Tcl_Interp *interp, MoleculeList *mlist, const char *text)
00048 {
00049 int molid = -1;
00050 if (!strcmp(text, "top")) {
00051 if (mlist->top()) {
00052 molid = mlist->top()->id();
00053 } else {
00054 Tcl_AppendResult(interp, "There is no 'top' molecule ", NULL);
00055 return NULL;
00056 }
00057 } else {
00058 if (Tcl_GetInt(interp, text, &molid) != TCL_OK) {
00059 Tcl_AppendResult(interp, "Not valid molecule id ", text, NULL);
00060 return NULL;
00061 }
00062 }
00063 // here I have 'molid', so get the given molecule 
00064 Molecule *mol = mlist-> mol_from_id(molid); 
00065 if (!mol) {
00066 Tcl_AppendResult(interp, "Cannot find molecule ", text, NULL);
00067 }
00068 return mol;
00069 }
00070 
00072 
00073 // forward definitions
00074 static int access_tcl_atomsel(ClientData my_data, Tcl_Interp *interp,
00075 int argc, const char *argv[]);
00076 static int access_tcl_atomsel_obj(ClientData my_data, Tcl_Interp *interp,
00077 int argc, Tcl_Obj * const argv[]);
00078 static void remove_tcl_atomsel(ClientData my_data);
00079 
00080 // given the interpreter and attribute string, construct the array
00081 // mapping from attribute to atomSelParser index
00082 static int split_tcl_atomsel_info(Tcl_Interp *interp, SymbolTable *parser,
00083 const char *opts, 
00084 int *num, int **mapping) 
00085 {
00086 *num = 0;
00087 *mapping = NULL;
00088 
00089 // make the list of attributes
00090 const char **attribs;
00091 int num_attribs;
00092 if (Tcl_SplitList(interp, opts, &num_attribs, &attribs) != TCL_OK) {
00093 Tcl_AppendResult(interp, "cannot split attributes list", NULL);
00094 return TCL_ERROR;
00095 }
00096 
00097 // verify that each attrib is a valid KEYWORD or SINGLEWORD
00098 // in the parser
00099 int *info_index = new int[num_attribs];
00100 for (int i=0; i<num_attribs; i++) {
00101 // search for a match to the attribute
00102 int j = parser->find_attribute(attribs[i]);
00103 
00104 if (j == -1) { // the name wasn't found, so complain
00105 Tcl_AppendResult(interp, "cannot find attribute '", 
00106 attribs[i], "'", NULL);
00107 delete [] info_index;
00108 ckfree((char *)attribs); // free of tcl data
00109 return TCL_ERROR;
00110 }
00111 // make sure this is a KEYWORD or SINGLEWORD
00112 if (parser->fctns.data(j)->is_a != SymbolTableElement::KEYWORD &&
00113 parser->fctns.data(j)->is_a != SymbolTableElement::SINGLEWORD) {
00114 Tcl_AppendResult(interp, "'", attribs[i], 
00115 "' is not a keyword or singleword", NULL);
00116 delete [] info_index;
00117 ckfree((char *)attribs); // free of tcl data
00118 return TCL_ERROR;
00119 }
00120 info_index[i] = j; // make the mapping from attrib to atomSelParser index
00121 }
00122 
00123 ckfree((char *)attribs); // free of tcl data
00124 *mapping = info_index; // return the mapping
00125 *num = num_attribs;
00126 return TCL_OK;
00127 }
00128 
00129 // the Tcl command is "atomselect". It generates 'local' (with upproc)
00130 // functions which return information about the AtomSel selection
00131 // Format is: atomselect <molecule id> <text>
00132 static int make_tcl_atomsel(ClientData cd, Tcl_Interp *interp, int argc, const char *argv[])
00133 {
00134 
00135 VMDApp *app = (VMDApp *)cd;
00136 MoleculeList *mlist = app->moleculeList; 
00137 SymbolTable *atomSelParser = app->atomSelParser; 
00138 
00139 if (argc == 4 && !strcmp(argv[1], "macro")) {
00140 if (atomSelParser->add_custom_singleword(argv[2], argv[3])) {
00141 // XXX log command ourselves; should define a VMDApp method to do it.
00142 app->commandQueue->runcommand(new CmdAddAtomSelMacro(argv[2], argv[3]));
00143 return TCL_OK;
00144 }
00145 Tcl_AppendResult(interp, "Unable to create macro for '",argv[2],"'", NULL);
00146 return TCL_ERROR;
00147 }
00148 if (argc == 3 && !strcmp(argv[1], "macro")) {
00149 const char *macro = atomSelParser->get_custom_singleword(argv[2]);
00150 if (!macro) {
00151 Tcl_AppendResult(interp, "No macro exists for '",argv[2], "'", NULL);
00152 return TCL_ERROR;
00153 }
00154 Tcl_AppendResult(interp, (char *)macro, NULL);
00155 return TCL_OK;
00156 }
00157 if (argc == 2 && !strcmp(argv[1], "macro")) {
00158 for (int i=0; i<atomSelParser->num_custom_singleword(); i++) {
00159 const char *macro = atomSelParser->custom_singleword_name(i);
00160 if (macro && strlen(macro) > 0)
00161 Tcl_AppendElement(interp, (char *)macro);
00162 }
00163 return TCL_OK;
00164 }
00165 if (argc == 3 && !strcmp(argv[1], "delmacro")) {
00166 if (!atomSelParser->remove_custom_singleword(argv[2])) {
00167 Tcl_AppendResult(interp, "Unable to delete macro '", argv[2], "'", NULL);
00168 return TCL_ERROR;
00169 }
00170 // XXX log command ourselves; should define a VMDApp method to do it.
00171 app->commandQueue->runcommand(new CmdDelAtomSelMacro(argv[2]));
00172 return TCL_OK;
00173 }
00174 
00175 // return a list of all the undeleted selection
00176 //
00177 // XXX since atomselection names are practially always stored in 
00178 // a variable and thus the name itself does not matter, we could
00179 // consider to change the original code to generate symbols of 
00180 // the kind __atomselect## or even __vmd_atomselect##.
00181 if (argc == 2 && !strcmp(argv[1], "list")) {
00182 char script[] = "info commands {atomselect[0-9]*}"; 
00183 return Tcl_Eval(interp, script);
00184 }
00185 
00186 // return a list of the available keywords in the form
00187 if (argc == 2 && !strcmp(argv[1], "keywords")) {
00188 for (int i=0; i<atomSelParser->fctns.num(); i++) {
00189 Tcl_AppendElement(interp, atomSelParser->fctns.name(i));
00190 }
00191 return TCL_OK;
00192 }
00193 
00194 // return all the symbol table information for the available keywords
00195 // in the form {visiblename regex is takes}, where
00196 // "is" is one of "int", "float", "string"
00197 // "takes" is one of "keyword", "function", "boolean", "sfunction"
00198 if (argc == 2 && !strcmp(argv[1], "symboltable")) {
00199 char *pis, *ptakes;
00200 // go through the parser, one by one
00201 for (int i=0; i< atomSelParser->fctns.num(); i++) {
00202 Tcl_AppendResult(interp, i==0?"":" ", "{", NULL);
00203 // what kind of function is this?
00204 switch (atomSelParser->fctns.data(i) -> is_a) {
00205 case SymbolTableElement::KEYWORD: ptakes = (char *) "keyword"; break;
00206 case SymbolTableElement::FUNCTION: ptakes = (char *) "function"; break;
00207 case SymbolTableElement::SINGLEWORD: ptakes = (char *) "boolean"; break;
00208 case SymbolTableElement::STRINGFCTN: ptakes = (char *) "sfunction"; break;
00209 default: ptakes = (char *) "unknown"; break;
00210 }
00211 // what does it return?
00212 switch (atomSelParser->fctns.data(i) -> returns_a) {
00213 case SymbolTableElement::IS_INT : pis = (char *) "int"; break;
00214 case SymbolTableElement::IS_FLOAT : pis = (char *) "float"; break;
00215 case SymbolTableElement::IS_STRING : pis = (char *) "string"; break;
00216 default: pis = (char *) "unknown"; break;
00217 }
00218 // append to the result string
00219 Tcl_AppendElement(interp, atomSelParser->fctns.name(i));
00220 Tcl_AppendElement(interp, atomSelParser->fctns.name(i));
00221 Tcl_AppendElement(interp, pis);
00222 Tcl_AppendElement(interp, ptakes);
00223 Tcl_AppendResult(interp, "}", NULL);
00224 }
00225 return TCL_OK;
00226 }
00227 
00228 if (!((argc == 3) || (argc == 5 && !strcmp(argv[3], "frame")))) {
00229 Tcl_SetResult(interp, 
00230 (char *) "usage: atomselect <command> [args...]\n"
00231 "\nCreating an Atom Selection:\n"
00232 " <molId> <selection text> [frame <n>] -- creates an atom selection function\n"
00233 " list -- list existing atom selection functions\n"
00234 " (type an atomselection function to see a list of commands for it)\n"
00235 "\nGetting Info about Keywords:\n" 
00236 " keywords -- keywords for selection's get/set commands\n"
00237 " symboltable -- list keyword function and return types\n"
00238 "\nAtom Selection Text Macros:\n" 
00239 " macro <name> <definition> -- define a new text macro\n"
00240 " delmacro <name> -- delete a text macro definition\n"
00241 " macro [<name>] -- list all (or named) text macros\n",
00242 TCL_STATIC);
00243 return TCL_ERROR;
00244 }
00245 int frame = AtomSel::TS_NOW;
00246 if (argc == 5) { // get the frame number
00247 int val;
00248 if (AtomSel::get_frame_value(argv[4], &val) != 0) {
00249 Tcl_SetResult(interp, 
00250 (char *) "atomselect: bad frame number in input, must be "
00251 "'first', 'last', 'now', or a non-negative number",
00252 TCL_STATIC);
00253 return TCL_ERROR;
00254 }
00255 frame = val;
00256 }
00257 
00258 // get the molecule id
00259 Molecule *mol = find_molecule(interp, mlist, argv[1]);
00260 if (!mol) {
00261 Tcl_AppendResult(interp, " in atomselect's 'molId'", NULL);
00262 return TCL_ERROR;
00263 }
00264 // do the selection 
00265 AtomSel *atomSel = new AtomSel(app, atomSelParser, mol->id());
00266 atomSel -> which_frame = frame;
00267 if (atomSel->change(argv[2], mol) == AtomSel::NO_PARSE) {
00268 Tcl_AppendResult(interp, "atomselect: cannot parse selection text: ",
00269 argv[2], NULL);
00270 return TCL_ERROR;
00271 }
00272 // At this point the data is okay so construct the new function
00273 
00274 // make the name
00275 char newname[30];
00276 int *num = (int *)Tcl_GetAssocData(interp, (char *)"AtomSel", NULL);
00277 sprintf(newname, "atomselect%d", *num);
00278 (*num)++;
00279 
00280 // make the new proc
00281 Tcl_CreateObjCommand(interp, newname, access_tcl_atomsel_obj, 
00282 (ClientData) atomSel, 
00283 (Tcl_CmdDeleteProc *) remove_tcl_atomsel);
00284 
00285 // here I need to change the context ...
00286 Tcl_VarEval(interp, "upproc 0 ", newname, NULL);
00287 
00288 // return the new function name and return it
00289 Tcl_AppendElement(interp, newname);
00290 return TCL_OK;
00291 }
00292 
00293 // given the tcl variable string, get the selection
00294 AtomSel *tcl_commands_get_sel(Tcl_Interp *interp, const char *str) {
00295 Tcl_CmdInfo info;
00296 if (Tcl_GetCommandInfo(interp, (char *)str, &info) != 1)
00297 return NULL;
00298 
00299 return (AtomSel *)(info.objClientData); 
00300 }
00301 
00302 // improve the speed of 'move' and 'moveby'
00303 // needs a selection and a matrix
00304 // Applies the matrix to the coordinates of the selected atoms
00305 static int atomselect_move(Tcl_Interp *interp, AtomSel *sel, const char *mattext) { 
00306 int molid = sel->molid();
00307 VMDApp *app = (VMDApp *)Tcl_GetAssocData(interp, (char *)"VMDApp", NULL);
00308 MoleculeList *mlist = app->moleculeList;
00309 Molecule *mol = mlist->mol_from_id(molid);
00310 if (!mol) {
00311 Tcl_SetResult(interp, (char *) "atomselection move: molecule was deleted",
00312 TCL_STATIC);
00313 return TCL_ERROR;
00314 }
00315 
00316 // get the frame
00317 float *framepos = sel->coordinates(mlist);
00318 if (!framepos) {
00319 Tcl_SetResult(interp, (char *) "atomselection move: invalid/ no coordinates in selection", TCL_STATIC);
00320 return TCL_ERROR;
00321 }
00322 
00323 // get the matrix
00324 Matrix4 mat;
00325 Tcl_Obj *matobj = Tcl_NewStringObj(mattext, -1);
00326 if (tcl_get_matrix("atomselection move:", interp, 
00327 matobj , mat.mat) != TCL_OK) {
00328 Tcl_DecrRefCount(matobj); 
00329 return TCL_ERROR;
00330 }
00331 Tcl_DecrRefCount(matobj); 
00332 
00333 // and apply it to the coordinates
00334 int err;
00335 if ((err = measure_move(sel, framepos, mat)) != MEASURE_NOERR) {
00336 Tcl_SetResult(interp, (char *)measure_error(err), TCL_STATIC);
00337 return TCL_ERROR;
00338 }
00339 mol->force_recalc(DrawMolItem::MOL_REGEN);
00340 return TCL_OK;
00341 }
00342 
00343 
00344 // and the same for the vector offset
00345 // Applies the vector to the coordinates of the selected atoms
00346 static int atomselect_moveby(Tcl_Interp *interp, AtomSel *sel, const char *vectxt) { 
00347 int i;
00348 int molid = sel->molid();
00349 VMDApp *app = (VMDApp *)Tcl_GetAssocData(interp, (char *)"VMDApp", NULL);
00350 MoleculeList *mlist = app->moleculeList;
00351 Molecule *mol = mlist->mol_from_id(molid);
00352 if (!mol) {
00353 Tcl_SetResult(interp, (char *) "atomselection moveby: molecule was deleted", TCL_STATIC);
00354 return TCL_ERROR;
00355 }
00356 
00357 // get the frame
00358 float *framepos = sel->coordinates(mlist);
00359 if (!framepos) {
00360 Tcl_SetResult(interp, (char *) "atomselection moveby: invalid/ no coordinates in selection", TCL_STATIC);
00361 return TCL_ERROR;
00362 }
00363 
00364 // get the vector
00365 int num_vect;
00366 Tcl_Obj **vec;
00367 Tcl_Obj *vecobj = Tcl_NewStringObj(vectxt, -1);
00368 if (Tcl_ListObjGetElements(interp, vecobj, &num_vect, &vec) != TCL_OK) {
00369 Tcl_DecrRefCount(vecobj); // free translation vector
00370 return TCL_ERROR;
00371 }
00372 if (num_vect != 3) {
00373 Tcl_SetResult(interp, (char *) "atomselection moveby: translation vector can only be of length 3", TCL_STATIC);
00374 Tcl_DecrRefCount(vecobj); // free translation vector
00375 return TCL_ERROR;
00376 }
00377 float vect[3];
00378 for (i=0; i<3; i++) {
00379 double tmp; 
00380 if (Tcl_GetDoubleFromObj(interp, vec[i], &tmp) != TCL_OK) {
00381 Tcl_SetResult(interp, (char *)"atomselect moveby: non-numeric in vector", TCL_STATIC);
00382 Tcl_DecrRefCount(vecobj); // free translation vector
00383 return TCL_ERROR;
00384 }
00385 vect[i] = (float)tmp;
00386 }
00387 
00388 // and apply it to the coordinates
00389 for (i=sel->firstsel; i<=sel->lastsel; i++) {
00390 if (sel->on[i]) {
00391 vec_add(framepos + 3L*i, framepos + 3L*i, vect);
00392 }
00393 }
00394 
00395 Tcl_DecrRefCount(vecobj); // free translation vector
00396 
00397 // notify molecule that coordinates changed.
00398 mol->force_recalc(DrawMolItem::MOL_REGEN);
00399 return TCL_OK;
00400 }
00401 
00402 
00403 #define ATOMSEL_SET_BAD_DATA(x) \
00404 do { \
00405 char buf[80]; \
00406 sprintf(buf, "atomsel: set: bad data in %dth element", x); \
00407 Tcl_AppendResult(interp, buf, NULL); \
00408 delete [] data; \
00409 delete [] atomon; \
00410 delete [] elems; \
00411 } while (0)
00412 
00413 #define ATOMSEL_SET_BADDATA2(x) \
00414 do { \
00415 char buf[80]; \
00416 sprintf(buf, "atomsel: set: bad data in %dth element", x);\
00417 Tcl_AppendResult(interp, buf, NULL); \
00418 delete [] data; \
00419 delete [] atomon; \
00420 delete [] elems; \
00421 } while (0)
00422 
00423 static int atomsel_set(ClientData my_data, Tcl_Interp *interp,
00424 int argc, Tcl_Obj * const objv[]) {
00425 
00426 AtomSel *atomSel = (AtomSel *)my_data;
00427 VMDApp *app = (VMDApp *)Tcl_GetAssocData(interp, "VMDApp", NULL);
00428 {
00429 // check that the molecule exists
00430 Molecule *mol = app->moleculeList->mol_from_id(atomSel -> molid());
00431 if (!mol) {
00432 char tmpstring[1024];
00433 sprintf(tmpstring, "atomsel: get: was molecule %d deleted?",
00434 atomSel->molid());
00435 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
00436 return TCL_ERROR;
00437 }
00438 }
00439 SymbolTable *atomSelParser = app->atomSelParser;
00440 if (atomSel == NULL) {
00441 Tcl_SetResult(interp, (char *) "atomselect access without data!", TCL_STATIC);
00442 return TCL_ERROR;
00443 } 
00444 
00445 int i, num_mapping;
00446 Tcl_Obj **attrs;
00447 // Get the list of attributes we want to set
00448 if (Tcl_ListObjGetElements(interp, objv[2], &num_mapping, &attrs))
00449 return TCL_ERROR;
00450 
00451 // Get the list of data elements
00452 int num_outerlist;
00453 Tcl_Obj **outerlist;
00454 if (Tcl_ListObjGetElements(interp, objv[3], &num_outerlist, &outerlist))
00455 return TCL_ERROR;
00456 
00457 // Check that all the attributes are writable
00458 SymbolTableElement **elems = new SymbolTableElement *[num_mapping];
00459 for (i=0; i<num_mapping; i++) {
00460 const char *attrname = Tcl_GetStringFromObj(attrs[i], NULL);
00461 int id = atomSelParser->find_attribute(attrname);
00462 if (id < 0) {
00463 delete [] elems;
00464 Tcl_AppendResult(interp, "cannot find attribute '", attrname, "'", NULL);
00465 return TCL_ERROR;
00466 }
00467 SymbolTableElement *elem = atomSelParser->fctns.data(id);
00468 if (elem->is_a != SymbolTableElement::KEYWORD || !elem->set_fctn) {
00469 delete [] elems;
00470 Tcl_AppendResult(interp, "atomsel object: set: data not modifiable: ",
00471 attrname, NULL);
00472 return TCL_ERROR;
00473 }
00474 elems[i] = elem;
00475 }
00476 atomsel_ctxt context(atomSelParser, 
00477 app->moleculeList->mol_from_id(atomSel->molid()),
00478 atomSel->which_frame, NULL);
00479 
00480 // Make list of the atom indices that are on
00481 int *atomon = new int[atomSel->selected];
00482 int ind = 0;
00483 for (i=atomSel->firstsel; i<=atomSel->lastsel; i++) 
00484 if (atomSel->on[i])
00485 atomon[ind++] = i;
00486 
00487 // If there is only one attribute, then outerlist must be either a
00488 // single element or contain one element for each selected atom.
00489 // If there is more than one attribute, then outerlist must be
00490 // a list of scalars or lists, one for each attribute.
00491 
00492 if (num_mapping == 1) {
00493 if (num_outerlist != 1 && num_outerlist != atomSel->selected) {
00494 char tmpstring[1024];
00495 sprintf(tmpstring,
00496 "atomselect set: %d data items doesn't match %d selected atoms.",
00497 num_outerlist, atomSel->selected);
00498 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
00499 delete [] elems;
00500 delete [] atomon;
00501 return TCL_ERROR;
00502 }
00503 SymbolTableElement *elem = elems[0];
00504 switch (elem->returns_a) {
00505 case SymbolTableElement::IS_INT:
00506 {
00507 int val;
00508 int *data = new int[atomSel->num_atoms];
00509 if (num_outerlist == 1) {
00510 if (Tcl_GetIntFromObj(NULL, outerlist[0], &val) != TCL_OK) {
00511 // try to convert to double instead
00512 double dval;
00513 if (Tcl_GetDoubleFromObj(NULL, outerlist[0], &dval) == TCL_OK) {
00514 val = (int)dval;
00515 } else {
00516 ATOMSEL_SET_BAD_DATA(0);
00517 return TCL_ERROR;
00518 }
00519 }
00520 for (int i=0; i<atomSel->selected; i++) data[atomon[i]] = val;
00521 } else if (num_outerlist == atomSel->selected) {
00522 for (int i=0; i<num_outerlist; i++) {
00523 if (Tcl_GetIntFromObj(NULL, outerlist[i], &val) != TCL_OK) {
00524 
00525 // try to convert to double instead
00526 double dval;
00527 if (Tcl_GetDoubleFromObj(NULL, outerlist[i], &dval) == TCL_OK) {
00528 val = (int)dval;
00529 } else {
00530 ATOMSEL_SET_BAD_DATA(i);
00531 return TCL_ERROR;
00532 }
00533 }
00534 data[atomon[i]] = val;
00535 }
00536 }
00537 elem->set_keyword_int(&context, atomSel->num_atoms, data, atomSel->on);
00538 delete [] data;
00539 }
00540 break;
00541 case SymbolTableElement::IS_FLOAT:
00542 {
00543 double val;
00544 double *data = new double[atomSel->num_atoms];
00545 if (num_outerlist == 1) {
00546 if (Tcl_GetDoubleFromObj(NULL,outerlist[0],&val) != TCL_OK) {
00547 ATOMSEL_SET_BAD_DATA(0);
00548 return TCL_ERROR;
00549 }
00550 for (int i=0; i<atomSel->selected; i++) data[atomon[i]] = val;
00551 } else if (num_outerlist == atomSel->selected) {
00552 for (int i=0; i<num_outerlist; i++) {
00553 if (Tcl_GetDoubleFromObj(NULL, outerlist[i], &val) != TCL_OK) {
00554 ATOMSEL_SET_BAD_DATA(i);
00555 return TCL_ERROR;
00556 }
00557 data[atomon[i]] = val;
00558 }
00559 }
00560 elem->set_keyword_double(&context, atomSel->num_atoms, data, atomSel->on);
00561 delete [] data;
00562 }
00563 break;
00564 case SymbolTableElement::IS_STRING:
00565 {
00566 const char *val;
00567 const char **data = new const char *[atomSel->num_atoms];
00568 if (num_outerlist == 1) {
00569 val = Tcl_GetStringFromObj(outerlist[0], NULL);
00570 for (int i=0; i<atomSel->selected; i++) data[atomon[i]] = val;
00571 } else if (num_outerlist == atomSel->selected) {
00572 for (int i=0; i<num_outerlist; i++) {
00573 data[atomon[i]] = Tcl_GetStringFromObj(outerlist[i], NULL);
00574 }
00575 }
00576 elem->set_keyword_string(&context, atomSel->num_atoms, data, atomSel->on);
00577 delete [] data;
00578 }
00579 break;
00580 }
00581 } else {
00582 // something like "$sel set {mass beta} {{1 0} {2 1} {3 1} {3 2}}"
00583 if (num_outerlist != atomSel->selected) {
00584 char tmpstring[1024];
00585 sprintf(tmpstring, 
00586 "atomselect: set: %d data items doesn't match %d selected atoms.", 
00587 num_outerlist, atomSel->selected);
00588 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
00589 delete [] elems;
00590 delete [] atomon;
00591 return TCL_ERROR;
00592 }
00593 Tcl_Obj ***objdata = new Tcl_Obj **[num_outerlist];
00594 for (i=0; i<num_outerlist; i++) {
00595 int itemsize;
00596 Tcl_Obj **itemobjs;
00597 if (Tcl_ListObjGetElements(interp, outerlist[i], &itemsize, &itemobjs)
00598 != TCL_OK) {
00599 delete [] objdata;
00600 delete [] atomon;
00601 delete [] elems;
00602 return TCL_ERROR;
00603 }
00604 if (itemsize != num_mapping) {
00605 char tmpstring[1024];
00606 delete [] objdata;
00607 delete [] atomon;
00608 delete [] elems;
00609 sprintf(tmpstring, 
00610 "atomselect: set: data element %d has %d terms (instead of %d)", 
00611 i, itemsize, num_mapping);
00612 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
00613 return TCL_ERROR;
00614 }
00615 objdata[i] = itemobjs;
00616 }
00617 
00618 // Now go back through the elements and extract their data values
00619 for (i=0; i<num_mapping; i++) {
00620 SymbolTableElement *elem = elems[i];
00621 switch (elem->returns_a) {
00622 case (SymbolTableElement::IS_INT): {
00623 int *data = new int[atomSel->num_atoms];
00624 for (int j=0; j<num_outerlist; j++) {
00625 int val;
00626 if (Tcl_GetIntFromObj(NULL, objdata[j][i], &val) != TCL_OK) {
00627 // try to get double
00628 double dval;
00629 if (Tcl_GetDoubleFromObj(NULL, objdata[j][i], &dval) == TCL_OK) {
00630 val = (int)dval;
00631 } else {
00632 ATOMSEL_SET_BADDATA2(j);
00633 return TCL_ERROR;
00634 }
00635 }
00636 data[atomon[j]] = val;
00637 }
00638 elem->set_keyword_int(&context, atomSel->num_atoms,
00639 data, atomSel->on);
00640 delete [] data;
00641 }
00642 break;
00643 
00644 case (SymbolTableElement::IS_FLOAT): {
00645 double *data = new double[atomSel->num_atoms];
00646 for (int j=0; j<num_outerlist; j++) {
00647 double val;
00648 if (Tcl_GetDoubleFromObj(NULL, objdata[j][i], &val) != TCL_OK) {
00649 ATOMSEL_SET_BADDATA2(j);
00650 return TCL_ERROR;
00651 }
00652 data[atomon[j]] = val;
00653 }
00654 elem->set_keyword_double(&context, atomSel->num_atoms,
00655 data, atomSel->on);
00656 delete [] data;
00657 }
00658 break;
00659 case (SymbolTableElement::IS_STRING): {
00660 const char **data = new const char *[atomSel->num_atoms];
00661 for (int j=0; j<num_outerlist; j++)
00662 data[atomon[j]] = Tcl_GetStringFromObj(objdata[j][i], NULL);
00663 elem->set_keyword_string(&context, atomSel->num_atoms,
00664 data, atomSel->on);
00665 delete [] data;
00666 }
00667 break;
00668 }
00669 } 
00670 delete [] objdata;
00671 }
00672 delete [] atomon;
00673 delete [] elems;
00674 
00675 // Recompute the color assignments if certain atom attributes are changed.
00676 for (i=0; i<num_mapping; i++) {
00677 const char *attr = Tcl_GetStringFromObj(attrs[i], NULL);
00678 if (!strcmp(attr, "name") ||
00679 !strcmp(attr, "element") ||
00680 !strcmp(attr, "atomicnumber") ||
00681 !strcmp(attr, "type") ||
00682 !strcmp(attr, "resname") ||
00683 !strcmp(attr, "chain") ||
00684 !strcmp(attr, "segid") ||
00685 !strcmp(attr, "segname")) {
00686 app->moleculeList->add_color_names(atomSel->molid());
00687 break;
00688 }
00689 }
00690 
00691 // This call to force_recalc is potentially expensive; 
00692 // When reps have to be updated, it amounts to about 25% of the 
00693 // time for a 13,000 atom system on a 1.1 GHz Athlon. It's
00694 // here so that changing atom values immediately updates the screen.
00695 // For better performance, we set dirty bits and do the update only 
00696 // when the next screen redraw occurs.
00697 Molecule *mol = app->moleculeList->mol_from_id(atomSel->molid());
00698 mol->force_recalc(DrawMolItem::SEL_REGEN | DrawMolItem::COL_REGEN); 
00699 return TCL_OK;
00700 }
00701 
00702 // methods related to a selection
00703 //0 num -- number of atoms selected
00704 //1 list -- list of atom indicies
00705 //2 molid -- id of the molecule used
00706 //3 text -- the selection text
00707 //4 get {options} -- return a list of the listed data for each atom
00708 //6 type -- returns "atomselect"
00709 //20 frame -- returns the value of the frame (or 'now' or 'last')
00710 //21 frame <num> -- sets the frame value given the name or number
00712 //7 moveby {x y z} -- move by a given {x y z} offset
00713 //8 lmoveby {{x y z}} -- move by a list of {x y z} offsets, 1 per atom
00714 //9 moveto {x y z} -- move to a given {x y z} offset
00715 //10 lmoveto {{x y z} -- same as 'set {x y z}'
00717 //11 move {transformation} -- takes a 4x4 transformation matrix
00719 //12 delete -- same as 'rename $sel {}'
00720 //13 global -- same as 'upproc #0 $argv[0]'
00721 //14 uplevel L -- same as 'upproc $argv[1] $argv[0]'
00722 #define CHECK_MATCH(string,val) if(!strcmp(argv[1],string)){option=val;break;}
00723 
00724 int access_tcl_atomsel_obj(ClientData my_data, Tcl_Interp *interp, 
00725 int argc, Tcl_Obj * const objv[]) {
00726 
00727 if (argc > 1) {
00728 const char *argv1 = Tcl_GetStringFromObj(objv[1], NULL);
00729 if (argc == 4 && !strcmp(argv1, "set")) 
00730 return atomsel_set(my_data, interp, argc, objv);
00731 }
00732 const char **argv = new const char *[argc];
00733 for (int i=0; i<argc; i++) argv[i] = Tcl_GetStringFromObj(objv[i], NULL);
00734 int rc = access_tcl_atomsel(my_data, interp, argc, argv);
00735 delete [] argv;
00736 return rc;
00737 }
00738 
00739 int access_tcl_atomsel(ClientData my_data, Tcl_Interp *interp,
00740 int argc, const char *argv[]) {
00741 
00742 VMDApp *app = (VMDApp *)Tcl_GetAssocData(interp, (char *)"VMDApp", NULL);
00743 AtomSel *atomSel = (AtomSel *)my_data; 
00744 MoleculeList *mlist = app->moleculeList; 
00745 SymbolTable *atomSelParser = app->atomSelParser;
00746 int i;
00747 
00748 if (atomSel == NULL) {
00749 Tcl_SetResult(interp, (char *) "atomselect access without data!", TCL_STATIC);
00750 return TCL_ERROR;
00751 }
00752 // We don't have a singleword defined yet, so macro is NULL.
00753 atomsel_ctxt context(atomSelParser, mlist->mol_from_id(atomSel->molid()), 
00754 atomSel->which_frame, NULL);
00755 
00756 int option = -1;
00757 const char *outfile_name = NULL; // for 'writepdb'
00758 while (1) {
00759 if (argc == 2) {
00760 CHECK_MATCH("num", 0);
00761 CHECK_MATCH("list", 1);
00762 CHECK_MATCH("molindex", 2);
00763 CHECK_MATCH("molid", 2);
00764 CHECK_MATCH("text", 3);
00765 CHECK_MATCH("type", 6);
00766 CHECK_MATCH("delete", 12);
00767 CHECK_MATCH("global", 13);
00768 CHECK_MATCH("frame", 20);
00769 CHECK_MATCH("getbonds", 24);
00770 CHECK_MATCH("update", 26);
00771 CHECK_MATCH("getbondorders", 27);
00772 CHECK_MATCH("getbondtypes", 29);
00773 } else if (argc == 3) {
00774 CHECK_MATCH("get", 4);
00775 CHECK_MATCH("moveby", 7); // these now pass via the "extended"
00776 CHECK_MATCH("lmoveby", 8); // Tcl functionality
00777 CHECK_MATCH("moveto", 9);
00778 CHECK_MATCH("lmoveto", 10);
00779 CHECK_MATCH("move", 11);
00780 CHECK_MATCH("uplevel", 14);
00781 CHECK_MATCH("frame", 21);
00782 CHECK_MATCH("setbonds", 25);
00783 CHECK_MATCH("setbondorders", 28);
00784 CHECK_MATCH("setbondtypes", 30);
00785 if (!strncmp(argv[1],"write", 5)) { option = 23; break; }
00786 }
00787 if (argc != 1) {
00788 // gave some wierd keyword
00789 Tcl_AppendResult(interp, "atomselection: improper method: ", argv[1],
00790 "\n", NULL);
00791 }
00792 // Now list the available options
00793 Tcl_AppendResult(interp, 
00794 "usage: <atomselection> <command> [args...]\n"
00795 "\nCommands for manipulating atomselection metadata:\n",
00796 " frame [new frame value] -- get/set frame\n",
00797 " molid|molindex -- get selection's molecule id\n",
00798 " text -- get selection's text\n",
00799 " delete -- delete atomselection (to free memory)\n",
00800 " global -- move atomselection to global scope\n",
00801 " update -- recalculate selection\n",
00802 "\nCommands for getting/setting attributes:\n",
00803 " num -- number of atoms\n",
00804 " list -- get atom indices\n",
00805 " get <list of attributes> -- for attributes use 'atomselect keywords'\n",
00806 " set <list of attributes> <nested list of values>\n",
00807 " getbonds -- get list of bonded atoms\n",
00808 " setbonds <bondlists>\n",
00809 " getbondorders -- get list of bond orders\n",
00810 " setbondorders <bondlists>\n",
00811 " getbondtypes -- get list of bond types\n",
00812 " setbondtypes <bondlists>\n",
00813 " moveto|moveby <3 vector> -- change atomic coordinates\n",
00814 " lmoveto|lmoveby <x> <y> <z>\n",
00815 " move <4x4 transforamtion matrix>\n",
00816 "\nCommands for writing to a file:\n",
00817 " writepdb <filename> -- write sel to PDB file\n",
00818 " writeXXX <filename> -- write sel to XXX file (if XXX is a known format)\n",
00819 NULL);
00820 return TCL_ERROR;
00821 }
00822 
00823 switch(option) {
00824 case 0: { // num
00825 char tmpstring[64];
00826 sprintf(tmpstring, "%d", atomSel->selected);
00827 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
00828 return TCL_OK;
00829 }
00830 case 1: { // list
00831 char tmpstring[64];
00832 for (int i=atomSel->firstsel; i<=atomSel->lastsel; i++) {
00833 if (atomSel->on[i]) {
00834 sprintf(tmpstring, "%d", i);
00835 Tcl_AppendElement(interp, tmpstring);
00836 } 
00837 }
00838 return TCL_OK;
00839 }
00840 case 2: { // molid
00841 char tmpstring[64];
00842 sprintf(tmpstring, "%d", atomSel->molid());
00843 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE); 
00844 return TCL_OK;
00845 }
00846 case 3: { // text
00847 Tcl_SetResult(interp, atomSel->cmdStr, TCL_VOLATILE);
00848 return TCL_OK;
00849 }
00850 case 20: { // frame
00851 char tmpstring[1024];
00852 switch (atomSel->which_frame) {
00853 case AtomSel::TS_LAST: sprintf(tmpstring, "last"); break;
00854 case AtomSel::TS_NOW : sprintf(tmpstring, "now"); break;
00855 default:
00856 sprintf(tmpstring, "%d", atomSel->which_frame);
00857 }
00858 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
00859 return TCL_OK;
00860 }
00861 case 21: { // frame <num>
00862 int val;
00863 if (AtomSel::get_frame_value(argv[2], &val) != 0) {
00864 Tcl_AppendResult(interp, "atomsel: frame '", argv[2], "' invalid; ",
00865 "please use a number >=0 or 'first', 'last', or 'now'", NULL);
00866 return TCL_ERROR;
00867 }
00868 atomSel -> which_frame = val;
00869 return TCL_OK;
00870 }
00871 case 4: { // get
00872 // check that the molecule exists
00873 Molecule *mol = mlist->mol_from_id(atomSel -> molid());
00874 if (!mol) {
00875 char tmpstring[1024];
00876 sprintf(tmpstring, "atomsel: get: was molecule %d deleted?",
00877 atomSel->molid());
00878 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
00879 return TCL_ERROR;
00880 }
00881 
00882 // get the mapping
00883 int *mapping;
00884 int num_mapping;
00885 if (split_tcl_atomsel_info(interp, atomSelParser, argv[2], 
00886 &num_mapping, &mapping) != TCL_OK) {
00887 Tcl_AppendResult(interp, ": in atomsel: get:", NULL);
00888 return TCL_ERROR;
00889 }
00890 
00891 // get the requested information
00892 Tcl_Obj *result = Tcl_NewListObj(0,NULL);
00893 if (num_mapping == 1) {
00894 // special case for only one property - don't have to build sublists
00895 // for data elements, resulting in large speedup.
00896 SymbolTableElement *elem = atomSelParser->fctns.data(mapping[0]);
00897 if (elem->is_a == SymbolTableElement::SINGLEWORD) {
00898 // Set the singleword, in case this is a macro.
00899 context.singleword = atomSelParser->fctns.name(mapping[0]);
00900 // get the boolean state
00901 int *flgs = new int[atomSel->num_atoms]; 
00902 memcpy(flgs, atomSel->on, atomSel->num_atoms * sizeof(int));
00903 elem->keyword_single(&context, atomSel->num_atoms, flgs);
00904 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
00905 if (atomSel->on[j])
00906 Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(flgs[j]));
00907 }
00908 delete [] flgs;
00909 } else { // then this is a keyword, and I already have routines to use
00910 switch(elem->returns_a) {
00911 case (SymbolTableElement::IS_STRING):
00912 {
00913 const char **tmp = new const char *[atomSel->num_atoms]; 
00914 elem->keyword_string(&context, atomSel->num_atoms, tmp, atomSel->on);
00915 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
00916 if (atomSel->on[j])
00917 Tcl_ListObjAppendElement(interp, result,
00918 Tcl_NewStringObj((char *)tmp[j], -1));
00919 }
00920 delete [] tmp;
00921 }
00922 break;
00923 case (SymbolTableElement::IS_INT):
00924 {
00925 int *tmp = new int[atomSel->num_atoms]; 
00926 elem->keyword_int(&context, atomSel->num_atoms, tmp, atomSel->on);
00927 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
00928 if (atomSel->on[j])
00929 Tcl_ListObjAppendElement(interp, result,
00930 Tcl_NewIntObj(tmp[j]));
00931 }
00932 delete [] tmp;
00933 }
00934 break; 
00935 case (SymbolTableElement::IS_FLOAT):
00936 {
00937 double *tmp = new double[atomSel->num_atoms]; 
00938 elem->keyword_double(&context, atomSel->num_atoms, tmp, atomSel->on);
00939 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
00940 if (atomSel->on[j])
00941 Tcl_ListObjAppendElement(interp, result,
00942 Tcl_NewDoubleObj(tmp[j]));
00943 }
00944 delete [] tmp;
00945 } 
00946 break;
00947 default: ;
00948 } // switch
00949 }
00950 } else {
00951 // construct sublists each atom; each sublist will contain the
00952 // requested properties for each atom.
00953 for (i=0; i<atomSel->selected; i++) {
00954 Tcl_ListObjAppendElement(interp, result, Tcl_NewListObj(0,NULL));
00955 } 
00956 // Get the array of sublists for efficient access.
00957 Tcl_Obj **arr;
00958 int dum;
00959 Tcl_ListObjGetElements(interp, result, &dum, &arr);
00960 
00961 for (i=0; i<num_mapping; i++) {
00962 SymbolTableElement *elem = atomSelParser->fctns.data(mapping[i]);
00963 if (elem->is_a == SymbolTableElement::SINGLEWORD) {
00964 // Set the singleword, in case this is a macro.
00965 context.singleword = atomSelParser->fctns.name(mapping[i]);
00966 // get the boolean state
00967 int *flgs = new int[atomSel->num_atoms]; 
00968 memcpy(flgs, atomSel->on, atomSel->num_atoms * sizeof(int));
00969 elem->keyword_single(&context, atomSel->num_atoms, flgs);
00970 int k=0; 
00971 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
00972 if (atomSel->on[j])
00973 Tcl_ListObjAppendElement(interp, arr[k++], 
00974 Tcl_NewIntObj(flgs[j]));
00975 }
00976 delete [] flgs;
00977 } else { // then this is a keyword, and I already have routines to use
00978 switch(elem->returns_a) {
00979 case (SymbolTableElement::IS_STRING):
00980 {
00981 const char **tmp = new const char *[atomSel->num_atoms]; 
00982 elem->keyword_string(&context, atomSel->num_atoms, tmp, atomSel->on);
00983 int k=0;
00984 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
00985 if (atomSel->on[j])
00986 Tcl_ListObjAppendElement(interp, arr[k++],
00987 Tcl_NewStringObj((char *)tmp[j], -1));
00988 }
00989 delete [] tmp;
00990 }
00991 break;
00992 case (SymbolTableElement::IS_INT):
00993 {
00994 int *tmp = new int[atomSel->num_atoms]; 
00995 elem->keyword_int(&context, atomSel->num_atoms, tmp, atomSel->on);
00996 int k=0;
00997 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
00998 if (atomSel->on[j])
00999 Tcl_ListObjAppendElement(interp, arr[k++],
01000 Tcl_NewIntObj(tmp[j]));
01001 }
01002 delete [] tmp;
01003 }
01004 break; 
01005 case (SymbolTableElement::IS_FLOAT):
01006 {
01007 double *tmp = new double[atomSel->num_atoms]; 
01008 elem->keyword_double(&context, atomSel->num_atoms, tmp, atomSel->on);
01009 int k=0;
01010 for (int j=atomSel->firstsel; j<=atomSel->lastsel; j++) {
01011 if (atomSel->on[j])
01012 Tcl_ListObjAppendElement(interp, arr[k++],
01013 Tcl_NewDoubleObj(tmp[j]));
01014 }
01015 delete [] tmp;
01016 } 
01017 break;
01018 default: ;
01019 } // switch
01020 } // else (singleword)
01021 } // loop over mappings
01022 } // if (num_mapping)
01023 delete [] mapping;
01024 Tcl_SetObjResult(interp, result);
01025 return TCL_OK;
01026 }
01027 case 6: // type
01028 Tcl_SetResult(interp, (char *) "atomselect", TCL_STATIC);
01029 return TCL_OK;
01030 
01031 case 7: // moveby
01032 return atomselect_moveby(interp, atomSel, argv[2]);
01033 
01034 case 8: // lmoveby
01035 return Tcl_VarEval(interp, "vmd_atomselect_lmoveby {", argv[0], 
01036 (char *)"} {",
01037 argv[2], "}", NULL); 
01038 
01039 case 9: // moveto
01040 return Tcl_VarEval(interp, "vmd_atomselect_moveto {", argv[0], 
01041 (char *)"} {",
01042 argv[2], "}", NULL); 
01043 
01044 case 10: // lmoveto
01045 return Tcl_VarEval(interp, "vmd_atomselect_lmoveto {", argv[0], 
01046 (char *)"} {",
01047 argv[2], "}", NULL); 
01048 
01049 case 11: // move {transformation}
01050 return atomselect_move(interp, atomSel, argv[2]);
01051 
01052 case 12: // delete
01053 return Tcl_VarEval(interp, "unset upproc_var_", argv[0], NULL);
01054 case 13: // global
01055 return Tcl_VarEval(interp, "upproc #0 ", argv[0], NULL);
01056 case 14: // uplevel
01057 return Tcl_VarEval(interp, "upproc ", argv[1], " ", argv[0], NULL);
01058 
01059 case 23: { // writeXXX <name>
01060 const char *filetype = argv[1]+5;
01061 outfile_name = argv[2];
01062 // check that the molecule exists
01063 int molid = atomSel->molid();
01064 if (!app->molecule_valid_id(molid)) {
01065 char buf[512];
01066 sprintf(buf, "atomsel: writeXXX: was molecule %d deleted?", molid);
01067 Tcl_SetResult(interp, buf, TCL_VOLATILE);
01068 return TCL_ERROR;
01069 }
01070 // parse the selected frame and check for valid range
01071 int frame=-1;
01072 switch (atomSel -> which_frame) {
01073 case AtomSel::TS_NOW: frame = app->molecule_frame(molid); break;
01074 case AtomSel::TS_LAST: frame = app->molecule_numframes(molid)-1; break;
01075 default: frame = atomSel->which_frame; break;
01076 }
01077 if (frame < 0 || frame >= app->molecule_numframes(molid)) {
01078 char tmpstring[1024];
01079 sprintf(tmpstring, "atomsel: frame %d out of range for molecule %d", 
01080 frame, molid);
01081 Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
01082 return TCL_ERROR;
01083 }
01084 // Write the requested atoms to the file
01085 FileSpec spec;
01086 spec.first = frame; // write current frame only
01087 spec.last = frame; // write current frame only
01088 spec.stride = 1; // write all selected frames
01089 spec.waitfor = FileSpec::WAIT_ALL; // wait for all frames to be written
01090 spec.selection = atomSel->on; // write only selected atoms
01091 if (!app->molecule_savetrajectory(molid, outfile_name, filetype, &spec)) {
01092 Tcl_AppendResult(interp, "atomsel: ", argv[1], " failed.", NULL);
01093 return TCL_ERROR;
01094 }
01095 return TCL_OK;
01096 }
01097 
01098 case 24: // getbonds
01099 {
01100 Molecule *mol = mlist->mol_from_id(atomSel->molid());
01101 if (!mol) {
01102 Tcl_AppendResult(interp, "atomsel : getbonds: was molecule deleted", 
01103 NULL);
01104 return TCL_ERROR;
01105 }
01106 Tcl_Obj *result = Tcl_NewListObj(0,NULL);
01107 for (int i=atomSel->firstsel; i<=atomSel->lastsel; i++) {
01108 if (atomSel->on[i]) {
01109 Tcl_Obj *bondlist = Tcl_NewListObj(0,NULL);
01110 const MolAtom *atom = mol->atom(i);
01111 for (int j=0; j<atom->bonds; j++) {
01112 Tcl_ListObjAppendElement(interp, bondlist, 
01113 Tcl_NewIntObj(atom->bondTo[j]));
01114 } 
01115 Tcl_ListObjAppendElement(interp, result, bondlist); 
01116 }
01117 }
01118 Tcl_SetObjResult(interp, result);
01119 return TCL_OK;
01120 }
01121 break;
01122 
01123 case 25: // setbonds:
01124 {
01125 Molecule *mol = mlist->mol_from_id(atomSel->molid());
01126 if (!mol) {
01127 Tcl_AppendResult(interp, "atomsel : setbonds: was molecule deleted",
01128 NULL);
01129 return TCL_ERROR;
01130 }
01131 int num;
01132 const char **bondlists;
01133 if (Tcl_SplitList(interp, argv[2], &num, &bondlists) != TCL_OK) {
01134 Tcl_AppendResult(interp, "atomsel : setbonds: invalid bondlists", NULL);
01135 return TCL_ERROR;
01136 }
01137 if (num != atomSel->selected) {
01138 Tcl_AppendResult(interp, "atomsel : setbonds: Need one bondlist for ",
01139 "each selected atom", NULL);
01140 return TCL_ERROR;
01141 }
01142 
01143 // when user sets data fields they are marked as valid data in BaseMolecule
01144 mol->set_dataset_flag(BaseMolecule::BONDS);
01145 
01146 int ii = 0;
01147 mol->force_recalc(DrawMolItem::MOL_REGEN); // XXX many reps ignore bonds
01148 for (int i=atomSel->firstsel; i<=atomSel->lastsel; i++) {
01149 if (!atomSel->on[i]) 
01150 continue;
01151 int numbonds;
01152 const char **atomids;
01153 if (Tcl_SplitList(interp, bondlists[ii], &numbonds, &atomids) != TCL_OK) {
01154 Tcl_AppendResult(interp, "atomsel: setbonds: Unable to parse bondlist",
01155 NULL);
01156 Tcl_Free((char *)bondlists);
01157 return TCL_ERROR;
01158 }
01159 if (numbonds > MAXATOMBONDS) {
01160 Tcl_AppendResult(interp, 
01161 "atomsel: setbonds: too many bonds in bondlist: ", bondlists[ii],
01162 "\n", NULL);
01163 char buf[8];
01164 sprintf(buf, "%ld", MAXATOMBONDS);
01165 Tcl_AppendResult(interp, "Maximum of ", buf, " bonds\n", NULL);
01166 Tcl_Free((char *)atomids);
01167 Tcl_Free((char *)bondlists);
01168 return TCL_ERROR;
01169 }
01170 MolAtom *atom = mol->atom(i);
01171 int k=0; 
01172 for (int j=0; j<numbonds; j++) {
01173 int id;
01174 if (Tcl_GetInt(interp, atomids[j], &id) != TCL_OK) {
01175 Tcl_Free((char *)atomids);
01176 Tcl_Free((char *)bondlists);
01177 return TCL_ERROR;
01178 }
01179 if (id >= 0 && id < mol->nAtoms) {
01180 atom->bondTo[k++] = id;
01181 } else {
01182 Tcl_AppendResult(interp,
01183 "atomsel: setbonds: warning, ignoring invalid atom id: ", 
01184 atomids[j], "\n", NULL);
01185 } 
01186 }
01187 atom->bonds = k;
01188 Tcl_Free((char *)atomids);
01189 ii++; 
01190 }
01191 Tcl_Free((char *)bondlists);
01192 return TCL_OK;
01193 } 
01194 break; 
01195 
01196 case 26: // update
01197 {
01198 Molecule *mol = mlist->mol_from_id(atomSel->molid());
01199 if (!mol) {
01200 Tcl_AppendResult(interp, "atomsel : update: was molecule deleted?",
01201 NULL);
01202 return TCL_ERROR;
01203 }
01204 int retval = atomSel->change(NULL, mol);
01205 if (retval == AtomSel::NO_PARSE) {
01206 Tcl_AppendResult(interp, "atomsel : update: invalid selection",
01207 NULL);
01208 return TCL_ERROR;
01209 }
01210 return TCL_OK;
01211 }
01212 
01213 case 27: // getbondorders
01214 {
01215 Molecule *mol = mlist->mol_from_id(atomSel->molid());
01216 if (!mol) {
01217 Tcl_AppendResult(interp, "atomsel : getbondorders: was molecule deleted", NULL);
01218 return TCL_ERROR;
01219 }
01220 Tcl_Obj *result = Tcl_NewListObj(0,NULL);
01221 for (int i=atomSel->firstsel; i<=atomSel->lastsel; i++) {
01222 if (atomSel->on[i]) {
01223 Tcl_Obj *bondlist = Tcl_NewListObj(0,NULL);
01224 const MolAtom *atom = mol->atom(i);
01225 for (int j=0; j<atom->bonds; j++) {
01226 Tcl_ListObjAppendElement(interp, bondlist, 
01227 Tcl_NewDoubleObj(mol->getbondorder(i, j)));
01228 } 
01229 Tcl_ListObjAppendElement(interp, result, bondlist); 
01230 }
01231 }
01232 Tcl_SetObjResult(interp, result);
01233 return TCL_OK;
01234 }
01235 break;
01236 
01237 case 28: // setbondorders:
01238 {
01239 Molecule *mol = mlist->mol_from_id(atomSel->molid());
01240 if (!mol) {
01241 Tcl_AppendResult(interp, "atomsel : setbondorders: was molecule deleted",
01242 NULL);
01243 return TCL_ERROR;
01244 }
01245 int num;
01246 const char **bondlists;
01247 if (Tcl_SplitList(interp, argv[2], &num, &bondlists) != TCL_OK) {
01248 Tcl_AppendResult(interp, "atomsel : setbondorders: invalid bond order lists", NULL);
01249 return TCL_ERROR;
01250 }
01251 if (num != atomSel->selected) {
01252 Tcl_AppendResult(interp, "atomsel : setbondorders: Need one bond order list for ", "each selected atom", NULL);
01253 return TCL_ERROR;
01254 }
01255 
01256 // when user sets data fields they are marked as valid data in BaseMolecule
01257 mol->set_dataset_flag(BaseMolecule::BONDORDERS);
01258 
01259 int ii = 0;
01260 mol->force_recalc(DrawMolItem::MOL_REGEN); // XXX many reps ignore bonds
01261 for (int i=atomSel->firstsel; i<=atomSel->lastsel; i++) {
01262 if (!atomSel->on[i]) 
01263 continue;
01264 int numbonds;
01265 const char **atomids;
01266 if (Tcl_SplitList(interp, bondlists[ii], &numbonds, &atomids) != TCL_OK) {
01267 Tcl_AppendResult(interp, "atomsel: setbondorders: Unable to parse bond order list",
01268 NULL);
01269 Tcl_Free((char *)bondlists);
01270 return TCL_ERROR;
01271 }
01272 if (numbonds > MAXATOMBONDS || numbonds > mol->atom(i)->bonds) {
01273 Tcl_AppendResult(interp, 
01274 "atomsel: setbondorders: too many items in bond order list: ", bondlists[ii],
01275 "\n", NULL);
01276 char buf[8];
01277 sprintf(buf, "%ld", MAXATOMBONDS);
01278 Tcl_AppendResult(interp, "Maximum of ", buf, " bonds\n", NULL);
01279 Tcl_Free((char *)atomids);
01280 Tcl_Free((char *)bondlists);
01281 return TCL_ERROR;
01282 }
01283 int k=0; 
01284 for (int j=0; j<numbonds; j++) {
01285 double order;
01286 if (Tcl_GetDouble(interp, atomids[j], &order) != TCL_OK) {
01287 Tcl_Free((char *)atomids);
01288 Tcl_Free((char *)bondlists);
01289 return TCL_ERROR;
01290 }
01291 mol->setbondorder(i, k++, (float) order);
01292 }
01293 Tcl_Free((char *)atomids);
01294 ii++; 
01295 }
01296 Tcl_Free((char *)bondlists);
01297 return TCL_OK;
01298 }
01299 break;
01300 
01301 case 29: // getbondtypes
01302 {
01303 Molecule *mol = mlist->mol_from_id(atomSel->molid());
01304 if (!mol) {
01305 Tcl_AppendResult(interp, "atomsel : getbondtypes: was molecule deleted", NULL);
01306 return TCL_ERROR;
01307 }
01308 Tcl_Obj *result = Tcl_NewListObj(0,NULL);
01309 for (int i=atomSel->firstsel; i<=atomSel->lastsel; i++) {
01310 if (atomSel->on[i]) {
01311 Tcl_Obj *bondlist = Tcl_NewListObj(0,NULL);
01312 const MolAtom *atom = mol->atom(i);
01313 for (int j=0; j<atom->bonds; j++) {
01314 Tcl_ListObjAppendElement(interp, bondlist, 
01315 Tcl_NewStringObj(mol->bondTypeNames.name(mol->getbondtype(i, j)),-1));
01316 } 
01317 Tcl_ListObjAppendElement(interp, result, bondlist); 
01318 }
01319 }
01320 Tcl_SetObjResult(interp, result);
01321 return TCL_OK;
01322 }
01323 break;
01324 
01325 case 30: // setbondtypes:
01326 {
01327 Molecule *mol = mlist->mol_from_id(atomSel->molid());
01328 if (!mol) {
01329 Tcl_AppendResult(interp, "atomsel : setbondtypes: was molecule deleted",
01330 NULL);
01331 return TCL_ERROR;
01332 }
01333 int num;
01334 const char **bondlists;
01335 if (Tcl_SplitList(interp, argv[2], &num, &bondlists) != TCL_OK) {
01336 Tcl_AppendResult(interp, "atomsel : setbondtypes: invalid bond type lists", NULL);
01337 return TCL_ERROR;
01338 }
01339 if (num != atomSel->selected) {
01340 Tcl_AppendResult(interp, "atomsel : setbondtypes: Need one bond type list for ", "each selected atom", NULL);
01341 return TCL_ERROR;
01342 }
01343 
01344 // when user sets data fields they are marked as valid data in BaseMolecule
01345 mol->set_dataset_flag(BaseMolecule::BONDTYPES);
01346 
01347 int ii = 0;
01348 for (int i=atomSel->firstsel; i<=atomSel->lastsel; i++) {
01349 if (!atomSel->on[i]) 
01350 continue;
01351 int numbonds;
01352 const char **atomids;
01353 if (Tcl_SplitList(interp, bondlists[ii], &numbonds, &atomids) != TCL_OK) {
01354 Tcl_AppendResult(interp, "atomsel: setbondtypes: Unable to parse bond type list",
01355 NULL);
01356 Tcl_Free((char *)bondlists);
01357 return TCL_ERROR;
01358 }
01359 if (numbonds > MAXATOMBONDS || numbonds > mol->atom(i)->bonds) {
01360 Tcl_AppendResult(interp, 
01361 "atomsel: setbondtypes: too many items in bond type list: ", bondlists[ii],
01362 "\n", NULL);
01363 char buf[8];
01364 sprintf(buf, "%ld", MAXATOMBONDS);
01365 Tcl_AppendResult(interp, "Maximum of ", buf, " bonds\n", NULL);
01366 Tcl_Free((char *)atomids);
01367 Tcl_Free((char *)bondlists);
01368 return TCL_ERROR;
01369 }
01370 int k=0; 
01371 for (int j=0; j<numbonds; j++) {
01372 int type = mol->bondTypeNames.add_name(atomids[j], 0);
01373 mol->setbondtype(i, k++, type);
01374 }
01375 Tcl_Free((char *)atomids);
01376 ii++; 
01377 }
01378 Tcl_Free((char *)bondlists);
01379 return TCL_OK;
01380 } 
01381 break; 
01382 default:
01383 break;
01384 }
01385 
01386 Tcl_SetResult(interp, (char *) "atomselect: error: major weirdness!", TCL_STATIC);
01387 return TCL_ERROR;
01388 }
01389 
01390 
01391 // an "atomselect%u" is to be deleted
01392 void remove_tcl_atomsel(ClientData my_data) {
01393 delete (AtomSel *)my_data;
01394 }
01395 
01396 // callback for when the interpreter gets deleted.
01397 static void Atomsel_Delete(ClientData cd, Tcl_Interp *) {
01398 free(cd);
01399 }
01400 
01401 int Atomsel_Init(Tcl_Interp *interp) {
01402 VMDApp *app = (VMDApp *)Tcl_GetAssocData(interp, (char *)"VMDApp", NULL);
01403 
01404 Tcl_CreateCommand(interp, (char *) "atomselect", make_tcl_atomsel,
01405 (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
01406 
01407 int *num = (int *)malloc(sizeof(int)); 
01408 *num = 0;
01409 Tcl_SetAssocData(interp, (char *)"AtomSel", Atomsel_Delete, num);
01410 return TCL_OK;
01411 }
01412 
01413 #if defined(VMDTKCON)
01414 // tk based console glue code.
01415 #ifndef CONST
01416 #define CONST
01417 #endif
01418 
01419 /* provides a vmdcon command */
01420 int tcl_vmdcon(ClientData nodata, Tcl_Interp *interp,
01421 int objc, Tcl_Obj *const objv[]) {
01422 
01423 int newline, objidx, loglvl;
01424 CONST char *txt;
01425 
01426 newline=1;
01427 objidx=1;
01428 
01429 /* handle -nonewline */
01430 if (objidx < objc) {
01431 txt = Tcl_GetString(objv[objidx]);
01432 if (strcmp(txt, "-nonewline") == 0) {
01433 ++objidx;
01434 newline=0;
01435 }
01436 }
01437 
01438 /* handle -register/-unregister/-info/-warn/-error */
01439 if (objidx < objc) {
01440 txt = Tcl_GetString(objv[objidx]);
01441 // register a text widget as a console
01442 if (strcmp(txt, "-register") == 0) {
01443 ++objidx;
01444 newline=0;
01445 if (objidx < objc) {
01446 CONST char *mark="end";
01447 txt = Tcl_GetString(objv[objidx]);
01448 ++objidx;
01449 if (objidx < objc) {
01450 mark = Tcl_GetString(objv[objidx]);
01451 }
01452 vmdcon_register(txt, mark, (void *)interp);
01453 return TCL_OK;
01454 } else {
01455 Tcl_WrongNumArgs(interp, 1, objv, "-register widget_path ?mark?");
01456 return TCL_ERROR;
01457 }
01458 }
01459 // unregister the current text widget as console
01460 // NOTE: this will keep a history buffer which will
01461 // be displayed on the next registered text widget.
01462 if (strcmp(txt, "-unregister") == 0) {
01463 vmdcon_register(NULL, NULL, (void *)interp);
01464 return TCL_OK;
01465 }
01466 
01467 // connect console output back to the calling terminal
01468 if (strcmp(txt, "-textmode") == 0) {
01469 vmdcon_use_text((void *)interp);
01470 return TCL_OK;
01471 }
01472 // connect console output to the registered text widget
01473 if (strcmp(txt, "-widgetmode") == 0) {
01474 vmdcon_use_widget((void *)interp);
01475 return TCL_OK;
01476 }
01477 
01478 // reprint recent console messages.
01479 if (strcmp(txt, "-dmesg") == 0) {
01480 vmdcon_showlog();
01481 return TCL_OK;
01482 }
01483 
01484 // report console status
01485 if (strcmp(txt, "-status") == 0) {
01486 Tcl_Obj *result;
01487 switch (vmdcon_get_status()) {
01488 case VMDCON_UNDEF: 
01489 result = Tcl_NewStringObj("undefined",-1);
01490 break;
01491 
01492 case VMDCON_NONE: 
01493 result = Tcl_NewStringObj("none",-1);
01494 break;
01495 
01496 case VMDCON_TEXT: 
01497 result = Tcl_NewStringObj("text",-1);
01498 break;
01499 
01500 case VMDCON_WIDGET: 
01501 result = Tcl_NewStringObj("widget",-1);
01502 break;
01503 
01504 default: 
01505 Tcl_AppendResult(interp, 
01506 "vmdcon: unknown console status", 
01507 NULL);
01508 return TCL_ERROR; 
01509 }
01510 Tcl_SetObjResult(interp, result);
01511 return TCL_OK;
01512 }
01513 
01514 // report console status
01515 if (strcmp(txt, "-loglevel") == 0) {
01516 ++objidx;
01517 if (objidx < objc) {
01518 txt = Tcl_GetString(objv[objidx]);
01519 if (strcmp(txt,"all")==0) {
01520 vmdcon_set_loglvl(VMDCON_ALL);
01521 } else if (strcmp(txt,"info")==0) {
01522 vmdcon_set_loglvl(VMDCON_INFO);
01523 } else if (strcmp(txt,"warn")==0) {
01524 vmdcon_set_loglvl(VMDCON_WARN);
01525 } else if (strcmp(txt,"err")==0) {
01526 vmdcon_set_loglvl(VMDCON_ERROR);
01527 } else {
01528 Tcl_AppendResult(interp, "vmdcon: unkown log level: ",
01529 txt, NULL);
01530 return TCL_ERROR;
01531 }
01532 return TCL_OK;
01533 } else {
01534 Tcl_Obj *result;
01535 switch (vmdcon_get_loglvl()) {
01536 case VMDCON_ALL: 
01537 result = Tcl_NewStringObj("all",-1);
01538 break;
01539 
01540 case VMDCON_INFO: 
01541 result = Tcl_NewStringObj("info",-1);
01542 break;
01543 
01544 case VMDCON_WARN: 
01545 result = Tcl_NewStringObj("warn",-1);
01546 break;
01547 
01548 case VMDCON_ERROR: 
01549 result = Tcl_NewStringObj("err",-1);
01550 break;
01551 
01552 default: 
01553 Tcl_AppendResult(interp, 
01554 "vmdcon: unknown log level.", 
01555 NULL);
01556 return TCL_ERROR; 
01557 }
01558 Tcl_SetObjResult(interp, result);
01559 return TCL_OK;
01560 }
01561 }
01562 
01563 // print a help message
01564 if (strcmp(txt, "-help") == 0) {
01565 Tcl_AppendResult(interp, 
01566 "usage: vmdcon ?-nonewline? ?options? [arguments]\n",
01567 " print data to the VMD console or change console behavior\n\n",
01568 "Output options:\n",
01569 " with no options 'vmdcon' copies all arguments to the current console\n",
01570 " -info -- prepend output with 'Info) '\n",
01571 " -warn -- prepend output with 'Warning) '\n",
01572 " -err -- prepend output with 'ERROR) '\n",
01573 " -nonewline -- don't append a newline to the output\n",
01574 "Console mode options:\n",
01575 " -register <widget_path> ?<mark>? -- register a tk text widget as console\n",
01576 " optionally provide a mark as reference for insertions. otherwise 'end' is used\n",
01577 " -unregister -- unregister the currently registered console widget\n",
01578 " -textmode -- switch to text mode console (using stdio)\n",
01579 " -widgetmode -- switch to tk (registered) text widget as console\n\n",
01580 " -loglevel ?all|info|warn|err? -- get or set console log level (output to console only at that level or higher)\n",
01581 "General options:\n",
01582 " -status -- report current console status (text|widget|none)\n",
01583 " -dmesg -- (re)print recent console messages\n",
01584 " -help -- print this help message\n",
01585 NULL);
01586 
01587 return TCL_OK;
01588 }
01589 
01590 // from here on we assume that the intent is to send output
01591 
01592 // prepend the final output with "urgency" indicators
01593 // XXX: ideally, there would be no vmdcon without any 
01594 // loglevel argument, but for the time being we tolerate 
01595 // it and promote it to the highest loglevel.
01596 loglvl=VMDCON_ALWAYS;
01597 
01598 if (strcmp(txt, "-info") == 0) {
01599 loglvl=VMDCON_INFO;
01600 vmdcon_append(loglvl, "Info) ", 6);
01601 ++objidx;
01602 } else if (strncmp(txt, "-warn", 5) == 0) {
01603 loglvl=VMDCON_WARN;
01604 vmdcon_append(loglvl, "Warning) ", 9);
01605 ++objidx;
01606 } else if (strncmp(txt, "-err", 4) == 0) {
01607 loglvl=VMDCON_ERROR;
01608 vmdcon_append(loglvl, "ERROR) ", 7);
01609 ++objidx;
01610 }
01611 }
01612 
01613 if (objidx < objc) {
01614 txt = Tcl_GetString(objv[objidx]);
01615 vmdcon_append(loglvl, txt, -1);
01616 ++objidx;
01617 }
01618 
01619 if(newline==1) {
01620 vmdcon_append(loglvl, "\n", 1);
01621 }
01622 vmdcon_purge();
01623 
01624 if (objidx < objc) {
01625 Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?-info|-warn|-err? string");
01626 return TCL_ERROR;
01627 }
01628 
01629 return TCL_OK;
01630 }
01631 
01632 // we use c bindings, so the subroutines can be
01633 // exported to c code (plugins!) as well.
01634 const char *tcl_vmdcon_insert(void *interp, const char *w_path, 
01635 const char *mark, const char *text)
01636 {
01637 // do: .path.to.text insert <mark> <text> ; .path.to.text see end
01638 JString cmd; 
01639 cmd = w_path;
01640 cmd += " insert ";
01641 cmd += mark;
01642 cmd += " {";
01643 cmd += text;
01644 cmd += "}; ";
01645 cmd += w_path;
01646 cmd += " see end;"; 
01647 
01648 if (Tcl_Eval((Tcl_Interp *)interp,(char *)(const char *)cmd) != TCL_OK) {
01649 return Tcl_GetStringResult((Tcl_Interp *)interp);
01650 }
01651 return NULL;
01652 }
01653 
01654 void tcl_vmdcon_set_status_var(void *interp, int status) 
01655 {
01656 if (interp != NULL) {
01657 Tcl_ObjSetVar2((Tcl_Interp *)interp, 
01658 Tcl_NewStringObj("vmd_console_status", -1),
01659 NULL, Tcl_NewIntObj(status),
01660 TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
01661 }
01662 }
01663 
01664 #endif /* VMDTKCON */