###########################################################
## Small example to emulate a itcl-like language in XOTcl
## -gustaf neumann Jan. 2004
###########################################################
namespace eval itcl {
Class create class -superclass Class
class instproc instvars {} {
set vars [list]; set c [self]
for {} {[string compare ::xotcl::Object $c]} {set c [$c info superclass]} {
eval lappend vars [$c set __autovars]
}
return "\n\tmy instvar [lsort -unique $vars]"
}
class proc constructor {args} {
if {[llength $args]==2} {
foreach {arglist body} $args break
} else {
foreach {arglist construct body} $args break
set body $construct\n$body
}
my parameter [list {this [self]}]
my proc constructor args {uplevel next $args}
my instproc init $arglist [my instvars]\n$body
}
class proc method {name arglist body} {
my proc $name args {uplevel next $args}
my instproc $name $arglist [my instvars]\n$body
}
class proc inherit {class} {
my superclass $class
}
class proc variable {arglist} {
foreach v $arglist {my lappend __autovars $v}
}
class instproc init {classdef} {
my set __autovars this
namespace eval [self class] $classdef
my class Class
}
proc delete {what name} {$name destroy}
}Below is the Object Instantiation Test, which is codewise a superset of the OO Method Calls. The code for the method invocation test is available at [1].
###########################################################
# Two Demo classes from oo-bench
###########################################################
itcl::class Toggle {
variable state
constructor {start_state} {
set state $start_state
}
method value {} {
return $state
}
method activate {} {
set state [expr {!$state}]
return $this
}
}
itcl::class NthToggle {
inherit Toggle
variable count_max
variable counter
constructor {start_state max_counter} {
Toggle::constructor $start_state
} {
set count_max $max_counter
set counter 0
}
method activate {} {
if {[incr counter] >= $count_max} {
Toggle::activate
set counter 0
}
return $this
}
}
proc main {n} {
set toggle1 [Toggle \#auto 1]
for {set i 0} {$i<5} {incr i} {
$toggle1 activate
if {[$toggle1 value]} {
puts true
} else { puts false
}
}
itcl::delete object $toggle1
for {set i 0} {$i<$n} {incr i} {
set toggle [Toggle toggle$i 1]
itcl::delete object $toggle
}
puts {}
set ntoggle1 [NthToggle \#auto 1 3]
for {set i 0} {$i<8} {incr i} {
$ntoggle1 activate
if {[$ntoggle1 value]} {
puts true
} else {
puts false
}
}
itcl::delete object $ntoggle1
for {set i 0} {$i<$n} {incr i} {
set ntoggle [NthToggle toggle$i 1 3]
itcl::delete object $ntoggle
}
}
main [expr {$argc==1?[lindex $argv 0]:1}]Category XOTcl Code
