[vtkusers] Mixing C++ and Tcl/Tk Code in vtk application

[John Biddiscombe]

Daniel,

In order to access your C++ created objects from tcl and your tcl created
objects from C++, you're going to need to look carefully at the code in
vtkTclUtil.cxx. Each time an object is created, you need to create an
equivalent command in tcl to access it.
If you look carefully at the vtkTclUtil code you should be able to see what
you need to do.

Here's a piece of code that I use...it accepts a vtkObject pointer and
creates a tcl representation of it which can be queried by a tcl script
running in the same program. This only covers creating the object. If you
delete it from inside a script, or from C++, the copmmmand representing it
needs to be deleted. This code is overkill but simulates an object created
by a user in tcl - so it's fully interchangeable

The following code assumes you are using the standard vtk tcl
wrapping...(and that all the relevant vtkCommonInit, GraphicsInit,
FilteringInit....etc have been initialized....)

//--------------------------------------------------------------------------
-
int __fastcall TBvtkParam_TclWindow::InsertTclNewInstance(vtkObject *obj,
Tcl_Interp *interp, char *name) {
  //
  // first get the command info for the object we're representing
  //
  Tcl_CmdInfo CommandData, cinf;
  if (Tcl_GetCommandInfo(Interp, const_cast<char *>(obj->GetClassName()),
&CommandData)!=1) {
      throw("Internal problem creating Tcl vtkObject lookup");
  }
  // We need the CreateNewInstanceCommand from it (for the Object type)
  vtkTclCommandStruct *cs = (vtkTclCommandStruct*)CommandData.clientData;
  int (*TheInstanceNewCommand)(ClientData, Tcl_Interp *,int, char *[]) =
cs->CommandFunction;
  //
  // Do some checks to make sure we're not treading on anything
  //
  vtkTclInterpStruct *is = vtkGetInterpStruct(interp);
  // Make sure we are not duplicating a name
  if (Tcl_FindHashEntry(&is->InstanceLookup,name)) {
    throw Exception("Named Object Exists already");
  }
  // Make sure we are not clobbering a built in command
  if (Tcl_GetCommandInfo(interp,name,&cinf)) {
    throw Exception("A tcl/tk command with that name already exists.");
  }
  //
  // Setup the internal Tcl Hash tables (!)
  // 3 Hash tables : 1) Maps names of objects to actual raw pointers to
objects
  //                 1) Maps a string of the pointer to a string of the name
  //                 1) Maps names of objects to their command structures
(fn ptrs)
  //
  Tcl_HashEntry *entry;
  int is_new;
  // Create a hash entry : key=name, data=object
  entry = Tcl_CreateHashEntry(&is->InstanceLookup, name, &is_new);
  Tcl_SetHashValue(entry,(ClientData)obj);
  // Create a hash entry : key=pointerstring, data=name
  char temps[256];
  sprintf(temps,"%p",(void *)obj);
  entry = Tcl_CreateHashEntry(&is->PointerLookup, temps, &is_new);
  Tcl_SetHashValue(entry,(ClientData)(strdup(name)));
  // Create a hash entry : key=name, data=command function
  entry = Tcl_CreateHashEntry(&is->CommandLookup,name,&is_new);
  Tcl_SetHashValue(entry,(ClientData)(cs->CommandFunction));
  //
  // Create a new command to represent the (named) object
  //
  vtkTclCommandArgStruct *as = new vtkTclCommandArgStruct;
  as->Pointer = (void *)obj;
  as->Interp = interp;
  Tcl_CreateCommand(interp, name, TheInstanceNewCommand, (ClientData)as,
(Tcl_CmdDeleteProc *)vtkTclGenericDeleteObject);
  //
  // setup the delete callback
  //
  vtkCallbackCommand *cbc = vtkCallbackCommand::New();
  cbc->SetCallback(vtkTclDeleteObjectFromHash);
  cbc->SetClientData((void *)as);
  as->Tag = obj->AddObserver(vtkCommand::DeleteEvent, cbc);
  cbc->Delete();
  //
  return 1;
}
//--------------------------------------------------------------------------
-

You will almost certainly want to change the delete object callback to
ensure that if the user deletes your object you can be alerted. The above
code uses the default vtk callback which I've not changed here...

JB

vtk Based Contracts wanted...