1### Sample file for parameter testing....
2### For every class "-parameter" can be specified which accepts 
3### a list of parameter specifications.
4###
5### * If a parameter specification consists of a single word,
6###   the word is considered as the parameter name and
7###   a standard setter/getter method with this name is created.
8###
9### * If the parameter specification  consists of two words, the 
10###   second word is treated as the default value, which is stored 
11###   in the class object.
12###
13### * If a default value exists in the class object, a
14###   corresponding instance variable with the name of the
15###   parameter is created automatically during initialization 
16###   of the object.
17###
18### * If the parameter specification consists of more than two words, 
19###   various parameter methods  (starting with "-") with arguments 
20###   can be specified. In the following example
21###       Class C -parameter {{a 1} {b -default 1}}
22###       C c1
23###   both a and b receive 1 as default value.
24###
25### * In order to call the standard getter method use the method
26###   with the name of the parameter with one parameter. For example, 
27###   in order to call the standard getter for parameter a, use
28###       puts [c1 a]
29###   In order to use the standard setter for b, use the method with
30###   two parameters.
31###       c1 b 123
32###
33### * There are two ways to specify custom setter/getter methods for
34###   parameters: (a) the custom setter/getter can be defined within the
35###   class hierarchy of the object, or (b) the custom getter/setter can
36###   be specified on a different object. The custom setter/getter 
37###   method are called, from the standard setter/getter methods
38###   automatically if specified.
39### * In order to use approach (a) the parameter methods -getter 
40###   and -setter can be used to specify the custom getter and 
41###   and setter methods:
42###       Class D -parameter {{a -setter myset -getter myget}}
43###   The methods myset and myget are called like set with
44###   one or two arguments. They are responsible for setting and
45###   retrieving the appropiate values. It is possible to 
46###   specify any one of these parameter methods.
47### * In order to use approach (b) a parameter methods -access
48###   is use to specify an object responsible for setting/getting
49###   these values. This has the advantage that the custom getter and
50###   setter methods can be inherited from a separate class hierarchy,
51###   such they can used for any object without cluttering its
52###   interface. 
53### * In order to keep the parameter specification short the access 
54###   object my contain instance variables setter or getter, naming the
55###   setter/getter methods. If these instance variables are not 
56###   in the access object, "set" is used per default for getter and
57###   setter. These default values can be still overridden by the 
58###   parameter methods -setter or -getter.
59### * If the access object is specified, <object variable value>
60###   are passed to the setter method and <object varible> are passed
61###   to the custom getter method (in approach (a) the object is
62###   is not needed).
63
64Object different
65different set setter myset
66different set getter myget
67different proc myset {o var value} { $o set $var $value }
68different proc myget {o var} { $o set $var }
69
70
71Object print
72print proc set {o args} {
73  ::set var [lindex $args 0]
74  if {[llength $args]==1} {
75    puts "*** $o get $var"
76    $o set $var
77  } else {
78    ::set value [lindex $args 1]
79    puts "*** $o set $var $value"
80    $o set $var $value
81  }
82}
83print proc myset {o var value} { 
84  puts "*** $o myset $var $value"
85  $o set $var $value 
86}
87
88Class P
89P instproc set {o args} {
90  puts stderr "instance [self] of parameter class P called for $o $args"
91  if {[llength $args] == 1} {
92    $o set [lindex $args 0]
93  } else {
94    $o set [lindex $args 0] [lindex $args 1]
95  }
96}
97P p
98
99Class M
100M instproc mset args {
101  puts stderr "Mixin [self class] called for [self] $args"
102  if {[llength $args] == 1} {
103    my set [lindex $args 0]
104  } else {
105    my set [lindex $args 0] [lindex $args 1]
106  }
107}
108
109
110set x different
111
112Class C -parameter {
113  {c [self]} 
114  d
115  {e ""} 
116  {f -default 123 -setter setf -getter getf} 
117  {g -default 1000 -access print} 
118  {h -default 1001 -access print -setter myset} 
119  {i -default 1002 -access different} 
120  {j -default $x -access ::p} 
121  {k {[self class]}}
122  {l -default {[self class]} }
123  }
124C parameter [list [list z -access [P new -childof C] -default zzz]]
125
126C instmixin M
127C parameter {{x -default 333 -setter mset -getter mset}}
128
129puts stderr +++[C info parameter]
130
131C instproc setf {var val} {
132  puts stderr "... setting $var to $val"
133  my set $var $val
134}
135C instproc getf var {
136  puts stderr "... getting value of $var"
137  my set $var
138}
139
140#puts stderr "body of f: [C info instbody f]"
141puts stderr "body of x: [C info instbody x]"
142puts ======================create
143C c1 -f 133 -g 101 -h 102 -i 103
144puts ======================readvars
145foreach v [lsort [c1 info vars]] {
146  puts "$v = <[c1 $v]>"
147}
148
149puts "instances of P: [P info instances]"
150puts "instances of C: [C info instances]"
151