University of California, Berkeley
EECS Dept, CS Division
Jordan Smith SLIDE: Scene Language for
Interactive Dynamic Environments
Prof. Carlo H. Séquin

Home Goals Publications People Gallery Assignments Distributions

SLIDE Reference SLIDE Spec Tcl Notes

Tcl Notes

Introduction

These notes show some constructs and data structures which are very useful for programing in Tcl. They also show some common pitfalls when programming with these constructs. This page is not intended to be a complete Tcl tutorial. For more information visit the Tcl/Tk Man Pages or read the first 9 chapters of "Tcl and the Tk Toolkit" by John K. Ousterhout. The Ousterhout book is a very quick read, and it is the best way to get a real understanding of why Tcl acts the way it does. Another good way of learning Tcl is to interactively write commands into the wish program or into the command prompt of the slide rendering program.

Command Delimiters

Tcl is line interpreter, so the "\n" at the end of a line is the normal command delimiter. You can put multiple commands on the same line if you place a ";" in between them. You can have commands which span multiple lines two different ways. First, you can open a "{" block and not terminate it before the "\n". Second, you can escape the "\n" by placing a "\" as the last character on a line. The Tcl interpreter will then consider the next line as a continuation of the current line.

set a 1
set b 2; set c 3
if { $a == 1 } {
  puts "a == $a"
}
if { $a == 1 } \
{ puts "a == $a" }

# This last one is an errror
if { $a == 1 }
{ puts "a == $a" }

Comments

The # as the first character of a command will comment it out.

# This is a valid comment
set a 0; # This is a valid comment
set a 0 # This is invalid because it looks like extra arguments to set

Control Flow

With all control flow constructs, it is important to open the { on the same line, so that Tcl knows that the command is not complete when in encounters the }.

if

if { $a == 1 } {
  puts "Monday"
} elseif { $a == 2 } {
  puts "Tuesday"  
} elseif { $a == 3 } {
  puts "Wednesday"
} else {
  puts "Thursday"
}  

switch

switch $a {
  mon -
  1 {
    puts "Monday"
  }
  tues -
  2 {
    puts "Tuesday"
  }
  wed -
  3 {
    puts "Wednesday"
  }
  default {
    puts "Unknown day"
  }
}

while

set i 0
while { $i < 8 } {
  puts "$i"
  incr i
}

for

for { set i 0 } { $i < 8 } { incr i } {
  puts "$i"
}

Subexpression Evaluation

[ ] will evaluate a command in place and become the returned value of that command.

% expr 5*sin(90)
5
% set a [expr 5*sin(90)]
5
% puts "a = $a"
a = 5

expr is one very useful command to use in this way. Another useful command is subst which will substitute all $ and [] expressions.

% set name Jordan
Jordan
% puts "g$name0"
ERROR: unknown variable "name0"
% puts "g[subst $name]0"
gJordan0

Lists

The list data structure is used by SLIDE's Tcl interface to the SLIDE parser. The slide instance command can take a list of transforms where each transform is a list of parameters:

slide instance -xforms { {translate 1 0 0} {scale 1 2 1} }

An equivalent way of writing this in Tcl is the following:

slide instance -xforms [list [list translate 1 0 0] [list scale 1 2 1] ]

The difference between { } and [list ] is when the terms within them get evaluated. The following example illustrates the difference:

% set a 1
1
% set b 2
2
% set c 3
3
% # Using { } to make a list means that none of the terms are evaluated
% set v { $a $b $c [expr $a + $b + $c] }
$a $b $c [expr $a + $b + $c]
% # Using [list ] to make a list will evaluate all terms
% set w [list $a $b $c [expr $a + $b + $c] ]
1 2 3 6

Associative Arrays

An associative array is a useful data structure for simulating C style arrays, two dimensional arrays, structures, and classes. An associative array is really a hashtable where the hash keys are abitrary strings. One convenient property of associative arrays is that you can get access to all of its fields by declaring that just the base name is available within a scope.

# Used as a one dimensional array
for { set i 0 } { $i < 8 } { incr i } {
  set base($i) $i
  puts "base($i) = $base($i)"
}

# Used as a two dimensional array
# NOTE: "$i,$j" is a single string which is the index like "0,1"
for { set i 0 } { $i < 8 } { incr i } {
  for { set j 0 } { $j < 8 } { incr j } {
    set base($i,$j) $i
    puts "base($i,$j) = $base($i,$j)"
  }
}

Procedures

Tcl procedures can be created using the proc command. These are useful for creating call back functions for different widgets.


