[Keith Vetter] 2003-03-19 : for another project I needed to rotate 
and scale items on a canvas. Tcl will do the scaling for you (mostly)
and I wrote the following routines to do the rotation.

It works by rotating the coordinates of an item by some angle about
an arbitrary origin. This works well for polygons and lines but not
for ovals, rectangles or arcs. If you really need rotation of ovals,
rectangles and arcs you could first convert them into polygons 
(see [Regular polygons] for the code).

The demonstration code shows how it works. It draws a complex
item on the screen (the flag man from [Flag Signalling]) and
lets you rotate about some points. It shows both the good and
the bad.

----

 #----------------------------------------------------------------------
 #
 # RotateItem -- Rotates a canvas item any angle about an arbitrary point.
 # Works by rotating the coordinates of the object. Thus it works with:
 #  o polygon
 #  o line
 # It DOES NOT work correctly with:
 #  o rectangle
 #  o oval and arcs
 #  o text
 # 
 # Parameters:
 #       w - Path name of the canvas
 #       tagOrId - what to rotate -- may be composite items
 #       Ox, Oy - origin to rotate around
 #       angle - degrees clockwise to rotate by
 #
 # Results:
 #       Returns nothing
 #
 # Side effects:
 #       Creates a rounded polygon in the canvas.
 #
 #----------------------------------------------------------------------
 
 
 proc RotateItem {w tagOrId Ox Oy angle} {
    foreach id [$w find withtag $tagOrId] {     ;# Do each component separately
        set xy {}
        foreach {x y} [$w coords $id] {
            eval lappend xy [_RotateC $x $y $Ox $Oy $angle]
        }
        $w coords $id $xy
    }
 }
 proc _RotateC {x y Ox Oy angle} {
    # rotates vector (Ox,Oy)->(x,y) by angle degrees clockwise
 
    set x [expr {$x - $Ox}]                     ;# Shift to origin
    set y [expr {$y - $Oy}]
 
    set angle [expr {$angle * atan(1) * 4 / 180.0}] ;# Radians
    set xx [expr {$x * cos($angle) - $y * sin($angle)}] ;# Rotate
    set yy [expr {$x * sin($angle) + $y * cos($angle)}]
 
    set xx [expr {$xx + $Ox}]                   ;# Shift back
    set yy [expr {$yy + $Oy}]
 
    return [list $xx $yy]
 }
 
 ################################################################
 #
 # Demonstration code
 #
 
 
 proc Anchor {w tagOrId where} {
    foreach {x1 y1 x2 y2} [$w bbox $tagOrId] break
    if {[string first "n" $where] > -1} {
        set y $y1
    } elseif {[string first "s" $where] > -1} {
        set y $y2
    } else {
        set y [expr {($y1 + $y2) / 2.0}]
    }
    if {[string first "w" $where] > -1} {
        set x $x1
    } elseif {[string first "e" $where] > -1} {
        set x $x2
    } else {
        set x [expr {($x1 + $x2) / 2.0}]
    }
    return [list $x $y]
 }
 proc flagman {} {
    .c delete all
    .c create poly {-20 100 -5 100 0 50 5 100 20 100 25 -4 0 -10
        -25 -4} -fill white -tag poly
    .c create oval {-10 -29 10 -5} -fill orange  -outline orange -tag poly
    .c create line {-4 -20 -4 -17} -tag poly
    .c create line {4  -20  4 -17} -tag poly
    .c create arc -6 -24 6 -10 -start 210 -extent 125 -style arc -tag poly
    .c create rect {-9 -29 9 -24} -fill green -outline green -tag poly
    .c create poly -25 45 -25 57 -15 57 -15 45 -smo 1 -fill orange -tag poly
    .c create poly {-20 0 -25 0 -25 48 -15 48 -15 0} -fill grey95 -tag poly
    .c create poly {-21 50 -21 90 -19 90 -19 50} -fill brown -tag poly
    .c create poly {-21 88 -21 60 7 60 7 88} -fill red -tag poly
    .c create poly {-21 60 7 60 7 88} -fill yellow -tag poly
    .c create poly 25 45 25 57 15 57 15 45 -smooth 1 -fill orange -tag poly
    .c create poly {20 0 25 0 25 48 15 48 15 0} -fill grey95 -tag poly
    .c create poly {21 50 21 90 19 90 19 50} -fill brown -tag poly
    .c create poly {21 88 21 60 -7 60 -7 88} -fill red  -tag poly
    .c create poly {21 60 -7 60 -7 88} -fill yellow -tag poly
    .c create text 0 110 -text "Flag Man" -anchor c -tag poly
    .c move poly 0 -35.5
    
    bind . <Up>   {.c scale all 0 0 1.25 1.25}
    bind . <Down> {.c scale all 0 0 0.8 0.8}
    bind .c <1>   {.c scale all 0 0 1.25 1.25}
    bind .c <3>   {.c scale all 0 0 0.8 0.8}
 }
 
 proc Reset {} {
    flagman
    DrawAnchor
 }
 proc DrawAnchor {args} {
    .c delete anchor
    foreach {x y} [Anchor .c poly $::anchor] break
    set x0 [expr {$x - 3}]; set y0 [expr {$y - 3}]
    set x1 [expr {$x + 3}]; set y1 [expr {$y + 3}]
    .c create oval $x0 $y0 $x1 $y1 -tag anchor -fill black
 }
 proc Recenter {W h w} {
    set h [expr {$h / 2.0}] ; set w [expr {$w / 2.0}]
    $W config -scrollregion [list -$w -$h $w $h]
 }
 proc Doit {} {
    foreach {Ox Oy} [Anchor .c anchor c] break  ;# Get rotation point
    RotateItem .c poly $Ox $Oy $::angle
 }
 
 canvas .c -width 300 -height 300 -bd 2 -relief raised
 bind .c <Configure> {Recenter %W %h %w}
 
 scale .angle -orient horizontal -label "Rotation angle" -variable angle \
    -from -180 -to 180 -relief ridge
 labelframe .l -text "Rotation point"
 foreach {a1 a2 a3} {nw n ne w c e sw s se} {
    radiobutton .l.$a1 -text $a1 -variable anchor -value $a1 -anchor w -command DrawAnchor
    radiobutton .l.$a2 -text $a2 -variable anchor -value $a2 -anchor w -command DrawAnchor
    radiobutton .l.$a3 -text $a3 -variable anchor -value $a3 -anchor w -command DrawAnchor
    grid .l.$a1 .l.$a2 .l.$a3 -sticky ew
 }
 button .rotate -text Rotate -command Doit
 button .reset -text Reset -command Reset
 image create photo ::img::blank -width 1 -height 1
 button .about -image ::img::blank -highlightthickness 0 -command \
    {tk_messageBox -message "Canvas Rotation\nby Keith Vetter, March 2003"}
 place .about -in . -relx 1 -rely 1 -anchor se
 
 grid .c - - - -row 0 -sticky news
 grid .l .angle .rotate
 grid ^  ^      .reset
 grid rowconfigure . 0 -weight 1
 grid columnconfigure . 3 -weight 1
 grid config .angle -sticky n -pady 7
 
 set anchor c
 set angle 30
 Reset

----
[Category Graphics]