# scans for -foo "str" pairs and converts them
# into variable=value pairs in the surrounding
# scope - i.e. -foo "str" becomes "foo" with a
# value of "str" in the calling routine.
proc init { args } {
set max [ llength $args ]
if { $max == 1 } {
# braced set of args
eval set args $args
set max [ llength $args ]
}
for { set i 0 } { $i <= $max } { } {
set s [ lindex $args $i ]
if { [ string index $s 0 ] == "-" } {
set var [ string range $s 1 end ]
incr i
if { $i < $max } {
set val [ lindex $args $i ]
if { [ string index $val 0 ] != "-" } {
uplevel 1 set $var \{$val\}
continue
}
}
uplevel 1 set $var 1
}
incr i
}
}
proc class { type inherits instvars methods } {
global classinfo
foreach superclass $inherits {
set methods "
$methods
$classinfo($superclass-methods)
"
eval lappend instvars $classinfo($superclass-instvars)
}
set classinfo($type-instvars) $instvars
set classinfo($type-methods) $methods
set typeproc {
set instproc {
upvar @var THIS
@type THIS $method $args
}
upvar $var THIS
if { "$method" == "" } { return $self(=value) }
@init
switch $method {
@methods
}
regsub -all @var $instproc $var instproc
proc $var { { method "" } args } $instproc
}
regsub -all @type $typeproc $type typeproc
regsub -all self $methods THIS(=value) methods
foreach instvar $instvars {
if { "$instvar" == "args" } {
regsub @init $typeproc {init $args} typeproc
} else {
regsub -all $instvar $methods self($instvar) methods
}
}
regsub -all @init $typeproc "" typeproc
regsub -all @methods $typeproc $methods typeproc
regsub -all THIS $typeproc self typeproc
proc $type { var method args } $typeproc
}
class File {} { args filename } {
= {set filename "$open" ; set self [open $open]}
gets {return [ gets $self ]}
puts {puts $self "$args"}
eof {return [eof $self]}
close {close $self}
name {return $filename}
}
class TextFile { File } {} {
= { set filename "${open}.txt" ; set self [open $filename]}
}
class int {} {} {
= {set self [expr int(round($args))]}
++ {incr self}
}
TextFile F = -open chap2
puts "Filename is [F name]"
int i = 1
while 1 {
set line [ F gets]
if [F eof] break
puts "[i]:$line"
i ++
}
F close
.-. .-. .---. .---. .-..-. | "Bill Gates is just a monocle
| |__ / | \| |-< | |-< > / | and a Persian Cat away from
`----'`-^-'`-'`-'`-'`-' `-' | being one of the bad guys in a
My opinions only. | James Bond movie." -- D MillerCategory Object Orientation | Category Package | Category Acronym