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
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} {
#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
[dntwiki] - 2011-04-17 23:49:20The 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)}]
