blob: 4e62fb46d7d47206c482e92c663beda40f737689 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
set here [file dirname [file join [pwd] [info script]]]
puts LOADING
source [file join $here .. oodialect oodialect.tcl]
source [file join $here .. dicttool dicttool.tcl]
source [file join $here .. oometa oometa.tcl]
source [file join $here .. sha1 sha1.tcl]
source [file join $here index.tcl]
tool::class create foo {
option color {default blue}
}
puts "START DEMO"
foo create bar
puts [bar cget color]
bar configure color green
puts [bar cget color]
tool::class create car {
option color {
default: white
}
variable location home
array physics {
speed 0
accel 0
position {0 0}
}
method physics {field args} {
my variable physics
if {[llength $args]} {
set physics($field) $args
}
return $physics($field)
}
method location {} {
my variable location
return $location
}
method move newloc {
my variable location
set location $newloc
}
}
car create car1 color green
car1 cget color
#> green
car create car2
car2 cget color
#> white
car1 location
#> home
car1 move work
car1 location
#> work
puts [car1 physics speed]
#> 0
car1 physics speed 10
puts [car1 physics speed]
#> 10
|
