Lesson: Objects in TCL


For the purpose of this lesson, objects refer to collections of procedures and data that are encapsulated together. Depending on the function of the object, it may be designed to monitor some external state or it may control some external state. But controlling of its internal state is done thru procedure calls rather than by directly manipulating its internal data.

Where this code contributes to that capability is in showing how an object can have static state without storing lots of variables in the global namespace.

All code shown in this tutorial is covered by the GPL shown below.
 # Copyright (C) 2003  Allen Brown
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License version 2 as
 # published by the Free Software Foundation.
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # GNU General Public License for more details.
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the
 #   Free Software Foundation, Inc.
 #   59 Temple Place, Suite 330
 #   Boston, MA  02111-1307  USA


The key to encapsulation is namespaces. Both procedures and variables may be stored in named namspaces. If the namespace is named after the object, collisions with user variables (which will usually be in global namespace) will be almost entirely avoided. Notice that this allows us to create procedures which are used by our objects, but which are not visible to the user.

namespace eval LedObject \
{ # LedObject namespace

We encapsulate our procedure definitions inside the namespace.

  # Led_New defines a new LED object.
  proc Led_New { {LedName} paramlist... } \
    variable $LedName

  }; # Led_New

  proc Led_Update { {LedName} } \
    variable $LedName

  }; # Led_Update

Here are two procedure definitions. In each case, the first parameter to the procedure is the object name. That name is used as the variable in our LedObject namespace. Thus it must be unique, but only unique to this namespace. The user can reuse the object name as a local variable in his own namespace.

The first thing we do in the procedure is to make a variable declaration of our object name. That promotes the variable to the static part of the LedObject namespace. Without that it would be within the procedure's local namespace, and would be dynamic.

The $LedName variable is technically still accessible by the user. But the name is somewhat obscure. For instance, if the user called Led_New L1, the name for the variable we declare is globally accessible as ::LedObject::L1. But we trust that the user is unlikely to reference that variable.

  namespace export \
        Led_New \
} # LedObject namespace

Now export those procedures which we want visible outside the namespace. The result is that our object's procedures all see each other and see their special variable space. But users don't see any of this except for the parts which we export.

namespace import \
    ::LedObject::Led_New \

Now if the code which uses this object sources this file, they get the objects, with the imported names visible as tho they were defined locally.

Using our object variable efficiently

Generally our objects are likely to need to store a collection of values, not just one. How can we do that without cluttering up our namespace and increasing the risk of name collisions?

There are at least two ways to address this. One way would be to create a child namespace for each object instance within its class object namespace. For instance, instead of using the variable declaration above, we could have nested a new namespace with that name. I have not taken that approach and will leave it to others to explore that possibility.

The approach I took was to treat each object variable as an array, and store several variables that way. The syntax for accessing variables indirectly (where the variable name itself is stored in a variable) is rather obscure. To make this easier to use, I therefore shoved that ugliness into procedures.

 # -----------------------------------------------------------------
 # GetSymArray and PutSymArray are used to store and retrieve
 # values into a global array, whose name is passed in a variable.
proc GetSymArray { {arrayname} {destination} {index} } \
  uplevel eval set $destination [join [list {$} $arrayname ($index)] {}]
  return 0
}; # GetSymArray

proc PutSymArray { {arrayname} {value} {index} } \
  upvar $arrayname locarray
  set locarray($index) [list $value]
}; # PutSymArray

There may be other ways to do this. I have explored several. But all were ugly. The form shown here was no worse than any other.

Now lets revisit our object procedures.

  proc Led_New { {LedName} {NameOnCanv} {expression} \
                     {X} {Y} {Xs} {Ys} {ColorOn} {ColorOff} } \
    # LedName = Unique name for the LED.  Also the label on the LED.
    # NameOnCanv = 
    # expression = The expression being monitored,
    #           generally using fully qualified (::thisvar) names.
    # X and Y = Location on the window.
    # Xs and Ys = Size of LED.
    # ColorOn and ColorOff = Color of LED when expression!=0 or ==0.
    variable $LedName

