3 # Create a class, the usual bank account, with two instance variables:
9 # We have some class methods predefined
10 # Note we can call (e.g.) either Account.methods or 'Account methods'
11 puts "---- class Account ----"
12 puts "Account vars=[Account vars]"
13 puts "Account methods=[Account methods]"
16 # Create a constructor. This does validation, but it could
18 Account method constructor
{} {
20 error "Can't initialise account with a -ve balance"
24 # Now flesh out the class with some methods
25 # Could use 'Account method' here instead
26 Account method deposit
{amount
} {
27 set balance
[+ $balance $amount]
29 Account method see
{} {
32 Account method withdraw
{amount
} {
33 if {$amount > $balance} {error "Sorry $name, can only withdraw $balance"}
34 set balance
[- $balance $amount]
36 Account method describe
{} {
37 puts "I am object $self of class [$self classname]"
38 puts "My 'see' method returns [$self see]"
39 puts "My variables are:"
40 foreach i
[$self vars
] {
45 # Now an instance, initialisition some fields
46 set a
[Account new
{name
"Bob Smith"}]
48 puts "---- object Account ----"
49 # We can use class methods on the instance too
51 puts a.classname
=[$a classname
]
55 puts "deposit 100 -> [$a see]"
58 puts "withdraw 40 -> [$a see]"
60 catch {$a withdraw
1000} res
61 puts "withdraw 1000 -> $res\n"
63 # Tell me something about the object
67 # Now create a new subclass
68 # Could change the initial balance here too
69 class CreditAccount Account
{
73 CreditAccount method constructor
{} {
75 # If desired, manually invoke the baseclass constructor
79 # Override the 'withdraw' method to allow overdrawing
80 CreditAccount method withdraw
{amount
} {
81 if {$balance - $amount < $limit} {error "Sorry $name, that would exceed your credit limit of [expr -$limit]"}
82 set balance
[- $balance $amount]
84 # Override the 'describe' method, but invoke the baseclass method first
85 CreditAccount method describe
{} {
86 # First invoke the base class 'describe'
89 puts "*** Account is in debit"
93 puts "---- class CreditAccount ----"
94 puts "CreditAccount vars=[CreditAccount vars]"
95 puts "CreditAccount methods=[CreditAccount methods]"
98 puts "---- object CreditAccount ----"
99 set b
[CreditAccount new
{name
"John White"}]
101 puts b.vars
=[$b vars
]
102 puts b.classname
=[$b classname
]
104 puts "initial balance -> [$b see]"
106 puts "deposit 100 -> [$b see]"
109 puts "withdraw 40 -> [$b see]"
112 puts "withdraw 1000 -> [$b see]"
115 # Tell me something about the object
119 # 'eval' is similar to 'dict with' for an object, except it operates
120 # in it's own scope. A list of variables can be imported into the object scope.
121 # It is useful for ad-hoc operations for which it is not worth defining a method.
123 $a eval total
{ incr total
$balance }
124 incr total
[$b get balance
]
125 puts "Total of accounts [$a get name] and [$b eval {return "$name (Credit Limit
: $limit)"}] is: $total"
127 # Can we find all objects in the system?
128 # Almost. We can't really distinguish those which aren't real classes.
129 # This will get all references which aren't simple lambdas.
130 puts "---- All objects ----"
131 Account new
{name
"Terry Green" balance
20}
136 foreach r
[info references
] {
137 if {[getref
$r] ne
{}} {
140 puts [format "Found %14s: Owner: %14s, Balance: %+5d, in object %s" [$self classname
] $name $balance $self]
143 puts "Not an object: $r"
152 # Let the garbage collection take care of this one