################################################## 
# SetField
#   A procedure to set a field of an associative array to a value 
#     this  - the name of a global associative array 
#     field - an index into the associative array
#     value - the new value to set the field to, default value is 0
proc SetField { this field {value 0} } {
  # The array is defined in the global name space so we must
  # tell Tcl to look for it there.  Otherwise it will be treated as
  # a temporary local variable
  global $this

  set ${this}($field) $value
  # use subst to dereference the value of the field
  puts "${this}($field) = [subst $${this}($field)]"
  return [subst $${this}($field)]
}

set arr(a) 3

# Invoking the function
SetField arr a 5

# Invoking the function as a subexpression
set b [SetField arr a 4]

# NOTE: the name of a widget must start with a lower case letter
scale .sA -from 0 -to 10 -variable arr(a) -command "SetField arr a"

pack .sA

Interfacing C++ and Tcl

Tcl has mechanisms for interfacing with C code, but their support for C++ objects is not as nice. I have developed a C++ class which makes it easier to create C++ classes which can be accessed from Tcl. I modeled the Tcl interface after [Incr Tcl]. [Incr Tcl] is an object oriented extension to Tcl which makes it possible to program Tcl in an object oriented way, but does not extend the Tcl interface to C to include C++.

My Tcl to C++ interface is called ItclCxx because it gives an [Incr Tcl] look and feel to C++ objects. To use this interface, you create a C++ class which is subclassed from ItclCxx. You must implement 3 static functions on the class which define the interface to Tcl. Then it is possible to create, manipulate, and delete C++ objects from Tcl.

A Bezier class example

// bezier.h

#include "itclobject.h"

//////////////////////////////////////////////////////////////////////
// Bezier

class Bezier : public ItclObject
{
public:
  Bezier();
  virtual ~Bezier();
  void Init();
  void Uninit();

public:
  void SetControlPoints(float **ppf);
  void FrenetAt(float ppf[4][4], float fT);
  // There is some difficulty returning arrays so we convert the result
  // to a string and return that.
  char *FrenetTcl();
  virtual void Display();

public:
  float GetT() {return m_fT;};
  void SetT(float fT) {m_fT = fT;};

//////////////////////////////////////////////////
// Class Methods
//
public:
  static int ItclInit(Tcl_Interp *pInterp);

  static ItclObject *Allocate();
  static void Deallocate(ItclObject *pObject);

//////////////////////////////////////////////////
// Class Variables
//
protected:
  static ItclClassEntry *m_pItclClassEntry;

//////////////////////////////////////////////////
// Object Variables
//
protected:
  float m_fT;
  float m_ppfControl[4][4];
};

In the source file below we only show the functions which are special to the ItclCxx interface.

#include "bezier.h"

ItclClassEntry *Bezier::m_pItclClassEntry = NULL;

//////////////////////////////////////////////////
// START: Bezier class implementation (DELETED)
//

...

//
// END  : Bezier class implementation (DELETED)
//////////////////////////////////////////////////

int Bezier::ItclInit(Tcl_Interp *pInterp)
{
  ASSERT( pInterp != NULL );

  if ( m_pItclClassEntry != NULL )
    {
      sprintf(s_pcBuffer, "ERROR: class \"Bezier\" : attempt to reinitialize");
      Tcl_SetResult(pInterp, s_pcBuffer, TCL_VOLATILE);
      return TCL_ERROR;
    }
  
  //////////////////////////////////////////////////
  // Create a class entry
  m_pItclClassEntry = new ItclClassEntry;
  ASSERT( m_pItclClassEntry != NULL );
  m_pItclClassEntry->Init(pInterp, 
			  ItclNameSpace::GetGlobal(),
			  ItclObject::m_pItclClassEntry, 
			  "Bezier", 
			  Bezier::Allocate, 
			  Bezier::Deallocate);

  //////////////////////////////////////////////////
  // Create the method entries

  Itcl_Method ufpMethod;

  ufpMethod.v__ppf = (Itcl_Method_v__ppf)(&Bezier::SetControlPoints);
  m_pItclClassEntry->CreateMethodEntry("SetControlPoints", &ufpMethod, itrt_v, itpt_ppf,
				       "{ {x y z w} {x y z w} {x y z w} {x y z w} {x y z w}}");

  ufpMethod.pc__v = (Itcl_Method_pc__v)(&Bezier::FrenetTcl);
  m_pItclClassEntry->CreateMethodEntry("Frenet", &ufpMethod, itrt_pc, itpt_v,
				       "");

  ufpMethod.v__v = (Itcl_Method_v__v)(&Bezier::Display);
  m_pItclClassEntry->CreateMethodEntry("Display", &ufpMethod, itrt_v, itpt_v,
				       "{}");

  //////////////////////////////////////////////////
  // Create the field entries

  Itcl_Method ufpMethodGet;
  Itcl_Method ufpMethodSet;

  ufpMethodGet.f__v = (Itcl_Method_f__v)(&Bezier::GetT);
  ufpMethodSet.v__f = (Itcl_Method_v__f)(&Bezier::SetT);
  m_pItclClassEntry->CreateFieldEntry("t", 
				      &ufpMethodGet, itrt_f, itpt_v,
				      &ufpMethodSet, itrt_v, itpt_f);

  return TCL_OK;
}

