The following Itcl class implements a set of commands for
performing translation, scaling, rotation, shear and reflection
on a list of points. The class also supports a transform matrix stack so transforms can be chained together.

[Tom Krehbiel]

----

 #------------------------------------------------------------
 # Matrix equation for 2D point transform
 #------------------------------------------------------------
 #
 # | x'|   | a b tx | | x |   | a*x + b*y + tx |
 # | y'| = | c d ty | | y | = | c*x + d*y + ty |
 # | 1 |   | 0 0 1  | | 1 |   |        1       |
 #
 # Translate
 # ----------
 #
 # | 1 0 tx |     | x'|    | 1*x + 0*y + tx |
 # | 0 1 ty | =>  | y'| =  | 0*x + 1*y + ty |
 # | 0 0 1  |     | 1 |    |        1       |
 #
 # Scale
 # ----------
 #
 # | sx 0  0 |     | x'|   | sx*x +  0*y + 0 |
 # | 0  sy 0 | =>  | y'| = |  0*x + sy*y + 0 |
 # | 0  0  1 |     | 1 |   |         1       |
 #
 # Rotation
 # ----------
 #
 # for: r0 = cos(angle) 
 #      r1 = sin(angle) 
 #
 # | r0 -r1 0 |     | x'|    | r0*x - r1*y + 0 |
 # | r1  r0 0 | =>  | y'| =  | r1*x + r0*y + 0 |
 # | 0   0  1 |     | 1 |    |         1       |
 #
 # Shear
 # ----------
 #
 # | 1  hx 0 |     | x'|    |  1*x + hx*y + 0 |
 # | hy 1  0 | =>  | y'| =  | hy*x +  1*y + 0 |
 # | 0  0  1 |     | 1 |    |        1       |
 #
 # Reflection
 # ----------
 #
 # for: Rx,Ry := { 1.0 , -1.0 }
 #       1 = don't reflect 
 #      -1 = reflect 
 #
 # | Rx 0  0 |     | x'|   | Rx*x +  0*y + 0 |
 # | 0  Ry 0 | =>  | y'| = |  0*x + Ry*y + 0 |
 # | 0  0  1 |     | 1 |   |         1       |
 #
 #------------------------------------------------------------
 class Transform {

     # define some constants
     private common M_PI   3.14159265358979323846
     private common M_PI_2 1.57079632679489661923
     private common M_PI_4 0.78539816339744830962

     private variable maxStack 0   ;# max depth of stack
     private variable stackSiz 0
     private variable tmStack ""   ;# fifo stack of transform matrix's

     # Transform Matrix (TM)
     protected variable a
     protected variable b
     protected variable c
     protected variable d
     protected variable tx
     protected variable ty

     constructor { depth } {
         set maxStack $depth
         $this reset
     }
     destructor {
     }

     public method dump { {indent 0} }
     public method clearTransform { }
     public method clearStack { }
     public method reset { }
     public method push { }
     public method getTop { }
     public method pop { }
     public method getTransform { }
     public method translate { x y }
     public method scale { sx sy }
     public method rotate { deg }
     public method applyTransformToStack { x y s }
     public method apply { x y }
     public method applyR { rec }
     public method applyTo { xyList }
     public method applyStackTo { xyList }

 }
 #------------------------------
 # CLASS IMPLEMENTATION
 #------------------------------
 body Transform::dump { {indent 0} } {
     set x [string repeat " " $indent]
     puts "${x}+Transform: $this"
     puts "${x} a.......: $a"
     puts "${x} b.......: $b"
     puts "${x} c.......: $c"
     puts "${x} d.......: $d"
     puts "${x} tx......: $tx"
     puts "${x} ty......: $ty"
     puts "${x} maxStack: $maxStack"
     puts "${x} stackSiz: $stackSiz"
     puts "${x} tmStack.: $tmStack"
 }
 #----------
 # reset TM to unit matrix values
 body Transform::clearTransform { } {
     set a 1.0
     set b 0.0
     set c 0.0
     set d 1.0
     set tx 0.0
     set ty 0.0
 }
 #----------
 # reset TM to unit matrix values
 body Transform::clearStack { } {
     set stackSiz 0
     set tmStack ""
 }
 #----------
 # reset TM to unit matrix values
 body Transform::reset { } {
     clearTransform
     clearStack
 }
 body Transform::push { } {
     if { $stackSiz > $maxStack } {
         # remove an element from bottom of stack
         set tmStack [lreplace $tmStack end end]
         incr stackSiz -1
     }
     if { $stackSiz == 0 } {
         lappend tmStack "$a $b $c $d $tx $ty"
     } else {
         set tmStack [linsert $tmStack 0 "$a $b $c $d $tx $ty"]
     }
     incr stackSiz
     set a 1.0
     set b 0.0
     set c 0.0
     set d 1.0
     set tx 0.0
     set ty 0.0
 }
 body Transform::getTop { } {
     set result 0
     if { $stackSiz > 0 } {
         foreach {a b c d tx ty} [lindex $tmStack 0] break
     } else {
         set result 1
     }
     return $result
 }
 body Transform::pop { } {
     set result 0
     if { $stackSiz > 0 } {
         set tmStack [lreplace $tmStack 0 0]
         incr stackSiz -1
         set a 1.0
         set b 0.0
         set c 0.0
         set d 1.0
         set tx 0.0
         set ty 0.0
     } else {
         set result 1
     }
     return $result
 }
 body Transform::getTransform { } {
     return "$tx $ty $a"
 }
 body Transform::applyTransformToStack { x y s } {
     if { $stackSiz == 0 } { return }
     set new ""
     foreach tmEntry $tmStack {
         foreach {a b c d tx ty} $tmEntry break
         # scale
         set a [expr $a*$s]
         set b [expr $b*$s]
         set c [expr $c*$s]
         set d [expr $d*$s]
         # translate
         set tx [expr $a*$x + $b*$y + $tx]
         set ty [expr $c*$x + $d*$y + $ty]
         lappend new "$a $b $c $d $tx $ty"
     }
     set tmStack "$new"
     clearTransform
 }

 body Transform::translate { x y } {
     set tx [expr $a*$x + $b*$y + $tx]
     set ty [expr $c*$x + $d*$y + $ty]
 }
 body Transform::scale { sx sy } {
     set a [expr $a*$sx]
     set b [expr $b*$sy]
     set c [expr $c*$sx]
     set d [expr $d*$sy]
 }
 body Transform::rotate { deg } {
     if { $deg == 0.0 } {
         return
     } elseif { $deg == 90.0 } {
         set Cos 0.0
         set Sin -1.0
     } elseif { $deg == 180.0 } {
         set Cos -1.0
         set Sin 0.0
     } elseif { $deg == 270.0 } {
         set Cos 0.0
         set Sin 1.0
     } else {
         set Cos [expr cos($deg)]
         set Sin [expr sin($deg)]
     }
     set A $a
     set B $b
     set C $c
     set D $d

     set a [expr $A*$Cos + $B*$Sin]
     set b [expr $B*$Cos - $A*$Sin]
     set c [expr $C*$Cos + $D*$Sin]
     set d [expr $D*$Cos - $C*$Sin]
 }

 body Transform::apply { X Y } {
     upvar $X x $Y y
     set nx [expr $a*$x + $c*$y + $tx]
     set ny [expr $b*$x + $d*$y + $ty]
     set x $nx
     set y $ny
 }
 body Transform::applyR { rec } {
     foreach {x0 y0 x1 y1} $rec {}
     set nx0 [expr $a*$x0 + $c*$y0 + $tx]
     set ny0 [expr $b*$x0 + $d*$y0 + $ty]
     set nx1 [expr $a*$x1 + $c*$y1 + $tx]
     set ny1 [expr $b*$x1 + $d*$y1 + $ty]
     return "$nx0 $ny0 $nx1 $ny1"
 }
 body Transform::applyTo { xyList } {
     set result ""
     foreach {x y} $xyList {
         apply x y
         lappend result "$x" "$y"
     }
     return $result
 }
 body Transform::applyStackTo { xyList } {
     for {set i 0} {$i < $stackSiz} {incr i} {
         set new ""
         foreach {a b c d tx ty} [lindex $tmStack $i] break
         foreach {x y} $xyList {
             lappend new [expr $a*$x + $c*$y + $tx] [expr $b*$x + $d*$y + $ty]
         }
         set xyList $new
     }
     return $xyList
 }