Version 13 of Quick photo rotation

Updated 2012-03-30 03:31:14 by RLE

Richard Suchenwirth 2004-09-28 - Here's code for photo image rotation by +90 or -90 degrees only, but it runs reasonably fast:

 proc imgrot90 {img {clockwise 0}} {
    set w [image width $img]
    set h [image height $img]
    set matrix [string repeat "{[string repeat {0 } $h]} " $w]
    if $clockwise {
        set x0 0; set y [expr {$h-1}]; set dx 1; set dy -1 
    } else {
        set x0 [expr {$w-1}]; set y 0; set dx -1; set dy 1 
    }
    foreach row [$img data] {
        set x $x0
        foreach pixel $row {
            lset matrix $x $y $pixel
            incr x $dx
        }
        incr y $dy
    }
    set im2 [image create photo -width $h -height $w]
    $im2 put $matrix
    set im2
 }

WikiDbImage rotext.jpg

RS 2006-04-25: One frequently-asked-for feature is rotation of text, which can be done with the above code, plus the following:

 proc rotext {w x y text args} {
    package require Img
    raise [toplevel .tt]
    pack [eval [list label .tt.l -text $text] $args]
    update idletasks
    set i0 [image create photo -data .tt.l]
    destroy .tt
    $w create image $x $y -image [imgrot90 $i0]
    image delete $i0
 }
 #--Testing demo, usage example:
 pack [canvas .c -width 100 -height 80]
 update idletasks ;# to prevent occasional loss of the first item
 rotext .c 20 50 "Hello" -fg red -font {Courier 11}
 rotext .c 50 50 "vertical world"

KPV asked for rotation with transparent background (just like text items on canvas normally are). My solution is to copy pixels only if their colors differs from a specified "background" color:

 proc imgrot90t {img {clockwise 0} {bg {255 255 255}}} {
    set w [image width $img]
    set h [image height $img]
    set im2 [image create photo -width $h -height $w]
    for {set i 0} {$i<$h} {incr i} {
         for {set j 0} {$j<$w} {incr j} {
             if $clockwise {
                 set color [$img get $j [expr {$h-$i-1}]]
             } else {
                 set color [$img get [expr {$w-$j-1}] $i]
             }
             if {$color ne $bg} {
                 $im2 put [eval format #%02x%02x%02x $color] -to $i $j
             }
         }
    }
    set im2
 }

Just change imgrot90 in rotext to imgrot90t, and give the desired items -bg white (which in photo terms is reported as {255 255 255}), or modify accordingly ... :)