Tourner une image

 

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