image put est lent!

 

Kroc 08/09/2005 - En utilisant la version 8.5a2 de Tclkit, je me suis rendu compte que la commande image put est beaucoup plus lente qu'avec les versions 8.4 de Tk ou Tclkit, surtout sous Windows. Voici un petit script qui le démontre bien :

  package require Tk
  package require Img
  set notwin [catch {console show}]

  # Create a white pixmap to plot data on:
  image create photo capture -width 600 -height 600
  capture put white -to 0 0 600 600

  # Dessinne un cercle sur une image :
  proc oval2cap { coords width L H } {
    set piS2 [expr {2.05 * atan(1)}]
    set a [expr {([lindex $coords 0]+[lindex $coords 2])/2.0}]
    set b [expr {([lindex $coords 1]+[lindex $coords 3])/2.0}]
    set rmax [expr {[lindex $coords 2]-$a}]
    set rmin [expr {$rmax-$width}]
    set step [expr {1.0/$rmax}]
    for {set alpha 0} {$alpha <= $piS2} {set alpha [expr {$alpha+$step}]} {
      for {set R $rmin} {$R <= $rmax} {set R [expr {$R+0.5}]} {
        set x1 [expr {round($a+($R*cos($alpha)))}]
        set y1 [expr {round($b+($R*sin($alpha)))}]
        set x2 [expr {round($a-($x1-$a))}]
        set y2 [expr {round($b-($y1-$b))}]
        foreach x "$x1 $x2 $x1 $x2" y "$y1 $y2 $y2 $y1" {
          if {$x >= 0 && $y >= 0 && $x < $L && $y < $H} {
            capture put black -to $x $y
          }
        }
      }
    }
  }

  # On mesure le temps nécessaire pour 2 cercles :
  set t1 [time "oval2cap {27 27 568 568} 1 600 600"]
  set t2 [time "oval2cap {252 252 346 346} 12 600 600"]
  set tot [expr {[lindex $t1 0]+[lindex $t2 0]}]

  # Puis on affiche les resultats :
  puts "\n\
      Resultats avec Tk [info patchlevel]:\n\
      t1 (1er cercle) = $t1\n\
      t2 (2em cercle) = $t2\n\
      Total time used = $tot microseconds per iteration\n"

  if {$notwin} { exit }

Test réalisés sous Windows XP (avec Dell Inspiron 510m) : 8.5a2 est 170 plus lent que 8.4.11 !!

 Resultats avec Tk 8.4.11:
 t1 (1er cercle) = 77309 microseconds per iteration
 t2 (2em cercle) = 111137 microseconds per iteration
 Total time used = 188446 microseconds per iteration

 Resultats avec Tk 8.5a2:
 t1 (1er cercle) = 13049618 microseconds per iteration
 t2 (2em cercle) = 18949436 microseconds per iteration
 Total time used = 31999054 microseconds per iteration

En attendant que les choses s'améliorent, voici un moyen de contourner le problème en travaillant sur une liste de liste dont on fera une image XPM :

  package require Tk
  package require Img
  set notwin [catch {console show}]

  # Creation d'une image blanche :
  image create photo capture -width 600 -height 600
  capture put white -to 0 0 600 600

    # Convertion en image :
    proc xpmdata2tkimage { data couleur tkimage } {
    set hauteur [llength $data]
    set largeur [llength [lindex $data 0]]
    set xpm "/* XPM */\nstatic char * InlineData[] = {\n"
      append xpm "\"$largeur $hauteur 2 1\",\n"
      append xpm "\"# c none\",\n"
      append xpm "\". c $couleur\",\n"
      foreach ligne $data {
        append xpm "\"[join $ligne {}]\",\n"
      }
      set xpm "[string range $xpm 0 end-2]};"
    return [catch {image create photo $tkimage -data $xpm}]
  }

  # Dessinne un cercle sur une image :
  proc oval2cap { coords width L H } {
    set data {}
    for {set lig 0} {$lig < $L} {incr lig} {
      append data " {[string repeat "# " $H]}"
    }
    set piS2 [expr {2.05 * atan(1)}]
    set a [expr {([lindex $coords 0]+[lindex $coords 2])/2.0}]
    set b [expr {([lindex $coords 1]+[lindex $coords 3])/2.0}]
    set rmax [expr {[lindex $coords 2]-$a}]
    set rmin [expr {$rmax-$width}]
    set step [expr {1.0/$rmax}]
    for {set alpha 0} {$alpha <= $piS2} {set alpha [expr {$alpha+$step}]} {
      for {set R $rmin} {$R <= $rmax} {set R [expr {$R+0.5}]} {
        set x1 [expr {round($a+($R*cos($alpha)))}]
        set y1 [expr {round($b+($R*sin($alpha)))}]
        set x2 [expr {round($a-($x1-$a))}]
        set y2 [expr {round($b-($y1-$b))}]
        foreach x "$x1 $x2 $x1 $x2" y "$y1 $y2 $y2 $y1" {
          if {$x >= 0 && $y >= 0 && $x < $L && $y < $H} {
            lset data $x $y .
          }
        }
      }
    }
    xpmdata2tkimage $data #000000 capture
  }

  # On mesure le temps nécessaire pour 2 cercles :
  set t1 [time "oval2cap {27 27 568 568} 1 600 600"]
  set t2 [time "oval2cap {252 252 346 346} 12 600 600"]
  set tot [expr {[lindex $t1 0]+[lindex $t2 0]}]

  # Puis on affiche les resultats :
  puts "\n\
      Resultats avec Tk [info patchlevel]:\n\
      t1 (1er cercle) = $t1\n\
      t2 (2em cercle) = $t2\n\
      Total time used = $tot microseconds per iteration\n"

  if {$notwin} { exit }

Test réalisés sous Windows XP (avec Dell Inspiron 510m) :

 Resultats avec Tk 8.4.11:
 t1 (1er cercle) = 2961328 microseconds per iteration
 t2 (2em cercle) = 824589 microseconds per iteration
 Total time used = 3785917 microseconds per iteration

 Resultats avec Tk 8.5a2:
 t1 (1er cercle) = 2965671 microseconds per iteration
 t2 (2em cercle) = 832938 microseconds per iteration
 Total time used = 3798609 microseconds per iteration

Voilà, tout en restant moins rapide que la première méthode avec 8.4.11, cette méthode est déjà 8 fois plus rapide que la précédente sous 8.5a2.