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

TclTextInterp.C

Go to the documentation of this file.
00001 /***************************************************************************
00002  *cr
00003  *cr            (C) Copyright 1995-2011 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: TclTextInterp.C,v $
00013  *      $Author: johns $        $Locker:  $             $State: Exp $
00014  *      $Revision: 1.113 $      $Date: 2012/03/18 02:17:51 $
00015  *
00016  ***************************************************************************
00017  * DESCRIPTION:
00018  *   The Tcl-based text command interpreter implementation
00019  ***************************************************************************/
00020 
00021 #include <tcl.h>
00022 #include <stdlib.h>
00023 #include <ctype.h>  // for toupper/tolower
00024 
00025 #ifdef VMDTK
00026 #if defined(_MSC_VER)
00027 // XXX prototype, skip problems with tk.h.
00028 EXTERN int              Tk_Init _ANSI_ARGS_((Tcl_Interp *interp));
00029 #else
00030 #include <tk.h>         // Tk extensions
00031 #endif
00032 #endif
00033 
00034 #include "TclTextInterp.h"
00035 #include "Inform.h"
00036 #include "TclCommands.h"
00037 #include "VMDApp.h"
00038 #include "DisplayDevice.h" 
00039 
00040 #include "config.h"
00041 #if defined(VMDTKCON)
00042 #include "vmdconsole.h"
00043 #endif
00044 
00045 #if !defined(_MSC_VER)
00046 #include <unistd.h>
00047 static int vmd_isatty(int fd) {
00048   // Check for console tty override in case we're running on a cluster node
00049   // on Clustermatic or Scyld, which cause isatty() to return false even when
00050   // we do have a tty.  This makes it possible to get the normal VMD prompts
00051   // in an interactive bpsh session if we want.
00052   if (getenv("VMDFORCECONSOLETTY") != NULL)
00053     return 1;
00054 
00055   return isatty(fd);
00056 }
00057 
00058 #else
00059 static int vmd_isatty(int) {
00060   return 1;
00061 }
00062 #endif
00063 
00064 static int text_cmd_wait(ClientData cd, Tcl_Interp *interp, int argc,
00065                             const char *argv[]) {
00066 
00067   TclTextInterp *ttinterp = (TclTextInterp *)cd;
00068   if(argc == 2) {
00069     ttinterp->wait((float)atof(argv[1]));
00070   } else {
00071     Tcl_AppendResult(interp, "wait: Usage: wait <seconds>",NULL);
00072     return TCL_ERROR;
00073   }
00074   return TCL_OK;
00075 }
00076 
00077 static int text_cmd_quit(ClientData cd, Tcl_Interp *interp, int argc,
00078                             const char *argv[]) {
00079 
00080   VMDApp *app = (VMDApp *)cd;
00081   // Trigger exit sequence on next display update.  
00082   // Avoid calling VMDexit more than once.
00083   if (!app->exitFlag) app->VMDexit("",0,0);
00084 
00085   // return TCL_ERROR so that execution of procs or sourcing of files
00086   // stops here as well.
00087   return TCL_ERROR;
00088 }
00089 
00090 static int text_cmd_play(ClientData cd, Tcl_Interp *interp, int argc,
00091                                 const char *argv[]) {
00092 
00093   TclTextInterp *ttinterp = (TclTextInterp *)cd;
00094   if (argc != 2) {
00095     Tcl_AppendResult(interp, "Usage: play <filename>", NULL);
00096     return TCL_ERROR;
00097   }
00098   if (ttinterp->evalFile(argv[1])) return TCL_ERROR;
00099   return TCL_OK;
00100 }
00101 
00102 TclTextInterp::TclTextInterp(VMDApp *vmdapp, int guienabled)
00103 : app(vmdapp) {
00104   
00105   interp = Tcl_CreateInterp();
00106 #if 0
00107   Tcl_InitMemory(interp); // enable Tcl memory debugging features
00108                           // when compiled with TCL_MEM_DEBUG
00109 #endif
00110 
00111   commandPtr = Tcl_NewObj();
00112   Tcl_IncrRefCount(commandPtr);
00113   consoleisatty = vmd_isatty(0); // whether we're interactive or not
00114   gotPartial = 0;
00115   needPrompt = 1;
00116   callLevel = 0;
00117   starttime = delay = 0;
00118 
00119   // set tcl_interactive, lets us run unix commands as from a shell
00120   Tcl_SetVar(interp, "tcl_interactive", "1", 0);
00121 
00122   // pass our instance of VMDApp to a hash table assoc. with the interpreter 
00123   Tcl_SetAssocData(interp, "VMDApp", NULL, app);
00124  
00125   // Set up argc, argv0, and argv variables
00126   {
00127     char argcbuf[20];
00128     sprintf(argcbuf, "%d", app->argc_m);
00129     Tcl_SetVar(interp, "argc", argcbuf, TCL_GLOBAL_ONLY);
00130     // it might be better to use the same thing that was passed to
00131     // Tcl_FindExecutable, but this is now
00132     Tcl_SetVar(interp, "argv0", app->argv_m[0], TCL_GLOBAL_ONLY);
00133     char *args = Tcl_Merge(app->argc_m-1, app->argv_m+1);
00134     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
00135     Tcl_Free(args);
00136   }
00137 
00138 #if defined(_MSC_VER) && TCL_MINOR_VERSION >= 4
00139   // The Windows versions of Tcl 8.5.x have trouble finding
00140   // the Tcl library subdirectory for unknown reasons.
00141   // We force the appropriate env variables to be set in Tcl, 
00142   // despite Windows.
00143   {
00144     char vmdinitscript[4096];
00145     char * tcl_library = getenv("TCL_LIBRARY");
00146     char * tk_library = getenv("TK_LIBRARY");
00147 
00148     if (tcl_library) {
00149       sprintf(vmdinitscript, "set env(TCL_LIBRARY) {%s}", tcl_library);
00150       if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00151         msgErr << Tcl_GetStringResult(interp) << sendmsg;
00152       }
00153     }
00154     if (tk_library) {
00155       sprintf(vmdinitscript, "set env(TK_LIBRARY) {%s}", tk_library);
00156       if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00157         msgErr << Tcl_GetStringResult(interp) << sendmsg;
00158       }
00159     }
00160   }
00161 #endif
00162 
00163   if (Tcl_Init(interp) == TCL_ERROR) {  // new with 7.6
00164     msgErr << "Tcl startup error: " << Tcl_GetStringResult(interp) << sendmsg;
00165   }
00166 
00167 #ifdef VMDTK
00168   // and the Tk commands (but only if a GUI is available!)
00169   if (guienabled) {
00170     if (Tk_Init(interp) == TCL_ERROR) {
00171       msgErr << "Tk startup error: " << Tcl_GetStringResult(interp) << sendmsg;
00172     } else {
00173       Tcl_StaticPackage(interp,  "Tk",
00174                         (Tcl_PackageInitProc *) Tk_Init,
00175                         (Tcl_PackageInitProc *) NULL);
00176     }
00177   } // end of check that GUI is allowed
00178 #endif
00179   add_commands();
00180 }
00181 
00182 void TclTextInterp::add_commands() {
00183   Vmd_Init(interp);
00184 
00185   Atomsel_Init(interp);
00186 
00187   Tcl_CreateCommand(interp,  "molinfo", molecule_tcl,
00188                       (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00189 
00190   Tcl_CreateCommand(interp,  "graphics", graphics_tcl,
00191                       (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00192 
00193   Tcl_CreateCommand(interp,  "colorinfo", tcl_colorinfo,
00194                       (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00195 
00196   Tcl_CreateCommand(interp,  "wait", text_cmd_wait,
00197                       (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00198 
00199   Tcl_CreateCommand(interp,  "play", text_cmd_play,
00200                       (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00201 
00202   Tcl_CreateCommand(interp,  "exit", text_cmd_quit,
00203                       (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00204 
00205   Tcl_CreateCommand(interp,  "quit", text_cmd_quit,
00206                       (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00207 
00208   Vec_Init(interp);
00209 }
00210   
00211   
00212 void TclTextInterp::doInit() {
00213   int startuperror = 0;
00214   const char *vmddir;
00215   char vmdinitscript[4096];
00216   
00217   vmddir = getenv("VMDDIR"); 
00218 
00219   // read the VMD initialization script
00220   if (vmddir == NULL) {
00221     msgErr << "VMDDIR undefined, startup failure likely." << sendmsg;
00222 #if defined(_MSC_VER)
00223     vmddir = "c:/program files/university of illinois/vmd";
00224 #else
00225     vmddir = "/usr/local/lib/vmd";
00226 #endif
00227     startuperror = 1;
00228   } 
00229 
00230   // force VMDDIR env variable to be set in Tcl, despite Windows.
00231   sprintf(vmdinitscript, "set env(VMDDIR) {%s}", vmddir);
00232   if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00233     msgErr << Tcl_GetStringResult(interp) << sendmsg;
00234     startuperror = 1;
00235   }
00236 
00237   sprintf(vmdinitscript, "source {%s/scripts/vmd/vmdinit.tcl}", vmddir);
00238   if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00239     startuperror = 1;
00240   }
00241 
00242   if (startuperror) {
00243     msgErr << "Could not read the vmd initialization file -" << sendmsg;
00244     msgErr << "  " << vmdinitscript << sendmsg;
00245     msgErr << Tcl_GetStringResult(interp) << sendmsg;
00246 
00247 #if defined(_MSC_VER)
00248     msgErr << "The VMDDIR variable in the Windows registry is missing or" 
00249            << " incorrect. " << sendmsg;
00250 #else
00251     msgErr << "The VMDDIR environment variable is set by the startup"
00252            << sendmsg;
00253     msgErr << "script and should point to the top of the VMD hierarchy." 
00254            << sendmsg;
00255 #endif
00256     msgErr << "VMD will continue with limited functionality." << sendmsg;
00257   }
00258 }
00259 
00260 TclTextInterp::~TclTextInterp() {
00261   // Set callback variable, giving a chance for Tcl to do some clean-ups
00262   // (for example, if external jobs have been run and need to be halted...)
00263   setString("vmd_quit", "1");
00264   
00265   // DeleteInterp must precede Finalize!
00266   Tcl_DeleteInterp(interp);
00267   interp = NULL; // prevent use by Python if Tcl_Finalize() invokes
00268                  // shutdown scripts
00269 }
00270 
00271 int TclTextInterp::doTkUpdate() {
00272   // Loop on the Tcl event notifier
00273   while (Tcl_DoOneEvent(TCL_DONT_WAIT));
00274   return 1; 
00275 }  
00276 
00277 void TclTextInterp::doEvent() {
00278   if (!done_waiting())
00279     return;
00280 
00281   // no recursive calls to TclEvalObj; this prevents  
00282   // display update ui from messing up Tcl. 
00283   if (callLevel) 
00284     return;
00285 
00286   Tcl_Channel inChannel = Tcl_GetStdChannel(TCL_STDIN);
00287   Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
00288 
00289   if (needPrompt && consoleisatty) {
00290 #if TCL_MINOR_VERSION >= 4
00291     if (gotPartial) {
00292       Tcl_WriteChars(outChannel, "? ", -1);
00293     } else { 
00294       Tcl_WriteChars(outChannel, VMD_CMD_PROMPT, -1);
00295     }
00296 #else
00297     if (gotPartial) {
00298       Tcl_Write(outChannel, "? ", -1);
00299     } else { 
00300       Tcl_Write(outChannel, VMD_CMD_PROMPT, -1);
00301     }
00302 #endif
00303 #if defined(VMDTKCON)
00304     vmdcon_purge();
00305 #endif
00306     Tcl_Flush(outChannel);
00307     needPrompt = 0;
00308   }
00309  
00310 #if defined(VMDMPI)
00311   //
00312   // XXX MPI builds of VMD cannot try to read any command input from the 
00313   //     console because it creates shutdown problems, at least with MPICH.
00314   //     File-based command input is fine however.
00315   //
00316   return;
00317 #endif
00318  
00319   if (!vmd_check_stdin())
00320     return;
00321 
00322   //
00323   // event loop based on tclMain.c
00324   //
00325   // According to the Tcl docs, GetsObj returns -1 on error or EOF.
00326     
00327   int length = Tcl_GetsObj(inChannel, commandPtr);
00328   if (length < 0) {
00329     if (Tcl_Eof(inChannel)) {
00330       // exit if we're not a tty, or if eofexit is set
00331       if ((!consoleisatty) || app->get_eofexit())
00332         app->VMDexit("", 0, 0);
00333     } else {
00334       msgErr << "Error reading Tcl input: " << Tcl_ErrnoMsg(Tcl_GetErrno()) 
00335              << sendmsg;
00336     }
00337     return;
00338   }
00339   
00340   needPrompt = 1;
00341   // add the newline removed by Tcl_GetsObj
00342   Tcl_AppendToObj(commandPtr, "\n", 1);
00343 
00344   char *stringrep = Tcl_GetStringFromObj(commandPtr, NULL);
00345   if (!Tcl_CommandComplete(stringrep)) {
00346     gotPartial = 1;
00347     return;
00348   }
00349   gotPartial = 0;
00350 
00351   callLevel++;
00352   Tcl_RecordAndEvalObj(interp, commandPtr, 0);
00353   callLevel--;
00354 
00355 #if TCL_MINOR_VERSION >= 4
00356   Tcl_DecrRefCount(commandPtr);
00357   commandPtr = Tcl_NewObj();
00358   Tcl_IncrRefCount(commandPtr);
00359 #else
00360   // XXX this crashes Tcl 8.5.[46] with an internal panic
00361   Tcl_SetObjLength(commandPtr, 0);
00362 #endif
00363     
00364   // if ok, send to stdout; if not, send to stderr
00365   Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
00366   char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
00367 #if defined(VMDTKCON)
00368   if (length > 0) {
00369     vmdcon_append(VMDCON_ALWAYS, bytes,length);
00370     vmdcon_append(VMDCON_ALWAYS, "\n", 1);
00371   }
00372   vmdcon_purge();
00373 #else
00374   if (length > 0) {
00375 #if TCL_MINOR_VERSION >= 4
00376     Tcl_WriteChars(outChannel, bytes, length);
00377     Tcl_WriteChars(outChannel, "\n", 1);
00378 #else
00379     Tcl_Write(outChannel, bytes, length);
00380     Tcl_Write(outChannel, "\n", 1);
00381 #endif
00382   }
00383   Tcl_Flush(outChannel);
00384 #endif
00385 }
00386 
00387 int TclTextInterp::evalString(const char *s) {
00388   if (Tcl_RecordAndEval(interp, s, 0) != TCL_OK) {
00389     // Don't print error message if there's nothing to show.
00390     if (strlen(Tcl_GetStringResult(interp))) 
00391       msgErr << Tcl_GetStringResult(interp) << sendmsg;
00392     return FALSE;
00393   }
00394   return TRUE;
00395 }
00396 
00397 void TclTextInterp::setString(const char *name, const char *val) {
00398   if (interp)
00399     Tcl_SetVar(interp, name, val, 
00400       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00401 }
00402 
00403 void TclTextInterp::setMap(const char *name, const char *key, 
00404                            const char *val) { 
00405   if (interp)
00406     Tcl_SetVar2(interp, name, key, val, 
00407       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00408     
00409 }
00410 
00411 // There's a fair amount of code duplication between doEvent and evalFile,
00412 // maybe these could be combined somehow, say by having TclTextInterp keep 
00413 // track of its Tcl_Channel objects.
00414 // 
00415 // Side note: Reading line-by-line gives different Tcl semantics than 
00416 // just calling Tcl_EvalFile. Shell commands (e.g., stty) are properly
00417 // parsed when read line-by-line and passed to Tcl_RecordAndEval, but are
00418 // unrecognized when contained in a file read by Tcl_EvalFile.  I would 
00419 // consider this a bug.  
00420 
00421 int TclTextInterp::evalFile(const char *fname) {
00422   Tcl_Channel inchannel = Tcl_OpenFileChannel(interp, fname, "r", 0644);
00423   Tcl_Channel outchannel = Tcl_GetStdChannel(TCL_STDOUT);
00424   if (inchannel == NULL) {
00425     msgErr << "Error opening file " << fname << sendmsg;
00426     msgErr << Tcl_GetStringResult(interp) << sendmsg;
00427     return 1;
00428   }
00429 
00430   Tcl_Obj *cmdPtr = Tcl_NewObj();
00431   Tcl_IncrRefCount(cmdPtr);
00432   int length = 0;
00433   while ((length = Tcl_GetsObj(inchannel, cmdPtr)) >= 0) {
00434     Tcl_AppendToObj(cmdPtr, "\n", 1);
00435     char *stringrep = Tcl_GetStringFromObj(cmdPtr, NULL);
00436     if (!Tcl_CommandComplete(stringrep)) {
00437       continue;
00438     }
00439 
00440     // check if "exit" was called
00441     if (app->exitFlag) break;
00442 
00443     Tcl_RecordAndEvalObj(interp, cmdPtr, 0);
00444 
00445 #if TCL_MINOR_VERSION >= 4
00446     Tcl_DecrRefCount(cmdPtr);
00447     cmdPtr = Tcl_NewObj();
00448     Tcl_IncrRefCount(cmdPtr);
00449 #else
00450     // XXX this crashes Tcl 8.5.[46] with an internal panic
00451     Tcl_SetObjLength(cmdPtr, 0);
00452 #endif
00453 
00454     // XXX this makes sure the display is updated 
00455     // after each line read from the file or pipe
00456     // So, this is also where we'd optimise reading multiple
00457     // lines at once
00458     //
00459     // In VR modes (CAVE, FreeVR, VR Juggler) the draw method will 
00460     // not be called from app->display_update(), so multiple lines
00461     // of input could be combined in one frame, if possible
00462     app->display_update();
00463 
00464     Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
00465     char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
00466 #if defined(VMDTKCON)
00467     if (length > 0) {
00468       vmdcon_append(VMDCON_ALWAYS, bytes,length);
00469       vmdcon_append(VMDCON_ALWAYS, "\n", 1);
00470     }
00471     vmdcon_purge();
00472 #else
00473     if (length > 0) {
00474 #if TCL_MINOR_VERSION >= 4
00475       Tcl_WriteChars(outchannel, bytes, length);
00476       Tcl_WriteChars(outchannel, "\n", 1);
00477 #else
00478       Tcl_Write(outchannel, bytes, length);
00479       Tcl_Write(outchannel, "\n", 1);
00480 #endif
00481     }
00482     Tcl_Flush(outchannel);
00483 #endif
00484   }
00485   Tcl_Close(interp, inchannel);
00486   Tcl_DecrRefCount(cmdPtr);
00487   return 0;
00488 }
00489 
00490 void TclTextInterp::wait(float wd) {
00491   delay = wd;
00492   starttime = time_of_day();
00493 }
00494 int TclTextInterp::done_waiting() {
00495   if (delay > 0) {
00496     double elapsed = time_of_day() - starttime;
00497     if (elapsed > delay) {
00498       delay = -1;     // done waiting
00499     } else {
00500       return 0;       // not done yet
00501     }
00502   }
00503   return 1; // done
00504 }
00505 
00506 
00507 void TclTextInterp::frame_cb(int molid, int frame) {
00508   Tcl_ObjSetVar2(interp, Tcl_NewStringObj("vmd_frame", -1),
00509                          Tcl_NewIntObj(molid),
00510                          Tcl_NewIntObj(frame),
00511                          TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00512 }
00513 
00514 void TclTextInterp::help_cb(const char *topic) {
00515   JString cmd("help ");
00516   cmd += topic;
00517   evalString((const char *)cmd);
00518 }
00519 
00520 void TclTextInterp::molecule_changed_cb(int molid, int code) {
00521   char molstr[30];
00522   sprintf(molstr, "%d", molid);
00523   char codestr[30];
00524   sprintf(codestr, "%d", code);
00525   setMap("vmd_molecule", molstr, codestr);
00526 }
00527 
00528 void TclTextInterp::initialize_structure_cb(int molid, int code) {
00529   char molstr[30];
00530   sprintf(molstr, "%d", molid);
00531   char codestr[30];
00532   sprintf(codestr, "%d", code);
00533   setMap("vmd_initialize_structure", molstr, codestr);
00534 }
00535 
00536 
00537 void TclTextInterp::logfile_cb(const char *str) {
00538   setString("vmd_logfile", (const char *)str);
00539 }
00540 
00541 void TclTextInterp::pick_atom_cb(int molid, int atom, int ss, bool is_pick) {
00542   char s[40];
00543   sprintf(s, "%d",ss);
00544   setString("vmd_pick_shift_state", s);
00545   sprintf(s, "%d", molid);
00546   setString("vmd_pick_mol", s);
00547   sprintf(s, "%d", atom);
00548   setString("vmd_pick_atom", s);
00549   
00550   // only set this callback variable for a user pick event
00551   if (is_pick)
00552     setString("vmd_pick_event", "1");
00553 }
00554 
00555 void TclTextInterp::pick_atom_callback_cb(int molid, int atom, const char *client) {
00556   char s[40];
00557   sprintf(s, "%s", (const char *)client);
00558   setString("vmd_pick_client", s);
00559   sprintf(s, "%d", molid);
00560   setString("vmd_pick_mol_silent", s);
00561   sprintf(s, "%d", atom);
00562   setString("vmd_pick_atom_silent", s);
00563 } 
00564 
00565 void TclTextInterp::pick_graphics_cb(int molid, int tag, int btn, int shift_state) {
00566   char s[300];
00567   sprintf(s, "%d %d %d %d", molid, tag, btn, shift_state);
00568   setString("vmd_pick_graphics", s);
00569 }
00570 
00571 void TclTextInterp::pick_selection_cb(int num, const int *atoms) {
00572   JString s;
00573   if (num > 0) {
00574     s = "index";
00575     for (int i=0; i<num; i++) {
00576       char buf[20];
00577       sprintf(buf, " %d", atoms[i]);
00578       s += buf;
00579     }
00580   } else {
00581     s = "none";
00582   }
00583   setString("vmd_pick_selection", (const char *)s);
00584 }
00585  
00586 void TclTextInterp::pick_value_cb(float value) {
00587   char buf[20];
00588   sprintf(buf, "%f", value);
00589   setString("vmd_pick_value", buf);
00590 }
00591 
00592 void TclTextInterp::timestep_cb(int molid, int frame) {
00593   char mol[10];
00594   char n[10];
00595   sprintf(mol, "%d", molid);
00596   sprintf(n, "%d", frame);
00597   setMap("vmd_timestep", mol, n);
00598 }
00599 
00600 void TclTextInterp::graph_label_cb(const char *type, const int *ids, int n) {
00601   Tcl_Obj *itemlist = Tcl_NewListObj(0, NULL);
00602   for (int i=0; i<n; i++) {
00603     Tcl_Obj *item = Tcl_NewListObj(0, NULL);
00604     Tcl_ListObjAppendElement(interp, item, Tcl_NewStringObj(type, -1));
00605     Tcl_ListObjAppendElement(interp, item, Tcl_NewIntObj(ids[i]));
00606     Tcl_ListObjAppendElement(interp, itemlist, item);
00607   }
00608   Tcl_Obj *varname = Tcl_NewStringObj("vmd_graph_label", -1);
00609   if (!Tcl_ObjSetVar2(interp, varname, NULL, itemlist, 
00610         TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY)) {
00611     msgErr << "Error graphing labels: " << Tcl_GetStringResult(interp) << sendmsg;
00612   }
00613 }
00614 
00615 void TclTextInterp::trajectory_cb(int molid, const char *name) {
00616   char s[10];
00617   if (!name) return;
00618   sprintf(s, "%d", molid);
00619   setMap("vmd_trajectory_read", s, name);
00620 }
00621 
00622 void TclTextInterp::tcl_cb(const char *cmd) {
00623   evalString(cmd);
00624 }
00625 
00626 void TclTextInterp::mousemode_cb(const char *mode, int submode) {
00627   char tmp[20];
00628   sprintf(tmp, "%d", submode);
00629   setString("vmd_mouse_mode", (const char *)mode);
00630   setString("vmd_mouse_submode", tmp);
00631 }
00632 
00633 void TclTextInterp::mouse_pos_cb(float x, float y, int buttondown) {
00634   Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
00635   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(x));
00636   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(y));
00637   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
00638   Tcl_Obj *varname = Tcl_NewStringObj("vmd_mouse_pos", -1);
00639   Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
00640 }
00641 
00642 void TclTextInterp::mobile_state_changed_cb() {
00643   setString("vmd_mobile_state_changed", "1");
00644 }
00645 
00646 void TclTextInterp::mobile_device_command_cb(const char *str) {
00647   setString("vmd_mobile_device_command", (const char *)str);
00648 }
00649 
00650 void TclTextInterp::mobile_cb(float tx, float ty, float tz,
00651                               float rx, float ry, float rz, int buttondown) {
00652   Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
00653   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tx));
00654   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ty));
00655   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tz));
00656   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rx));
00657   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ry));
00658   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rz));
00659   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
00660   Tcl_Obj *varname = Tcl_NewStringObj("vmd_mobile", -1);
00661   Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
00662 }
00663 
00664 
00665 void TclTextInterp::spaceball_cb(float tx, float ty, float tz,
00666                                  float rx, float ry, float rz, int buttondown) {
00667   Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
00668   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tx));
00669   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ty));
00670   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tz));
00671   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rx));
00672   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ry));
00673   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rz));
00674   Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
00675   Tcl_Obj *varname = Tcl_NewStringObj("vmd_spaceball", -1);
00676   Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
00677 }
00678 
00679 void TclTextInterp::userkey_cb(const char *key_desc) {
00680   int indx = app->userKeys.typecode(key_desc);
00681   if(indx >= 0) {
00682     const char *cmd = app->userKeys.data(indx);
00683     evalString(cmd);
00684   }
00685 }
00686 

Generated on Tue May 22 01:48:16 2012 for VMD (current) by doxygen1.2.14 written by Dimitri van Heesch, © 1997-2002