[http://mini.net/files/imgrot.jpg] ---- [Richard Suchenwirth] 2002-09-08 - After [GPS] started [Rotating a Tk photo image] in the Wiki, and after some [Tcl chatroom] discussions with [dkf] and [kennykb], here now is my shot at rotating [photo] images. The simple cases are handled especially fast: 180 degrees (upside-down) by just subsampling with factors -1 (which means mirroring - in just about no time); +/- 90 degrees by inverting the pixel matrix (which goes in 2.6 seconds on my box). Other angles have to be handled pedestrianly by bi-linear interpolation (averaging the r-g-b values of four neighboring original pixels, weighted by nearness), which takes around 15..17 sec on my P200/W95 box. Therefore, coding these algorithms in C is still highly recommended - but I just wanted to know how it can be done in [pure-Tcl] ;-) On my 833MHz box at work, the "slow" rotation took about 2 seconds, which comes closer to usability - and modern CPUs are more than double that fast... As usual, this page ends in a demo, where you see the 68*100 pixels Tcl logo twice - original and rotated, can enter an angle (counter-clockwise, 0..360) and make it run with . The time needed for a rotation is displayed in the title-bar. Care was taken to leave pixels "out of the picture" transparent in the rotated image. You can also choose to let the rotated image update after every row, or wait for the final product. } proc image'rotate {img angle} { if $angle { set w [image width $img] set h [image height $img] set tmp [image create photo] $tmp copy $img $img blank set buf {} switch -- $angle { 90 { for {set i [expr {$w-1}]} {$i>=0} {incr i -1} { set rowbuf {} for {set j 0} {$j < $h} {incr j} { foreach {r g b} [$tmp get $i $j] break lappend rowbuf [format #%02x%02x%02x $r $g $b] } lappend buf $rowbuf } $img config -width $h -height $w $img put $buf } 180 - -180 {$img copy $tmp -subsample -1 -1} 270 - -90 { for {set i 0} {$i<$w} {incr i} { set rowbuf {} for {set j [expr {$h-1}]} {$j>=0} {incr j -1} { foreach {r g b} [$tmp get $i $j] break lappend rowbuf [format #%02x%02x%02x $r $g $b] } lappend buf $rowbuf } $img config -width $h -height $w $img put $buf } default { set a [expr {atan(1)*8*$angle/360.}] set xm [expr {$w/2.}] set ym [expr {$h/2.}] set w2 [expr {round(abs($w*cos($a)) + abs($h*sin($a)))}] set xm2 [expr {$w2/2.}] set h2 [expr {round(abs($h*cos($a)) + abs($w*sin($a)))}] set ym2 [expr {$h2/2.}] $img config -width $w2 -height $h2 for {set i 0} {$i<$h2} {incr i} { set toX -1 for {set j 0} {$j<$w2} {incr j} { set rad [expr {hypot($ym2-$i,$xm2-$j)}] set th [expr {atan2($ym2-$i,$xm2-$j)+$a}] set x [expr {$xm-$rad*cos($th)}] if {$x < 0 || $x >= $w} continue set y [expr {$ym-$rad*sin($th)}] if {$y < 0 || $y >= $h} continue set x0 [expr {int($x)}] set x1 [expr {($x0+1)<$w? $x0+1: $x0}] set dx [expr {$x1-$x}] set y0 [expr {int($y)}] set y1 [expr {($y0+1)<$h? $y0+1: $y0}] set dy [expr {$y1-$y}] set R 0; set G 0; set B 0 foreach {r g b} [$tmp get $x0 $y0] { set R [expr {$R+$r*$dx*$dy}] set G [expr {$G+$g*$dx*$dy}] set B [expr {$B+$b*$dx*$dy}] } foreach {r g b} [$tmp get $x0 $y1] { set R [expr {$R+$r*$dx*(1.-$dy)}] set G [expr {$G+$g*$dx*(1.-$dy)}] set B [expr {$B+$b*$dx*(1.-$dy)}] } foreach {r g b} [$tmp get $x1 $y0] { set R [expr {$R+$r*(1.-$dx)*$dy}] set G [expr {$G+$g*(1.-$dx)*$dy}] set B [expr {$B+$b*(1.-$dx)*$dy}] } foreach {r g b} [$tmp get $x1 $y1] { set R [expr {$R+$r*(1.-$dx)*(1.-$dy)}] set G [expr {$G+$g*(1.-$dx)*(1.-$dy)}] set B [expr {$B+$b*(1.-$dx)*(1.-$dy)}] } set r [expr {round($R)}] set g [expr {round($G)}] set b [expr {round($B)}] lappend buf [format #%02x%02x%02x $r $g $b] if {$toX == -1} {set toX $j} } if {$toX>=0} { $img put [list $buf] -to $toX $i set buf {} if $::update update } } } } image delete $tmp } } #---------------------------------- testing demo: if {[file tail [info script]] == [file tail $argv0]} { pack [canvas .c -height 160 -width 250] #---assume standard installation paths: set sample [file join [lindex $auto_path 2] images logo100.gif] set im [image create photo -file $sample] set im2 [image create photo] $im2 copy $im .c create image 50 90 -image $im .c create image 170 90 -image $im2 entry .c.e -textvar angle -width 4 set angle 99 bind .c.e { $im2 config -width [image width $im] -height [image height $im] $im2 copy $im wm title . [time {image'rotate $im2 $::angle}] } .c create window 5 5 -window .c.e -anchor nw checkbutton .c.cb -text Update -variable update set ::update 1 .c create window 40 5 -window .c.cb -anchor nw bind . {exec wish $argv0 &; exit} } ---- There seems to be a bug with the code above. I get this error message when I run it with 5 degrees of rotation: domain error: argument not in valid range domain error: argument not in valid range while executing "expr {atan2($ym2-$i,$xm2-$j)+$a}" ("default" arm line 14) invoked from within "switch -- $angle { 90 { for {set i [expr {$w-1}]} {$i>=0} {incr i -1} { set rowbuf {} ..." (procedure "image'rotate" line 9) invoked from within "image'rotate $im2 $::angle" invoked from within "time {image'rotate $im2 $::angle}" invoked from within "wm title . [time {image'rotate $im2 $::angle}]" (command bound to event) ---- [RS]: The above Tcl code runs well on Win95 and Win2k, also at 5 degrees (or -5, 1, -1, ...). So I suspect it is the implementation-dependent limits of atan2 of the C runtime, which also on Solaris raises an (unjustified, IMO) error if both arguments are 0. Here is a workaround, to replace the ''atan2'' line, but better if this problem were handled inside the [expr] implementation: if {$ym2==$i && $xm2==$j} { set th $a } else { set th [expr {atan2($ym2-$i,$xm2-$j)+$a}] } Thanks for reporting!