Nothing really new here.

    PutSymArray $LedName $NameOnCanv NameOnCanv
    PutSymArray $LedName $expression expression
    PutSymArray $LedName $ColorOn ColorOn
    PutSymArray $LedName $ColorOff ColorOff

All of the information that will be needed by Led_Update get stuffed into $LedName. The last parameter is the associative array index value. We will see those names show up again when we access that info.

    button $NameOnCanv -padx $Xs -pady $Ys -borderwidth 3 -text $LedName
    place $NameOnCanv -x $X -y $Y
    return $LedName
  }; # Led_New

Now I create a graphic object. This is the object that will be maintained by Led_Update.

  # Given an LEDarray, the corresponding object is updated, depending
  # on the value returned from the expression.
  proc Led_Update { {LedName} } \
    variable $LedName

Nothing new here.

    GetSymArray $LedName NameOnCanv NameOnCanv
    GetSymArray $LedName expression expression

Here we are getting that info back from our object class's static namespace and storing it into our local variables for easy access.

    set Bitvalue [eval expr $expression]
    if {$Bitvalue} then \
      GetSymArray $LedName Color ColorOn
    } else {
      GetSymArray $LedName Color ColorOff
    $NameOnCanv configure -background $Color -activebackground $Color
  }; # Led_Update

This isn't specifically object code. But it makes the LED behave like, well, an LED.

Show it working..

OK. But first I want to define another object. Not that it is truly neccessary. But it makes the LEDs much more pleasant to play with.

namespace eval Canvas \
{ # Canvas namespace

  # Canvas_new returns an array (Canvasarray below) defining a new canvas object.
    proc Canvas_New { {CanvasObject} {X} {Y} {Xs} {Ys} {canvcolor} 
		      {textcolor} {title} } \
    # CanvasObject = Unique name for the canvas object.
    # X and Y = Location on the window.
    # Xs and Ys = Size of canvas.
    # title for the canvas
    variable $CanvasObject

    set Canvasname .$CanvasObject
    canvas $Canvasname -borderwidth 3 -width $Xs -height $Ys \
	-background $canvcolor
    place $Canvasname -x $X -y $Y
    label ${Canvasname}.title -borderwidth 3 -text $title \
	-foreground $textcolor -background $canvcolor
    place ${Canvasname}.title -x 5 -y 2
    PutSymArray $CanvasObject $Canvasname canvasname
    PutSymArray $CanvasObject $X X
    PutSymArray $CanvasObject $Y Y
    PutSymArray $CanvasObject $Xs Xs
    PutSymArray $CanvasObject $Ys Ys
    PutSymArray $CanvasObject $canvcolor canvcolor
    PutSymArray $CanvasObject $textcolor textcolor
    PutSymArray $CanvasObject {} objectlist
    return $Canvasname
  }; # Canvas_New

  # Return the foreground color for the Canvas object.
    proc Canvas_GetFgColor { {CanvasObject} } \
    # CanvasObject = Name for this canvas object.
    variable $CanvasObject

    GetSymArray $CanvasObject textcolor textcolor
    return $textcolor
  }; # Canvas_GetFgColor

  # Return the background color for the Canvas object.
    proc Canvas_GetBgColor { {CanvasObject} } \
    # CanvasObject = Name for this canvas object.
    variable $CanvasObject

    GetSymArray $CanvasObject canvcolor canvcolor
    return $canvcolor
  }; # Canvas_GetBgColor

  # Register the object in the Canvas objectlist.
  # Return the canvasname.
    proc Canvas_IncludeObject { {CanvasObject} {objecthandler} {objectname} } \
    # CanvasObject = Name for this canvas object.
    # objecthandler = Method for updating $objectname.
    # objectname = name of object to update.
    variable $CanvasObject

    GetSymArray $CanvasObject canvasname canvasname
    GetSymArray $CanvasObject objectlist objectlist
    lappend objectlist [list $objecthandler $objectname]
    PutSymArray $CanvasObject $objectlist objectlist
    return $canvasname.$objectname
  }; # Canvas_IncludeObject

  # Update all objects that have been registered for CanvasObject.
  proc Canvas_UpdateAll { {CanvasObject} } \
    # CanvasObject = Name for this canvas object.
    variable $CanvasObject

    GetSymArray $CanvasObject objectlist objectlist
    foreach objectpair $objectlist \
      eval $objectpair
  }; # Canvas_UpdateAll

  namespace export \
	Canvas_New \
	Canvas_GetFgColor \
	Canvas_GetBgColor \
	Canvas_IncludeObject \
} # Canvas namespace

