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
 }

 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"

 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
 }