#!/bin/sh # A simple example file for obstcl \ exec wish80 "$0" "$@" catch {lappend auto_path [pwd]} catch {lappend auto_path [file dirname [pwd]]} package require obstcl proc Polygon {} {} ;# for auto_mkindex proc Rectangle {} {} ;# for auto_mkindex # Just to prove a point, create the classes in their own namespace namespace eval demo {} # Create a class and a subclass. (By the way, I don't advocate # doing this for real -- it's just an example!) obstcl::class ::demo::Polygon { inherit Object option -fill blue option -canvas {} variable canvas variable id constructor {args} { set opts {} if { [set t [lsearch -regexp $args {^-[a-zA-Z-_]*$}]] > 0 } { set opts [lrange $args $t end] set args [lreplace $args $t end] } eval configure $this $opts if { $_options(-canvas) == "" } { error "Canvas is required" } set canvas $_options(-canvas) set id [eval $canvas create polygon $args \ [list -fill $_options(-fill)]] } method move {x y} { $canvas move $id $x $y } method rotate {x y angle} { set angle [expr double($angle) / 180.0 * 3.1415926] set newc {} foreach {a b} [$canvas coords $id] { if { $a == $x && $y == $b } { lappend result $a $b } else { set dx [expr $a - $x] set dy [expr $b - $y] set radius [expr sqrt($dx*$dx+$dy*$dy)] set theta [expr atan2($dy, $dx) + $angle] set a [expr $x + $radius * cos($theta)] set b [expr $y + $radius * sin($theta)] lappend newc $a $b } } eval $canvas coords $id $newc } } obstcl::class ::demo::Rectangle { inherit demo::Polygon option -size 10 constructor {x y args} { if ![string match {-*} [lindex $args 0]] { error "Rectangle expects x y -option value..." } eval configure $this $args set s $_options(-size) set x0 [expr $x - $s] set y0 [expr $y - $s] set x1 [expr $x + $s] set y1 [expr $y + $s] eval super $this constructor $x0 $y0 $x1 $y0 $x1 $y1 $x0 $y1 } } # Now create some objects and mess with them catch {destroy .c} set unique 0 canvas .c pack .c raise . update set p [demo::Polygon polygon[incr unique] \ 100 20 120 20 120 10 140 30 120 50 120 40 100 40 -canvas .c -fill red] set r [demo::Rectangle polygon[incr unique] \ 100 100 -canvas .c] for {set i 0} {$i < 20} {incr i} { $p move 1 1 update idletasks after 50 } for {set i 0} {$i < 144} {incr i} { $p rotate 100 100 5 $r rotate 100 100 -10 update idletasks after 20 }