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

TclCommands.C

Go to the documentation of this file.
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 */

Generated on Tue Oct 15 02:45:13 2024 for VMD (current) by doxygen1.2.14 written by Dimitri van Heesch, © 1997-2002