[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 clockwise the coordinates of an item by some angle about
an arbitrary origin. This works well for polygons and lines but not
for ovals, rectangles, arcs or text. 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 contains mostly polygons
and lines but also an oval, arc, rectangle and text so you can
see how it fails with those items.

----
[RS] notes that rectangles can be converted to polygons in a loss-free way, and finely rotated thereafter. Raw sketch:
 proc rect2poly {w item} {
    foreach {x0 y0 x1 y1} [$w coords $item] break
    $w delete $item
    $w create poly $x0 $y0 $x0 $y1 $x1 $y1 $x1 $y0 ;# need -fill etc. attributes here
 }
for a more detailed example: [Rectangle Conversion]
----


 #----------------------------------------------------------------------
 #
 # 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:
 #       Rotates a canvas item by ANGLE degrees clockwise
 #
 #----------------------------------------------------------------------
 
 proc RotateItem {w tagOrId Ox Oy angle} {
    set angle [expr {$angle * atan(1) * 4 / 180.0}] ;# Radians
    foreach id [$w find withtag $tagOrId] {     ;# Do each component separately
        set xy {}
        foreach {x y} [$w coords $id] {
            # rotates vector (Ox,Oy)->(x,y) by angle clockwise

            set x [expr {$x - $Ox}]             ;# Shift to origin
            set y [expr {$y - $Oy}]

            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}]
            lappend xy $xx $yy
        }
        $w coords $id $xy
    }
 }
 
 ################################################################
 #
 # 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

----
For use with animations, speed is an issue. Especially for use in mobile systems without floating point processor.
For this purpose, goniometrics could be replaced by look-ups with 5 entries (1-5 degrees, beyond 5 with gonio).
However, the simple improvement below may be sufficient and halves execution time (measured with ARM9 system, w/o FPU) - [RJM].
 # First improvement step: goniometrics out of loop
 proc object_rotate {w tag Ox Oy angle} {
    #foreach {Ox Oy} [object_center $w $tag] break
    set angle [expr {$angle * atan(1) / 45.0}] ;# Radians
    set sin [expr {sin($angle)}]
    set cos [expr {cos($angle)}]
    foreach id [$w find withtag $tag] {     ;# Do each component separately
        set xy {}
        foreach {x y} [$w coords $id] {
            # rotates vector (Ox,Oy)->(x,y) by angle clockwise
            set x [expr {$x - $Ox}]             ;# Shift to origin
            set y [expr {$y - $Oy}]
            set xx [expr {$x * $cos - $y * $sin + $Ox}] ;# Rotate and shift back
            set yy [expr {$x * $sin + $y * $cos + $Oy}]
            lappend xy $xx $yy
        }
        $w coords $id $xy
    }
 }

----








=====

----
***Screenshots***





[http://farm2.static.flickr.com/1283/4688001966_1ddc11ef43.jpg]





       


[gold] added pix 

----










======
----

***Screenshots***







[http://farm5.static.flickr.com/4033/4690372933_cab9267ef2.jpg]







       


[gold] added pix 

----









----
!!!!!!
%| [Category Graphics] |%
!!!!!!