namespace import \
    ::Canvas::Canvas_New \
    ::Canvas::Canvas_GetFgColor \
    ::Canvas::Canvas_GetBgColor \
    ::Canvas::Canvas_IncludeObject \


I will use this object class to manage the group of LEDs I lay down.

Now lets build the top level. Store the following into the file leddemo.tcl.

source {simfuncs.tcl}
source {LedObject.tcl}
source {CanvasObject.tcl}

simfuncs.tcl contains the GetSymArray and PutSymArray defns. LedObject.tcl contains the LED object defn. CanvasObject.tcl contains the Canvas object defn.

  set canvasname [Canvas_New ledCanvas 0 0 \
      80 250  {#7f6f7f} {#000000}  {Led Monitor}]
 # Led_New {LedName} {NameOnCanv} {expression} {X} {Y} {Xs} {Ys} {ColorOn} {ColorOff}
  set labelname [Canvas_IncludeObject ledCanvas Led_Update red3Led]
  Led_New red3Led   $labelname {$::myvar & 0x80} 0  20 7 3 "#ff0000" "#600000"
  set labelname [Canvas_IncludeObject ledCanvas Led_Update red2Led]
  Led_New red2Led   $labelname {$::myvar & 0x40} 0  50 7 3 "#ff0000" "#600000"
  set labelname [Canvas_IncludeObject ledCanvas Led_Update red1Led]
  Led_New red1Led   $labelname {$::myvar & 0x20} 0  80 7 3 "#ff0000" "#600000"
  set labelname [Canvas_IncludeObject ledCanvas Led_Update red0Led]
  Led_New red0Led   $labelname {$::myvar & 0x10} 0 110 7 3 "#ff0000" "#600000"
  set labelname [Canvas_IncludeObject ledCanvas Led_Update green3Led]
  Led_New green3Led $labelname {$::myvar & 0x08} 0 140 7 3 "#00ff00" "#006000"
  set labelname [Canvas_IncludeObject ledCanvas Led_Update green2Led]
  Led_New green2Led $labelname {$::myvar & 0x04} 0 170 7 3 "#00ff00" "#006000"
  set labelname [Canvas_IncludeObject ledCanvas Led_Update green1Led]
  Led_New green1Led $labelname {$::myvar & 0x02} 0 200 7 3 "#00ff00" "#006000"
  set labelname [Canvas_IncludeObject ledCanvas Led_Update green0Led]
  Led_New green0Led $labelname {$::myvar & 0x01} 0 230 7 3 "#00ff00" "#006000"

Declare a byte's worth of LEDs. Each is assigned one of the bits of myvar via it's expression. Myvar is passed in using ::myvar syntax to make it always global when it is accessed.

Now run wish and type the following:

source leddemo.tcl
set myvar 0x55
Canvas_UpdateAll ledCanvas

set myvar 0xf0
Canvas_UpdateAll ledCanvas

set myvar 0x33
Canvas_UpdateAll ledCanvas

Notice that we didn't explicitly update the LEDs. Instead each LED updated itself based on the instructions we gave when declaring that LED. And the updating was all managed by Canvas_UpdateAll.

Last modified 10 Dec 2006