ITcl
package require Itcl
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 \#auto 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 \#auto 1 3]
itcl::delete object $ntoggle
}
}
main [expr {$argc==1?[lindex $argv 0]:1}]
OTcl
Class Toggle
Toggle instproc state {v} {
$self set state $v
}
Toggle instproc value {} {
$self set state
}
Toggle instproc activate {} {
$self state [expr {! [$self set state]}]
set self
}
Class NthToggle -superclass Toggle
NthToggle instproc max {v} {
$self set max $v
}
NthToggle instproc init args {
eval $self next $args
$self set counter 0
}
NthToggle instproc activate {} {
$self instvar counter
if {[incr counter] >= [$self set max]} {
$self next
set counter 0
}
set self
}
proc main {} {
set n [lindex $::argv 0]
set toggle1 [Toggle t1 -state 1]
for {set i 0} {$i<5} {incr i} {
$toggle1 activate
if {[$toggle1 value]} {puts true} else {puts false}
}
$toggle1 destroy
for {set i 0} {$i<$n} {incr i} {
set toggle [Toggle t$i -state 1]
$toggle destroy
}
puts {}
set ntoggle1 [NthToggle nt -state 1 -max 3]
for {set i 0} {$i<8} {incr i} {
$ntoggle1 activate
if {[$ntoggle1 value]} {puts true} else {puts false}
}
$ntoggle1 destroy
for {set i 0} {$i<$n} {incr i} {
set ntoggle [NthToggle nt$i -state 1 -max 3]
$ntoggle destroy
}
}
main
XOTcl
Class Toggle -parameter state
Toggle instproc value {} {
my state
}
Toggle instproc activate {} {
my state [expr {! [my state]}]
self
}
Class NthToggle -superclass Toggle -parameter max
NthToggle instproc init {} {
next
my set counter 0
}
NthToggle instproc activate {} {
if {[my incr counter] >= [my max]} {
next
my set counter 0
}
self
}
proc main {} {
set n [lindex $::argv 0]
set toggle1 [Toggle new -state 1]
for {set i 0} {$i<5} {incr i} {
$toggle1 activate
if {[$toggle1 value]} {puts true} else {puts false}
}
$toggle1 destroy
for {set i 0} {$i<$n} {incr i} {
set toggle [Toggle new -state 1]
$toggle destroy
}
puts {}
set ntoggle1 [NthToggle new -state 1 -max 3]
for {set i 0} {$i<8} {incr i} {
$ntoggle1 activate
if {[$ntoggle1 value]} {puts true} else {puts false}
}
$ntoggle1 destroy
for {set i 0} {$i<$n} {incr i} {
set ntoggle [NthToggle new -state 1 -max 3]
$ntoggle destroy
}
}
main
Category XOTcl Code
stooop
class Toggle {
proc Toggle {this start_state} {
set ($this,state) $start_state
}
proc ~Toggle {this} {}
virtual proc value {this} {
return $($this,state)
}
proc activate {this} {
set ($this,state) [expr {!$($this,state)}]
return $this
}
}
class NthToggle {
proc NthToggle {this start_state max_counter} Toggle {$start_state} {
set ($this,count_max) $max_counter
set ($this,counter) 0
}
proc ~NthToggle {this} {}
proc activate {this} {
if {[incr ($this,counter)]>=$($this,count_max)} {
set Toggle::($this,state) [expr {!$Toggle::($this,state)}]
set ($this,counter) 0
}
return $this
}
}
proc main {n} {
set toggle1 [new Toggle 1]
for {set i 0} {$i<5} {incr i} {
if {[Toggle::value [Toggle::activate $toggle1]]} {
puts true
} else {
puts false
}
}
delete $toggle1
for {set i 0} {$i<$n} {incr i} {
set toggle [new Toggle 1]
delete $toggle
}
puts {}
set ntoggle1 [new NthToggle 1 3]
for {set i 0} {$i<8} {incr i} {
if {[Toggle::value [NthToggle::activate $ntoggle1]]} {
puts true
} else {
puts false
}
}
delete $ntoggle1
for {set i 0} {$i<$n} {incr i} {
set ntoggle [new NthToggle 1 3]
delete $ntoggle
}
}
main [expr {$argc==1?[lindex $argv 0]:1}]