Main Page   Class Hierarchy   Alphabetical List   Compound List   File List   Compound Members   File Members   Related Pages  

TclCommands.C

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

Generated on Mon Oct 13 01:27:55 2008 for VMD (current) by doxygen1.2.14 written by Dimitri van Heesch, © 1997-2002