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

colvarproxy_tcl.C

Go to the documentation of this file.
00001 // -*- c++ -*-
00002 
00003 // This file is part of the Collective Variables module (Colvars).
00004 // The original version of Colvars and its updates are located at:
00005 // https://github.com/Colvars/colvars
00006 // Please update all Colvars source files before making any changes.
00007 // If you wish to distribute your changes, please submit them to the
00008 // Colvars repository at GitHub.
00009 
00010 #include <sstream>
00011 #include <iostream>
00012 
00013 #include "colvarmodule.h"
00014 #include "colvarproxy.h"
00015 #include "colvarproxy_tcl.h"
00016 #include "colvaratoms.h"
00017 
00018 #ifdef COLVARS_TCL
00019 #include <tcl.h>
00020 #endif
00021 
00022 
00023 
00024 colvarproxy_tcl::colvarproxy_tcl()
00025 {
00026   tcl_interp_ = NULL;
00027 }
00028 
00029 
00030 colvarproxy_tcl::~colvarproxy_tcl()
00031 {
00032 }
00033 
00034 
00035 void colvarproxy_tcl::init_tcl_pointers()
00036 {
00037   // This is overloaded by NAMD and VMD proxies to use the local interpreters
00038 #if defined(COLVARS_TCL)
00039   if (tcl_interp_ == NULL) {
00040     // Allocate a dedicated Tcl interpreter for Colvars
00041     std::cout << "colvars: Allocating Tcl interpreter." << std::endl;
00042     set_tcl_interp(Tcl_CreateInterp());
00043   } else {
00044     std::cerr << "Error: init_tcl_pointers called with non-NULL tcl_interp_" << std::endl;
00045   }
00046 #else
00047   std::cerr << "Error: Tcl support is not available in this build." << std::endl;
00048 #endif
00049 }
00050 
00051 
00052 char const *colvarproxy_tcl::tcl_get_str(void *obj)
00053 {
00054 #if defined(COLVARS_TCL)
00055   return Tcl_GetString(reinterpret_cast<Tcl_Obj *>(obj));
00056 #else
00057   (void) obj;
00058   return NULL;
00059 #endif
00060 }
00061 
00062 
00063 int colvarproxy_tcl::tcl_run_script(std::string const &script)
00064 {
00065 #if defined(COLVARS_TCL)
00066   Tcl_Interp *const interp = get_tcl_interp();
00067   int err = Tcl_Eval(interp, script.c_str());
00068   if (err != TCL_OK) {
00069     cvm::log("Error while executing Tcl script:\n");
00070     cvm::error(Tcl_GetStringResult(interp));
00071     return COLVARS_ERROR;
00072   }
00073   return cvm::get_error();
00074 #else
00075   return COLVARS_NOT_IMPLEMENTED;
00076 #endif
00077 }
00078 
00079 
00080 int colvarproxy_tcl::tcl_run_file(std::string const &fileName)
00081 {
00082 #if defined(COLVARS_TCL)
00083   Tcl_Interp *const interp = get_tcl_interp();
00084   int err = Tcl_EvalFile(interp, fileName.c_str());
00085   if (err != TCL_OK) {
00086     cvm::log("Error while executing Tcl script file" + fileName + ":\n");
00087     cvm::error(Tcl_GetStringResult(interp));
00088     return COLVARS_ERROR;
00089   }
00090   return cvm::get_error();
00091 #else
00092   return COLVARS_NOT_IMPLEMENTED;
00093 #endif
00094 }
00095 
00096 
00097 int colvarproxy_tcl::tcl_run_force_callback()
00098 {
00099 #if defined(COLVARS_TCL)
00100   Tcl_Interp *const interp = get_tcl_interp();
00101   if (Tcl_FindCommand(interp, "calc_colvar_forces", NULL, 0) == NULL) {
00102     cvm::error("Error: Colvars force procedure calc_colvar_forces is not defined.\n");
00103     return COLVARS_ERROR;
00104   }
00105 
00106   std::string cmd = std::string("calc_colvar_forces ")
00107     + cvm::to_str(cvm::step_absolute());
00108   int err = Tcl_Eval(interp, cmd.c_str());
00109   if (err != TCL_OK) {
00110     cvm::log("Error while executing calc_colvar_forces:\n");
00111     cvm::error(Tcl_GetStringResult(interp));
00112     return COLVARS_ERROR;
00113   }
00114   return cvm::get_error();
00115 #else
00116   return COLVARS_NOT_IMPLEMENTED;
00117 #endif
00118 }
00119 
00120 
00121 int colvarproxy_tcl::tcl_run_colvar_callback(
00122                          std::string const &name,
00123                          std::vector<const colvarvalue *> const &cvc_values,
00124                          colvarvalue &value)
00125 {
00126 #if defined(COLVARS_TCL)
00127 
00128   Tcl_Interp *const interp = get_tcl_interp();
00129   size_t i;
00130 
00131   std::string cmd = std::string("calc_") + name;
00132   if (Tcl_FindCommand(interp, cmd.c_str(), NULL, 0) == NULL) {
00133     cvm::error("Error: scripted colvar procedure \"" + cmd + "\" is not defined.\n");
00134     return COLVARS_ERROR;
00135   }
00136 
00137   for (i = 0; i < cvc_values.size(); i++) {
00138     cmd += std::string(" {") + (*(cvc_values[i])).to_simple_string() +
00139       std::string("}");
00140   }
00141   int err = Tcl_Eval(interp, cmd.c_str());
00142   const char *result = Tcl_GetStringResult(interp);
00143   if (err != TCL_OK) {
00144     return cvm::error(std::string("Error while executing ")
00145                       + cmd + std::string(":\n") +
00146                       std::string(Tcl_GetStringResult(interp)),
00147                       COLVARS_ERROR);
00148   }
00149   std::istringstream is(result);
00150   if (value.from_simple_string(is.str()) != COLVARS_OK) {
00151     cvm::log("Error parsing colvar value from script:");
00152     cvm::error(result);
00153     return COLVARS_ERROR;
00154   }
00155   return cvm::get_error();
00156 
00157 #else
00158 
00159   (void) name;
00160   (void) cvc_values;
00161   (void) value;
00162   return COLVARS_NOT_IMPLEMENTED;
00163 
00164 #endif
00165 }
00166 
00167 
00168 int colvarproxy_tcl::tcl_run_colvar_gradient_callback(
00169                          std::string const &name,
00170                          std::vector<const colvarvalue *> const &cvc_values,
00171                          std::vector<cvm::matrix2d<cvm::real> > &gradient)
00172 {
00173 #if defined(COLVARS_TCL)
00174 
00175   Tcl_Interp *const interp = get_tcl_interp();
00176   size_t i;
00177 
00178   std::string cmd = std::string("calc_") + name + "_gradient";
00179   if (Tcl_FindCommand(interp, cmd.c_str(), NULL, 0) == NULL) {
00180     cvm::error("Error: scripted colvar gradient procedure \"" + cmd + "\" is not defined.\n");
00181     return COLVARS_ERROR;
00182   }
00183 
00184   for (i = 0; i < cvc_values.size(); i++) {
00185     cmd += std::string(" {") + (*(cvc_values[i])).to_simple_string() +
00186       std::string("}");
00187   }
00188   int err = Tcl_Eval(interp, cmd.c_str());
00189   if (err != TCL_OK) {
00190     return cvm::error(std::string("Error while executing ")
00191                       + cmd + std::string(":\n") +
00192                       std::string(Tcl_GetStringResult(interp)),
00193                       COLVARS_ERROR);
00194   }
00195   Tcl_Obj **list;
00196   int n;
00197   Tcl_ListObjGetElements(interp, Tcl_GetObjResult(interp),
00198                          &n, &list);
00199   if (n != int(gradient.size())) {
00200     cvm::error("Error parsing list of gradient values from script: found "
00201                + cvm::to_str(n) + " values instead of " +
00202                cvm::to_str(gradient.size()));
00203     return COLVARS_ERROR;
00204   }
00205   for (i = 0; i < gradient.size(); i++) {
00206     std::istringstream is(Tcl_GetString(list[i]));
00207     if (gradient[i].from_simple_string(is.str()) != COLVARS_OK) {
00208       cvm::log("Gradient matrix size: " + cvm::to_str(gradient[i].size()));
00209       cvm::log("Gradient string: " + cvm::to_str(Tcl_GetString(list[i])));
00210       cvm::error("Error parsing gradient value from script", COLVARS_ERROR);
00211       return COLVARS_ERROR;
00212     }
00213   }
00214 
00215   return cvm::get_error();
00216 
00217 #else
00218 
00219   (void) name;
00220   (void) cvc_values;
00221   (void) gradient;
00222   return COLVARS_NOT_IMPLEMENTED;
00223 
00224 #endif
00225 }

Generated on Thu Mar 28 02:42:56 2024 for VMD (current) by doxygen1.2.14 written by Dimitri van Heesch, © 1997-2002