[Richard Suchenwirth] 2007-10-20 - Now that I have [TclOO] both at work and home, and another weekend comes up, it's obvious that I wanted to play with it, just for finger practice. Barking dogs have been demonstrated elsewhere, but I decided to start with another classic example, a bank account.

 #!/usr/bin/env tclsh85
 package require TclOO
 namespace import oo::*
 catch {Account destroy} ;# in case of repeated sourcing

 class create Account {
    constructor {{ownerName undisclosed}} {
        my variable total overdrawLimit owner
        set total 0
        set overdrawLimit 10
        set owner $ownerName 
    }
    method deposit amount {
        my variable total
        set total [expr {$total + $amount}]
    }
    method withdraw amount {
        my variable {*}[info object vars [self]] ;# "auto-import" all variables
        if {($amount - $total) > $overdrawLimit} {
            error "Can't overdraw - total: $total, limit: $overdrawLimit"
        }
        set total [expr {$total - $amount}]
    }
    method transfer {amount targetAccount} {
        my variable total
        my withdraw $amount
        $targetAccount deposit $amount
        set total
    }
    destructor {
        my variable total
        if {$total} {puts "remaining $total will be given to charity"}
    }
 }
if 0 {Due to the simple hierarchy of TclOO (every class is an instance of ''oo::class'', which is an instance of ''oo::object''), it is not very hard to add development helper methods that each object inherits:}

 define oo::object method dump {{pat *}} {
    set res [list class [info object class [self]]]
    foreach i [info object vars [self] $pat] {
        my variable $i
        lappend res $i [set $i]
    }
    set res
 }
#-- "Test suite"
 foreach cmd [split {
    set a [Account new "John Doe"]
    $a deposit 200
    $a deposit 20
    $a withdraw 150
    $a withdraw 100
    $a dump
    set b [Account new]
    $a transfer 65 $b
    $a dump
    $b dump
    $a transfer 1000000 $b
    $b destroy
 } \n] {
    catch $cmd res
    puts "$cmd -> $res"
 }
if 0 {which prints
    set a [Account new "John Doe"] -> ::oo::Obj36
    $a deposit 200 -> 200
    $a deposit 20 -> 220
    $a withdraw 150 -> 70
    $a withdraw 100 -> Can't overdraw - total: 70, limit: 10
    $a dump -> class ::Account total 70 overdrawLimit 10 owner {John Doe}
    set b [Account new] -> ::oo::Obj37
    $a transfer 65 $b -> 5
    $a dump -> class ::Account total 5 overdrawLimit 10 owner {John Doe}
    $b dump -> class ::Account total 65 overdrawLimit 10 owner undisclosed
    $a transfer 1000000 $b -> Can't overdraw - total: 5, limit: 10
 remaining 65 will be given to charity
    $b destroy ->

Interactive testing is, as usual with Tcl, a good way to learn. In the following case, it shows that variables are not exactly protected from hack attacks:
 % set $a\::total 1000000
 1000000
 % $a dump
 class ::Account total 1000000 overdrawLimit 10 owner {John Doe}
So better not deploy a real banking software based on this code :^) On the lighter side, [introspection] works as we all know and love, for easy "online help":
 % class help
 unknown method "help": must be create, destroy or dump
 % Account help
 unknown method "help": must be create, destroy, dump or new
 % $a help
 unknown method "help": must be deposit, destroy, dump, transfer or withdraw

Another issue: member variables must be explicitly imported into methods (similar to [namespace] rules). If you prefer the [C++] style (all member variables implicitly known), one hackish solution was demonstrated in the ''withdraw'' method above, and here's some sugar-coating if you want it more often:
 proc all_my_variables {} {
    uplevel 1 {my variable {*}[info object vars [self]]}
 }
so the method can then look like
    method withdraw amount {
        all_my_variables
        if {($amount - $total) > $overdrawLimit} {
            error "Can't overdraw - total: $total, limit: $overdrawLimit"
        }
        set total [expr {$total - $amount}]
    }
To distinguish members and others, one might then use the C++ convention that member names end in "_".

To summarize my first impressions, TclOO can be used well as an OO system in itself. I haven't even used all features as documented in TIP #257. So when I'll need some [OO] in the future, I can probably just use this, and do without [incr Tcl] or [XOTcl] ... :^)

}

----
The most part of the above example was also included in http://en.wikibooks.org/wiki/Tcl_Programming/Introduction#TclOO - everyone is welcome to make it better!
----
[DKF]: Well, you can go one better:

 oo::class create class {
    superclass oo::class
    constructor {args} {
       my variable vars
       set vars {}
       next {*}$args
    }
    method global {variable {initValue {}}} {
       my variable vars
       lappend vars $variable $initValue
    }
    method constructor {args body} {
       my variable vars
       set body0 {}
       foreach {var val} $vars {append body0 [list variable $var $val] \;}
       oo::define [self] constructor $args $body0$body
    }
    method method {name args body} {
       my variable vars
       set body0 {}
       foreach {var val} $vars {append body0 [list variable $var] \;}
       oo::define [self] method $name $args $body0$body
    }
    method destructor body {
       my variable vars
       set body0 {}
       foreach {var val} $vars {append body0 [list variable $var] \;}
       oo::define [self] destructor $body0$body
    }
 }

 class create Account
 Account global total 0
 Account global overdrawLimit 10
 Account global owner
 Account constructor {{ownerName undisclosed}} {
    set owner $ownerName 
 }
 Account method deposit amount {
    set total [expr {$total + $amount}]
 }
 Account method withdraw amount {
    if {($amount - $total) > $overdrawLimit} {
       error "Can't overdraw - total: $total, limit: $overdrawLimit"
    }
    set total [expr {$total - $amount}]
 }
 Account method transfer {amount targetAccount} {
    my withdraw $amount
    $targetAccount deposit $amount
    return $total
 }
 Account destructor {
    if {$total} {puts "remaining $total will be given to charity"}
 }

----
%| [Category Example] | [Category Object orientation] |%