ItclObject *Bezier::Allocate()
{
  Bezier *pObject;

  pObject = new Bezier;
  pObject->Init();

  return pObject;
}

void Bezier::Deallocate(ItclObject *pObject)
{
  ASSERT( pObject != NULL );

  delete pObject;
}

// There is some difficulty returning arrays so we convert the result
// to a string and return that.
char *Bezier::FrenetTcl()
{
  static float s_ppfFrenet[4][4];

  FrenetAt(s_ppfFrenet, m_fT);

  sprintf(s_pcBuffer, "{%f %f %f %f} {%f %f %f %f} {%f %f %f %f} {%f %f %f %f}", 
	  s_ppfFrenet[0][0], s_ppfFrenet[0][1], s_ppfFrenet[0][2], s_ppfFrenet[0][3], 
	  s_ppfFrenet[1][0], s_ppfFrenet[1][1], s_ppfFrenet[1][2], s_ppfFrenet[1][3], 
	  s_ppfFrenet[2][0], s_ppfFrenet[2][1], s_ppfFrenet[2][2], s_ppfFrenet[2][3], 
	  s_ppfFrenet[3][0], s_ppfFrenet[3][1], s_ppfFrenet[3][2], s_ppfFrenet[3][3]);

  return s_pcBuffer;
}

A testing session in Tcl

# Update the search path
% lappend auto_path ~/project/slide/lib
~/project/slide/lib

# Load the dynamic library
% package require curvelib
1.0

# Create a C++ Bezier object
% set bez [Bezier]
Bezier0

# View the fields
% $bez configure 
{-Bspline::t  0.000000}

# Set a field value
% $bez configure -t 0.5

# Get a field value
% $bez cget -t 0.5
0.500000

# Is the object of the class Bezier?
% $bez isa Bezier
1

# Is the object of the class Wavelet?
% $bez isa Wavelet 
0

# View info about the object
% $bez info
wrong # args: should be one of...
  info args procname
  info body procname
  info class
  info function ?name? ?-protection? ?-type? ?-name? ?-args? ?-body?
  info heritage
  info inherit
  info variable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config?

# View info about the object's methods
% $bez info function 
::Bezier::Frenet ::Bezier::Display ::Bezier::SetControlPoints 
::ItclObject::Display ::ItclObject::info ::ItclObject::isa
::ItclObject::configure ::ItclObject::cget 

% set ppfBezier { {0.0 0.0 0.0 1.0}
                  {0.0 1.0 0.0 1.0}
                  {1.0 1.0 0.0 1.0}
                  {1.0 0.0 0.0 1.0} }

% $bez SetControlPoints $ppfBezier

# Calculate the Frenet frame information for the current T value
% set ppfFrenet [$bez Frenet]
{ {0.500000 0.750000 0.000000 1.000000}     # Position
  {1.000000 0.000000 0.000000 0.000000}     # Tangent Vector
  {0.000000 -1.000000 0.000000 0.000000}    # Normal Vector
  {0.000000 0.000000 -1.000000 0.000000} }  # Binormal Vector

# Use the ItclCxx built-in function scopecxx to bind field variables
# to widgets
% scopecxx $bez t
@Bezier0 @Bezier@t

% proc PrintField { obj field value } {
    puts "$obj $field = [$obj cget -$field] ?= $value"
}

% toplevel .bez
.bez

% scale .bez.sT \
	-label T \
	-from 0.0 \
	-to 1.0 \
	-resolution 0.01 \
	-orient horizontal \
	-length 300 \
	-variable [scopecxx $bez t] \
	-command "PrintField $bez t"
.bez.sT

% pack .bez.sT

# scopecxx can also be used to set fields directly
% set "[scopecxx $bez t]" 0.25
0.25

% $bez cget -t
0.250000

% set ppfFrenet [$bez Frenet]  
{ {0.843750 0.562500 0.000000 1.000000} 
  {0.600000 -0.800000 0.000000 0.000000} 
  {-0.800000 -0.600000 0.000000 0.000000} 
  {0.000000 0.000000 -1.000000 0.000000} }

# Use the ItclCxx built-in function deletecxx to delete C++ objects
% deletecxx object $bez

# The object no longer exists
% $bez configure
invalid command name "Bezier0"




This page was originally built by Jordan Smith.

Last modified: Sunday, 24-Nov-2002 23:15:05 PST