Canvas Rotation
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} {
lassign [$w coords $item] x0 y0 x1 y1
$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} {
lassign [$w bbox $tagOrId] x1 y1 x2 y2
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
lassign [Anchor .c poly $::anchor] x y
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 {} {
lassign [Anchor .c anchor c] Ox Oy;# 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
ResetFor 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} {
#lassign [object_center $w $tag] Ox Oy
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
gold added pix
dntwiki - 2011-04-17 23:49:20
The side effect is due to the screen-Y pointing downwards. Use this rotation to get the right rotation direction, i.e counterclockwise for positive angles and clockwise for negative ones.
set xx [expr {$x * cos($ang) + $y * sin($ang)}]
set yy [expr {-$x * sin($ang) + $y * cos($ang)}]