source leddemo.tcl set myvar 0x55 Canvas_UpdateAll ledCanvas
|
set myvar 0xf0 Canvas_UpdateAll ledCanvas
|
set myvar 0x33 Canvas_UpdateAll ledCanvas
|
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
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# 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
code...
}; # Led_New
proc Led_Update { {LedName} } \
{
variable $LedName
code...
}; # 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 \
Led_Update
} # 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 \
::LedObject::Led_Update
|
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. |
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. |
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_UpdateAll
} # Canvas namespace
namespace import \
::Canvas::Canvas_New \
::Canvas::Canvas_GetFgColor \
::Canvas::Canvas_GetBgColor \
::Canvas::Canvas_IncludeObject \
::Canvas::Canvas_UpdateAll
|
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.