Little Sugar for Stooop object system:
#------------------------------------------------------------------------------ proc unknown {cmd args} {
if {[string index $cmd 0] == "@"} { return [stooopSugar $cmd {*}$args] } else { error "unknown: $cmd $args" }
}
proc stooopSugar {cmd args} {
set parts [split $cmd .] set this [string range [lindex $parts 0] 1 end] set method [lindex $parts 1] set class [::stooop::classof $this] # first check if it is a class method if {[info procs ${class}::${method}] != ""} { return [${class}::${method} $this {*}$args] } # now checks if it is a ancestor method set baseClasses $::stooop::fullBases($class) foreach class $baseClasses { if {[info procs ${class}::${method}] != ""} { ${class}::${method} $this {*}$args } else { error "there is no suck method $method on class $class" } }
} #------------------------------------------------------------------------------
Usage:
package require stooop 4 ;# load stooop package namespace import stooop::* ;# and import class, new, ... commands
class shape { ;# base class definition
proc shape {this x y} { ;# base class constructor set ($this,x) $x ;# data member initialization set ($this,y) $y } proc ~shape {this} {} ;# base class destructor # pure virtual draw: must be implemented in derived classes virtual proc draw {this} virtual proc rotate {this angle} {} ;# do nothing by default
} proc shape::move {this x y} { ;# external member procedure definition
set ($this,x) $x set ($this,y) $y draw $this ;# shape::draw invokes derived class implementation puts "and I moved to ($x,$y)"
}
class triangle { ;# class definition
proc triangle {this x y} shape {$x $y} { ;# derived from shape # triangle constructor implementation } proc ~triangle {this} {} proc draw {this} { # triangle specific implementation puts "i am a triangle!!!" } proc rotate {this angle} { # triangle specific implementation }
}
class circle {} ;# empty class definition, procedures are defined outside proc circle::circle {this x y} shape {$x $y} { ;# derived from shape
# circle constructor implementation
} proc circle::~circle {this} {} proc circle::draw {this} {
# circle specific implementation puts "I am a circle!!!"
} # circle::rotate procedure is a noop, no need to overload
set s new circle 20 20 @$s.draw @$s.move 10 20
set f new triangle 10 20 @$f.move 20 25
enter categories here |
---|