source object.tcl namespace import Object::* set ObjectDebug 1 #------------------------------------------------------ #declares new class with name ClassA and without parents class ClassA { #declare constructor constructor { puts "ClassA::constructor: $this $args" } #declares destructor destructor { puts "ClassA::destructor $this" } #declares invariant invariant { puts "ClassA::invariant $this" } #declares attribute Attr1 with default Value attribute Attr1 defValue1 #declares methodA without arguments method methodA {} { puts "classA::methodA $this" return 1 } -precondition { puts "classA::methodA - precondition $this" } -postcondition { puts "classA::methodA - postcondition $this" } #declares methodB with 1 argument method methodB {a} { puts "classA::methodB $this $a" return $a } -precondition { if {[scan $a "%d" value] != 1} { error "argument should be a number" } } } #------------------------------------------------------ #declares new class with name NewClass and with parent classA class ClassB "ClassA" { constructor { puts "ClassB::constructor $this $args" } destructor { puts "ClassB::destructor $this" } invariant { puts "ClassB::invariant $this" } method methodA {} { puts "classB::methodA $this" } -postcondition { puts "classB::methodA - postcondition $this" } } #------------------------------------------------------ #declares some procedures, used in bindings proc onDelete {args} { puts "On Delete Object $args" } proc onChangeAttr {args} { puts "On Change Attribute $args" } puts "++++ set objA \[new ClassA\] ++++" set objA [new ClassA] Object::bind $objA OnDelete ::onDelete puts "++++ \$objA methodA ++++" $objA methodA puts "++++ \$objA methodB argB ++++" $objA methodB 1 puts "++++ set objB \[new ClassB\] ++++" set objB [new ClassB] Object::bind $objB OnDelete onDelete Object::bind $objB OnChangeAttr1 onChangeAttr puts "++++ \$objB methodA ++++" $objB methodA puts "++++ \$objB methodB argB ++++" $objB methodB 2 puts "++++ \$objB getAttr1 ++++" puts [$objB getAttr1] puts "++++ \$objB setAttr1 \"new Value\" ++++" $objB setAttr1 "new Value" puts "++++ \$objB getAttr1 ++++" puts [$objB getAttr1] Object::unbind $objB OnDelete onDelete puts "++++ delete \$objA ++++" delete $objA puts "++++ delete \$objB ++++" delete $objB