ulis, 2005-09-11. Une procédure pour tourner une image (avec gestion de la transparence).
mise à jour du 2005-09-13 :
On peut trouver des algorithmes plus rapides et/ou plus précis. Mais c'est plus compliqué.
Pourquoi
C'est le seul algorithme important de traitement d'image pour lequel je n'avais pas de traitement en Tcl.
Ça a fini par me manquer.
Comment ça marche
Pour chaque point de la nouvelle image on copie le point de l'ancienne image.
Pour trouver l'ancien point il suffit de faire une rotation inverse.
On a donc :
old_x - old_center_x = +(new_x - new_center_x) * cos(-angle) + (new_y - new_center_y) * sin(-angle) old_y - old_center_y = -(new_x - new_center_x) * sin(-angle) + (new_y - new_center_y) * cos(-angle)
La procédure
# rotate proc # ----------- # create a rotated image # ----------- # in : input image # out : output image name # angle : angle in degrees # xc, yc : facultative center coordinates proc rotate {in out angle {xc ""} {yc ""}} \ { # xi = + (x - s/2) * cos(-a) + (y - s/2) * sin(-a) + xc # yi = - (x - s/2) * sin(-a) + (y - s/2) * cos(-a) + yc set width [image width $in] set height [image height $in] set w2 [expr {$width / 2}] set h2 [expr {$height / 2}] if {$xc == ""} { set xc $w2 } if {$yc == ""} { set yc $h2 } set ww [expr {abs($width - $xc)}] if {$ww < $xc} { set ww $xc } set hh [expr {abs($height - $yc)}] if {$hh < $yc} { set hh $yc } set size [expr {round(sqrt($ww*$ww+$hh*$hh))}] set sx2 [expr {$size * 2}] set $out [image create photo -width $sx2 -height $sx2] set pi2 [expr {acos(0)}] set alpha [expr {$angle * $pi2 / 90.0}] set cos [expr {cos(-$alpha)}] set sin [expr {sin(-$alpha)}] for {set y 0} {$y < $sx2} {incr y} \ { for {set x 0} {$x < $sx2} {incr x} \ { set x1 [expr {$x - $size}] set y1 [expr {$y - $size}] set x0 [expr {round(+$x1 * $cos + $y1 * $sin + $xc)}] set y0 [expr {round(-$x1 * $sin + $y1 * $cos + $yc)}] if {$x0 >= 0 && $x0 < $width && $y0 >= 0 && $y0 < $height} \ { if {![$in transparency get $x0 $y0]} \ { set col [eval format #%2.2x%2.2x%2.2x [$in get $x0 $y0]] [set $out] put $col -to $x $y } } } } }
Le test
(attachez vos cheveux !)
# rotating color_image2.png # (download here: http://www.images.com/color_image2.png) # packages package require Tk catch { package require Img } # parameters set image color_image2.png set xc 25 set yc 25 # display interface wm title . rotate image create photo _img_ -file $image set width [image width _img_] set height [image height _img_] set w2 [expr {$width / 2}] set h2 [expr {$height / 2}] set ww [expr {abs($width - $xc)}] if {$ww < $xc} { set ww $xc } set hh [expr {abs($height - $yc)}] if {$hh < $yc} { set hh $yc } set size [expr {round(sqrt($ww*$ww+$hh*$hh))}] set sx2 [expr {$size * 2}] canvas .c -width $sx2 -height $sx2 .c create image $size $size -tags img pack .c raise . focus -force . # images for {set a 0} {$a < 360} {incr a 15} \ { rotate _img_ ::out($a) $a $xc $yc .c itemconfig img -image $::out($a) update } # step proc proc step {a} \ { .c itemconfig img -image $::out($a) incr a 15 if {$a == 360} { set a 0 } after 40 step $a } # animate step 0
Voir aussi
(à compléter)
Discussion
Catégorie Exemple | Catégorie Traitement d'image