SDynObject is short for Simple Dynamic Object system.
The latest SDynObject is available (with demos) from: http://www.xmission.com/~georgeps/SDynObject/
Note: Some widgets are incomplete due to lack of interest.
License: Tcl style
Author: George Peter Staplin
Getting Started
SDynObject is a dynamic object-oriented (OO) system. It features multiple inheritance, fast execution, and simplicity.
Most OO systems have a class command. In SDynObject we don't need such a thing, because proc provides all that we need. For example:
proc Bat obj {
sd.new.method hit.ball for $obj takes ball {
#at this point we have ball passed to us.
}
return $obj
}Note: It isn't necessary to use . in the name of a method. I like using . rather than _ or : because it takes only one keystroke instead of two.
How would we use the class given above you may ask? Well, it's really quite easy. First we need to create an object and then we pass the object to the Bat proc so that it inherits hit.ball. For example:
set b [Bat [sd.new.object]] $b->hit.ball someball
The $b->hit.ball command is just a normal Tcl procedure.
If you wanted to create a method that takes any arguments you can use the standard args string for the takes argument.
Instance Variables
How do we deal with instance variables in SDynObject? This is best illustrated with an example.
proc Bat obj {
$obj v foo
...
}In the example above we have just set the variable v and it will be held within our object.
How do we reference the given variable:
proc Bat obj {
$obj v foo
puts [$obj v]
return $obj
}In the example above puts [$obj v] will print foo.
The Current Object
How do we access the object that refers to the method we are in?
proc Bat obj {
sd.new.method hit.ball for $obj takes ball {
$self v $ball
}
return $obj
}In the example above $self is like the $obj. It's the same token value. $self connects all methods to a single object. You can use $self to call methods within an object too, as in $self->some.method.
Methods that Create Methods
Now how do we create a method within a method?
proc Bat obj {
sd.new.method create.anew for $obj takes name {
sd.new.method $name for $self takes args {
puts "$self $args"
}
}
return $obj
}Multiple Inheritance
How is multiple-inheritance done in SDynObject? We use several procedures and an object is passed to them so that it inherits methods and variables. For example:
proc Object obj {
$obj x 1
$obj y 1
$obj z 1
$obj name Object
sd.new.method move for $obj takes {x y z} {
$self x $x
$self y $y
$self z $z
}
return $obj
}
proc Ball obj {
$obj name Ball ;#inherit methods and variables from Object
sd.new.method roll for $obj takes direction {
if {"n" == $direction} {
#roll ball north
} elseif {"e" == $direction} {
#roll ball east
}
...
}
return $obj
}
set b [Ball [Object [sd.new.object]]]
$b->move 5 4 3
$b->roll nDereferencing Instance Variables
Tcl and Tk use a -textvariable option that is very handy, but how do we do such a thing with SDynObject instance variables?
proc Class obj {
$obj v foo
return $obj
}
set c [Class [sd.new.object]]
pack [entry .e -textvariable [sd.dereference $c v]]
#.e should now display fooDestroying an Object
How do we destroy an object's variables and methods?
sd.destroy.object $obj
Note: I may eventually make it be done via $obj->destroy.
For further information I suggest that you study SDynObject.tcl It's less than 50 lines of code and in my opinion quite easy to understand. Well, Richard Suchenwirth said "suchenwi ..and only 50 LOC? Then best put them all up - much user-friendlier than a ZIP file..." So, here is the code:
#SDynObject 29
#By George Peter Staplin
#Get it, use it, share it, improve it, but don't blame me.
package provide SDynObject 1.0
set ::sd_instance_cmd {
if {1 == [llength $args]} {
return [set objAr([lindex $args 0])]
} elseif {2 == [llength $args]} {
array set objAr $args
} else {
return -code error "$obj key ?value?"
}
}
proc sd.dereference {objId v} {
return "::sd_instance_[set objId]($v)"
}
proc sd.destroy.object obj {
if {[info exists ::sd_methods_$obj]} {
foreach m [set ::sd_methods_$obj] {
catch {rename $m {}}
}
}
array unset ::sd_instance_$obj
catch {rename $obj {}}
}
proc sd.get.unique.command.name {} {
while 1 {
if {"" == [info commands [set n cmd[clock clicks]]]} {
return $n
}
}
}
proc sd.new.method {m _for_ obj _takes_ argList body} {
lappend ::sd_methods_$obj $obj->$m
proc $obj->$m $argList "set self $obj\n$body"
}
proc sd.new.object {} {
proc [set n [sd.get.unique.command.name]] \
args "upvar #0 sd_instance_$n objAr; $::sd_instance_cmd"
sd.new.method destroy for $n takes {} [list sd.destroy.object $n]
return $n
}