Audela
Audela |
|
Cette page fait suite à celle qui permet d'écrire l'interface test.tcl. Nous allons modifier ce script pour ajouter des fonctionnalités utiles pour visualiser et analyser les images affichées : barres de défilement, coordonnées du curseur, réglage des seuils de visualisation et draguer une fenêtre sur l'image.
Rappelons que les exemples de cette page font apparaître des éléments graphiques à des endroits précis de l'interface. Si vous désirez changer leur positionnement, référez vous chapitre du packer du cours d'Anne Possoz.
Nous allons décrire la marche à suivre pour ajouter les barres de défilement sur la zone image du script test.tcl :
La zone image comportera donc deux barres (appelées scrollbars en anglais) afin de pouvoir naviger sur l'ensemble de l'image. Ces barres ont un intérêt si l'image est plus grande que la zone d'affichage. Par exemple, afficher une image 768x512 dans la zone d'affichage de test.tcl n'est possible que si on a effectivement la présence des barres de défilement.
Sur le listing ci dessous, nous indiquons, en rouge, les lignes à rajouter dans le fichier test.tcl (les lignes restant intactes sont écrites en italique) :
#--- definition des couleurs
set color(back) #123456
set color(back_image) #000000
set color(scroll) #BBBBBB
# --- initialisation de variables de zone
set zone(naxis1) 0
set zone(naxis2) 0
# --- charge des proc utilitaires pour Tk
source tkutil.tcl
#--- cache la fenetre racine
wm withdraw .
On définit une couleur grise correspondant à la couleur des barres de défilement (#BBBBBB est un gris clair). Les deux variables de l'array zone, servent à définir le format de l'image affichée. Au départ, il n'y a pas d'image et donc le format est 0 sur chaque axe. La ligne 'source tkutil.tcl' va exécuter le script Tcl contenu dans le fichier tkutil.tcl. Nous décrirons en détail ce fichier plus loin. Il va ajouter la fonction Scrolled_Canvas qui permet de créer les barres de défilement presque automatiquement.
Toujours dans le fichier test.tcl, ajouter les lignes (rouges) suivantes :
#--- cree le bouton 'quitter'
button .test.frame1.but_exit \
-text $caption(exit) -borderwidth 4 \
-command { testexit }
pack .test.frame1.but_exit \
-in .test.frame1 -side left -anchor w \
-padx 3 -pady 3
set zone(exit) .test.frame1.but_exit
#--- cree le nouveau canevas pour l'image
Scrolled_Canvas .test.image1 -borderwidth 0 -relief flat \
-width 300 -height 200 -scrollregion {0 0 0 0} -cursor crosshair
pack .test.image1 \
-in .test -expand 1 -side top -anchor center -fill both
.test.image1.canvas configure -bg $color(back_image)
.test.image1.canvas configure -borderwidth 0
.test.image1.canvas configure -relief flat
.test.image1 configure -bg $color(scroll)
set zone(image1) .test.image1.canvas
#--- detruit la fenetre principale avec la croix en haut a droite
bind .test <Destroy> { destroy .test; exit }
Il s'agit ici de remplacer la définition originelle du canvas d'affichage par un ensemble de widgets définis par la fonction Scrolled_Canvas. Le widget .test.image1 n'est plus le canevas de l'image mais le support de ce canevas (maintenant appelé .test.image1.canvas) et aux barres de défilement (.test.image.xscroll et .test.image.yscroll définies dans la fonction Scrolled_Canvas du fichier tkutil.tcl). Noter que, parmi les options de la fonction Scrolled_Canvas, on trouve -cursor crosshair. Ceci permet d'avoir un curseur de forme de croix lorsque l'on place la souris sur la zone image. Enfin, .test.image1.canvas configure, permet de modifier et d'ajouter des attributs au canevas d'affichage de l'image.
Enfin, il faut modifier les fonctions d'affichage de l'image. visu1 disp ne suffit plus car il faut aussi reconfigurer la dimension des barres de défilement si la taille de l'image a changé. Nous allons donc créer une nouvelle fonction 'testvisu' afin de rassembler ces opérations. Il conviendra aussi de remplacer les appels à la fonction 'visu1 disp' par 'testvisu' dans les fonctions 'testacq' et 'testload' :
proc testacq { } {
#--- acquisition de l'image
cam1 exptime 15
cam1 bin {2 2}
cam1 acq
vwait status_cam1
#--- statistiques pour calculer les seuils de visu
set mystatistics [buf1 stat]
set mycuts [lrange $mystatistics 0 1]
#--- seuils de visu et affichage
visu1 cut $mycuts
testvisu
}
proc testload { } {
global caption
set filename [tk_getOpenFile -title $caption(load) \
-filetypes {{{Images FITS} {.fit}}} \
-initialdir .. ]
if {$filename!=""} {
buf1 load $filename
testvisu
}
}
proc testvisu { } {
global zone
set zone(naxis1) [lindex [buf1 getkwd NAXIS1] 1]
set zone(naxis2) [lindex [buf1 getkwd NAXIS2] 1]
$zone(image1) configure -scrollregion [list 0 0 $zone(naxis1) $zone(naxis2)]
visu1 disp
}
Un nouveau fichier texte, appelé tkutil.tcl qui va contenir des fonctions utilitaires généralistes pour le graphisme. Ce fichier existe déjà dans le dossier test de la version de distribution de Audela. Le fichier tkutil.tcl doit être placé dans le même dossier que test.tcl. Pour le moment, ce fichier va contenir la seule fonction Scrolled_Canvas :
#
# Scrolled_Canvas --
# Cree un canvas scrollable, ainsi que les deux scrollbars
# pour le deplacer.
# ref: Brent Welsh, Practical Programming in TCL/TK, rev.2, page 392
#
proc Scrolled_Canvas { c args } {
frame $c
eval {canvas $c.canvas \
-xscrollcommand [list $c.xscroll set] \
-yscrollcommand [list $c.yscroll set] \
-highlightthickness 0 \
-borderwidth 0} $args
scrollbar $c.xscroll -orient horizontal -command [list $c.canvas xview]
scrollbar $c.yscroll -orient vertical -command [list $c.canvas yview]
grid $c.canvas $c.yscroll -sticky news
grid $c.xscroll -sticky ew
grid rowconfigure $c 0 -weight 1
grid columnconfigure $c 0 -weight 1
return $c.canvas
}
La fonction Scrolled_Canvas a été reprise telle qu'elle est écrite dans l'excellent livre de Brent Welsh, consacré au Tcl/Tk. On peut la voir comme une macro qui crée le canevas d'affichage avec les options définies par le paramètre d'entrée 'args' (c'est une liste d'options de canvas) et qui créé deux barres de défilement (scrollbar). Dans cette fonction, il convient de noter que la variable 'c' ($c) contient le nom du widget parent : .test.image1 dans notre cas. Les barres de défilement sont des widgets de type scrollbar. L'une est horizontale ($c.xcroll, c'est à dire, en clair, .test.image1.xscroll) et l'autre est verticale (.test.image1.yscroll).
Pour que le canvas d'affichage .test.image1.canvas puisse monter ou descendre en fonction de la position de l'ascenseur de la barre de défilement, le scrollbar .test.image1.yscroll appelle la commande 'yview' qui s'applique à .test.image1. Cette commande établit le lien entre la position de l'ascenseur et la partie visible de l'image dans le canvas. Même chose pour l'ascenseur horizontal.
La fonction grid, permet d'arranger les widgets concernés en ligne et en colonne dans une fenêtre "maître". Consulter la documentation de Tk pour plus de précision.
L'imagerie numérique permet d'avoir une image codée par des nombres. Il est souvent utile de connaître la valeur de certains pixels. La façon la plus rapide est de balader la souris sur l'image et de faire afficher la valeur du pixel sous le curseur. Rappelons que lors de la création des barres de défilement, nous avons choisi de transformer l'aspect du curseur de la souris sous la forme d'une croix, afin de bien pointer le pixel à mesurer.
Sur le listing ci dessous, nous indiquons, en rouge, les lignes à rajouter dans le fichier test.tcl :
#--- execute une commande a partir de la ligne de commande
bind $zone(command_line) <Key-Return> {
set resultat [eval $command_line]
if { [string compare $resultat ""] != 0 } {
$zone(status_list) insert end "$resultat"
}
set $command_line ""
}
# --- affiche la valeur du pixel pointe dans l'image
bind $zone(image1) <Motion> {
global zone
# --- Transforme les coordonnees de la souris (%x,%y) en coordonnees canvas (x,y)
set xy [screen2Canvas [list %x %y]]
# --- Transforme les coordonnees canvas (x,y) en coordonnees image (xi,yi)
set xyi [canvas2Picture $xy]
set xi [lindex $xyi 0]
set yi [lindex $xyi 1]
# --- Intens contiendra l'intensite du pixel pointe
set intens -
catch {set intens [buf1 getpix [list $xi $yi]]}
# --- Affichage des coordonnees
wm title .test "($xi,$yi)=$intens "
}
#--- declare un buffer pour placer les images en mémoire
buf::create 1
Le pixel, pointé par la souris, est repéré par une liaison (binding) avec le mouvement de la souris (<Motion>) dans le canevas de l'image $zone(image1), c'est à dire le widget de type canvas qui porte le nom .test.image1.canvas. Si la souris se trouve dans ce canevas, on entre dans l'exécution des commandes du binding. Les coordonnées de la souris sont dans les variables %x et %y (ces deux variables "spéciales" sont toujours associées aux bindings relatif à la souris). Comme l'image peut avoir subie un scroll, la fonction screen2Canvas permet donc de convertir les coordonnées de la souris dans le système de coordonnées écran du widget affiché (%x,%y) vers les coordonnées correspondantes (x,y) dans le canvas. La fonction screen2Canvas va être définie dans le fichier tkutil.tcl.
Par définition des images informatiques, les coordonnées (0,0) sont en haut à gauche alors que la définition (0,0) des images astronomiques est en bas à gauche. La fonction canvas2Picture permet donc de convertir les coordonnées de l'image canvas (x,y) vers les coordonnées correspondantes (xi,yi) de l'image dans le buffer 1. La fonction canvas2Picture va être définie dans le fichier tkutil.tcl.
La fonction 'buf1 getpix' permet de lire la valeur numérique associée au pixel de coordonnées (xi,yi). Si les coordonnées (xi,yi) dépassent les limites de l'image, la fonction 'buf1 getpix' retourne une erreur. Il faut donc détourner le message d'erreur pour éviter qu'il ne s'affiche à l'écran et qu'il arrête le programme. C'est le rôle de la fonction Tcl catch.
Le message d'information, contenant la valeur du pixel, est affiché dans la barre de titre de la fenêtre principale de test.tcl. Les images pouvant être codées avec des nombres à virgule, nous affichons tous les chiffres de la valeur de l'intensité. toutefois, si l'on ne veut afficher que la partie entière, on remplacera la dernière ligne par :
wm title .test "($xi,$yi)=[format "%d" $intens] "
La commande Tcl format transforme une chaîne de caractères en une autre formatée par un symbole spécial. Ici le symbole %d singifie de garder la partie entière. Le symbole %8.2f signifierait de garder 8 chiffres significatifs et de placer 2 chiffres après la virgule. La liste de ces symboles est identique à la syntaxe de la fonction printf du langage C.
Ouvrir le fichier texte tkutil.tcl (créé précédemment) et ajouter les lignes suivantes après la fonction Scrolled_Canvas :
#
# Transforme des coordonnees ecran en coordonnees canvas. L'argument
# est une liste de deux entiers, et retourne également une liste de
# deux entiers.
#
proc screen2Canvas {coord} {
global zone
set x [$zone(image1) canvasx [lindex $coord 0]]
set y [$zone(image1) canvasy [lindex $coord 1]]
return [list $x $y]
}
Les fonctions canvasx et canvasy permettent de retourner les positions absolues (x,y) du pixel pointé dans le canevas.
#
# Transforme des coordonnees canvas en coordonnees image. L'argument
# est une liste de deux entiers, et retourne également une liste de
# deux entiers.
#
proc canvas2Picture {coord} {
global zone
set xx [expr [lindex $coord 0] + 1]
set point [string first . $xx]
if {$point!=-1} {
set xx [string range $xx 0 [incr point -1]]
}
set yy [expr $zone(naxis2) - [lindex $coord 1]]
set point [string first . $yy]
if {$point!=-1} {
set yy [string range $yy 0 [incr point -1]]
}
return [list $xx $yy]
}
Cette fonction convertit automatiquement les coordonnées en nombres entiers. "string first . $xx" recherche la première occurrence "." dans la chaîne de caractères contenue dans la variable "xx". La fonction retourne -1 si l'occurrence n'est pas trouvée, sinon elle retourne l'indice de l'occurrence dans la chaîne. Dans ce dernier cas, on ne garde uniquement que les caractères précédent strictement le point ".".
Le réglage de la luminosité et du contraste des images se réalise avec deux barres de réglages. L'usage, pour les images astronomiques, veut que l'on utilise les seuils bas et haut pour définir les pixels respectivement colorés en noir et en blanc. Les pixels de valeur intermédiaire entre les seuil bas et haut sont grisés de plus en plus clair a mesure que l'on se rapproche du seuil haut. Nous allons donc créer deux glissières (scales) qui permettent de régler les seuils bas (à gauche) et haut (à droite) :
Sur le listing ci dessous, nous indiquons, en rouge, les lignes à rajouter dans le fichier test.tcl :
#--- cree le bouton 'quitter'
button .test.frame1.but_exit \
-text $caption(exit) -borderwidth 4 \
-command { testexit }
pack .test.frame1.but_exit \
-in .test.frame1 -side left -anchor w \
-padx 3 -pady 3
set zone(exit) .test.frame1.but_exit
#--- cree un frame pour y mettre des glissieres
frame .test.frame2 \
-borderwidth 0 -cursor arrow -bg $color(back)
pack .test.frame2 \
-in .test -anchor s -side bottom -expand 0 -fill x
# --- cree la glissiere de seuil bas
scale .test.frame2.sca1 -orient horizontal -from 0 -to 32767 -length 200 \
-borderwidth 1 -showvalue 0 -width 10 -sliderlength 20 \
-troughcolor $color(back) -background $color(back) \
-relief raised -activebackground $color(back) -command changeLoCut1
pack .test.frame2.sca1 \
-in .test.frame2 -anchor s -side left -expand 0 -padx 10 -pady 3
set zone(sb1) .test.frame2.sca1
# --- cree la glissiere de seuil haut
scale .test.frame2.sca2 -orient horizontal -from 0 -to 32767 -length 200 \
-borderwidth 1 -showvalue 0 -width 10 -sliderlength 20 \
-troughcolor $color(back) -background $color(back) \
-relief raised -activebackground $color(back) -command changeHiCut1
pack .test.frame2.sca2 \
-in .test.frame2 -anchor s -side right -expand 0 -padx 10 -pady 3
set zone(sh1) .test.frame2.sca2
#--- cree le nouveau canevas pour l'image
Scrolled_Canvas .test.image1 -borderwidth 0 -relief flat \
Le frame .test.frame2 va accueillir les deux glissières. Ces glissières sont crées comme des widgets de type scale. Leurs nom de widget sont assignées dans les variables globales zone(sb1) pour le seuil bas et zone(sh1) pour le seuil haut. Il est important de noter que l'action sur les glissières appelle les fonctions changeLoCut1 et changeHiCut1 qui vont être définies dans le fichier tkutil.tcl. Ces fonctions changent les valeurs des seuils mais n'affichent pas l'image. On souhaite afficher l'image seulement lorsque l'on relâche le pointeur de souris de la glissière. Il faut donc ajouter des liaisons sur les événements de type <ButtonRelease> associés aux glissières :
#--- detruit la fenetre principale avec la croix en haut a droite
bind .test <Destroy> { destroy .test; exit }
# --- re-affiche l'image si on relache les curseurs des glissieres
bind $zone(sh1) <ButtonRelease> {catch {visu1 disp}}
bind $zone(sb1) <ButtonRelease> {catch {visu1 disp}}
#--- execute une commande a partir de la ligne de commande
bind $zone(command_line) <Key-Return> {
set resultat [eval $command_line]
La fonction catch permet de détourner le message d'erreur éventuel et continuer le déroulement normal du script.
Lorsqu'une image est visualisée, suite à une acquisition ou a un chargement, il faut actualiser la position des curseurs sur les glissières des barres de seuil. Il faut donc ajouter des lignes dans la fonction testvisu :
proc testvisu { } {
global zone
set zone(naxis1) [lindex [buf1 getkwd NAXIS1] 1]
set zone(naxis2) [lindex [buf1 getkwd NAXIS2] 1]
$zone(image1) configure -scrollregion [list 0 0 $zone(naxis1) $zone(naxis2)]
visu1 disp
# --- place les curseurs des barres de seuil au bon endroit
set shb [testgetseuils]
$zone(sb1) set [lindex $shb 1]
$zone(sh1) set [lindex $shb 0]
# --- definit les limites de seuils bas et haut.
set hi [buf1 getkwd MIPS-HI]
set lo [buf1 getkwd MIPS-LO]
buf1 stat
set maxi [lindex [buf1 getkwd DATAMAX] 1]
set mini [lindex [buf1 getkwd DATAMIN] 1]
set range [expr $maxi-$mini]
set mini [expr $mini-$range]
set maxi [expr $maxi+$range]
$zone(sb1) configure -from $mini -to $maxi
$zone(sh1) configure -from $mini -to $maxi
if {[lindex $hi 1]!=""} {buf1 setkwd $hi }
if {[lindex $lo 1]!=""} {buf1 setkwd $lo }
}
proc testgetseuils { } {
# --- retourne un liste contenant le seuil haut et bas de l'image
global zone
# --- on recherche la valeur du mot cle MIPS-HI
set hi [lindex [buf1 getkwd MIPS-HI] 1]
if {$hi==""} {
# --- sinon on recherche la valeur du mot cle DATAMAX
set hi [lindex [buf1 getkwd DATAMAX] 1]
}
if {$hi==""} {
# --- sinon on fait une stat sur l'image
buf1 stat
set hi [lindex [buf1 getkwd MIPS-HI] 1]
set lo [lindex [buf1 getkwd MIPS-LO] 1]
}
# --- on recherche la valeur du mot cle MIPS-LO
set lo [lindex [buf1 getkwd MIPS-LO] 1]
if {$lo==""} {
# --- sinon on recherche la valeur du mot cle DATAMIN
set lo [lindex [buf1 getkwd DATAMIN] 1]
}
if {$lo==""} {
set lo 0
}
return [list $hi $lo]
}
La fonction testvisu comprend deux nouvelles parties. La première place les curseurs des barres de seuil au bon endroit. La seconde partie redimensionne les valeurs limites (mini,maxi) des barres de seuils. Ces valeurs sont calculées de façon à pouvoir effectuer des réglages fins dans l'étendue correspondant à la dynamique de l'image.
La fonction testgetseuils retourne la valeur des seuils haut et bas et les calculs si besoin est.
Ouvrir le fichier texte tkutil.tcl (crée précédemment) et ajouter les lignes suivantes à la fin du fichier :
#
# Nouvelle valeur de seuil haut
#
proc changeHiCut1 {foo} {
set sbh [visu1 cut]
visu1 cut [list $foo [lindex $sbh 1]]
}
#
# Nouvelle valeur de seuil bas
#
proc changeLoCut1 {foo} {
set sbh [visu1 cut]
visu1 cut [list [lindex $sbh 0] $foo]
}
Ces deux fonctions permettent d'enregistrer les nouvelles valeurs de seuils de l'image en fonction des valeurs retournées par la position des curseurs dans les widgets scale.
Il est très utile de pouvoir dessiner un cadre sur l'image affichée afin de définir une zone dans laquelle sera effectuée une analyse : largeur d'une étoile, statistiques locales, etc.
Ajouter la définition d'une nouvelle variable globale
infos
au début de test.tcl :
#--- definition des variables globales (arrays)
global caption
global color
global zone
global infos
# --- initialisation de variables d'infos
set infos(MouseState) rien
set infos(box) {1 1 1 1}
set infos(point) {1 1}
#--- description du texte a placer sur l'ecran
set caption(main_title) "test"
La variable info(MouseState) donne l'état actuel de la souris : rien (on n'est pas en train de draguer en cliquant) ou dragging (on est en train de draguer un cadre). La variable info(box) contient les coordonnées (x,y) de début et de fin de cadre sous forme d'une liste. C'est cette liste qui pourra être utilisée ultérieurement pour traiter des actions spécifiques à l'intérieur de ce cadre. Enfin, la variable infos(point) va contenir la liste des coordonnées (x,y) sur l'image du dernier point cliqué par la souris.
Il faut aussi définir la couleur du cadre qui va se superposer à l'image. Nous donnons ici l'exemple d'un cadre bleu (#0000EE signifie 00 00 EE où les deux premiers chiffres sont la composante rouge (00=zéro), les deux chiffres suivants sont la composante verte (00=zéro) et les deux derniers chiffres sont la composante rouge (EF=239 décimal). EE est une notation hexadécimale (base 16). Pour faire la conversion décimale, utiliser la règle suivante : remplacer les lettres A,B,C,D,E,F par 10,11,12,13,14,15 respectivement et appliquer la formule : E*16+F=14*16+15=239.
#--- definition des couleurs
set color(back) #123456
set color(back_image) #000000
set color(rectangle) #0000EF
Afin de pouvoir draguer un cadre sur l'image, il faut définir des liaisons associées aux événements de la souris avec la zone d'affichage de l'image. Il est évident qu'il y a trois types d'événements à gérer : l'appui sur le bouton gauche de la souris (ButtonPress-1) pour définir le début du cadre, le mouvement avec le bouton gauche appuyé (B1-Motion) pour dessiner le cadre sur l'image et pour commencer à draguer. Enfin le lâché du bouton gauche de la souris (ButtonRelease-1) pour terminer la définition du cadre. Pour gérer ces trois événements, nous allons ajouter les trois bindings correspondants (dans la partie du listing de test.tcl qui contient les bindings) :
#--- detruit la fenetre principale avec la croix en haut a droite
bind .test <Destroy> { destroy .test; exit }
bind $zone(image1) <ButtonPress-1> {
global infos
if { [string compare $infos(MouseState) rien] == 0 } {
set liste [screen2Canvas [list %x %y]]
if {[info exists zone(naxis1)]==1} {
if {[lindex $liste 0]<$zone(naxis1) && [lindex $liste 1]<$zone(naxis2)} {
boxBegin [list %x %y]
set infos(MouseState) dragging
}
}
} else {
if { [string compare $infos(MouseState) context] == 0 } {
#[MenuGet "$caption(audace,menu,analyse)"] unpost
set infos(MouseState) rien
}
}
}
bind $zone(image1) <B1-Motion> {
global infos
if { [string compare $infos(MouseState) dragging] == 0 } {
#--- Affichage des coordonnees
# displayCursorCoord [list %x %y]
#--- On n'oublie pas de dragger eventuellement la boite
boxDrag [list %x %y]
}
}
bind $zone(image1) <ButtonRelease-1> {
global infos
if { [string compare $infos(MouseState) dragging] == 0 } {
set infos(MouseState) rien
catch {boxEnd [list %x %y] }
}
}
Rappelons que la variable $zone(image1) correspond au canevas d'affichage de l'image.
Les bindings définis précédemment font appel à des fonctions qui doivent gérer le début, l'agrandissement et la fin du cadre à définir. C'est pour cela que nous présentons ces actions sous la forme des trois fonctions boxBegin, boxDrag et boxEnd. Ouvrir le fichier texte tkutil.tcl (crée précédemment) et ajouter les lignes suivantes à la fin du fichier :
#
# !! Les coordonnees coord sont des coordonnees canvas, et non ecran.
#
proc boxBegin {coord} {
global infos
catch {unset infos(box)}
set infos(box,1) [screen2Canvas $coord]
set infos(point) [canvas2Picture $infos(box,1)]
}
#
# !! Les coordonnees x et y sont des coordonnees canvas, et non ecran.
#
proc boxDrag {coord} {
global infos
global zone
global color
catch {$zone(image1) delete $infos(hBox)}
set x [lindex $coord 0]
if {$x<0} {set coord [lreplace $coord 0 0 0]}
if {$x>=$zone(naxis1)} {
set coord [lreplace $coord 0 0 [expr $zone(naxis1)-1]]
}
set y [lindex $coord 1]
if {$y<0} {set coord [lreplace $coord 1 1 0]}
if {$y>=$zone(naxis2)} {
set coord [lreplace $coord 1 1 [expr $zone(naxis2)-1]]
}
set infos(box,2) [screen2Canvas $coord]
set infos(hBox) [eval {$zone(image1) create rect} $infos(box,1) \
$infos(box,2) -outline $color(rectangle) -tag selBox]
}
#
# !! Les coordonnees x et y sont des coordonnees canvas, et non ecran.
#
proc boxEnd {coord} {
global infos
global zone
boxDrag $coord
if { $infos(box,1) == $infos(box,2)} {
catch {unset infos(box)}
$zone(image1) delete $infos(hBox)
} else {
set coord1 [canvas2Picture $infos(box,1)]
set coord2 [canvas2Picture $infos(box,2)]
set x1 [lindex $coord1 0]
set y1 [lindex $coord1 1]
set x2 [lindex $coord2 0]
set y2 [lindex $coord2 1]
if {$x1>$x2} {
set a $x1
set x1 $x2
set x2 $a
}
if {$y1>$y2} {
set a $y1
set y1 $y2
set y2 $a
}
catch {unset infos(box)}
set infos(box) [list $x1 $y1 $x2 $y2]
}
}
Ces trois fonctions appellent les fonctions canvas2Picture et screen2Canvas, définies dans la création d'un curseur image.
La fonction boxBegin, calcule la variable infos(box,1) qui contient la position du premier point cliqué par la souris. La fonction boxDrag, calcule la variable infos(box,2) qui contient la position du dernier point dragué par la souris. De plus, la fonction redessine un rectangle délimitant la zone draguée. Il s'agit d'un widget Tk de type canvas rectangle. Enfin, la fonction boxEnd va calculer les coordonnées de la boite draguée.
Le dossier profil, de la distribution de Audela, contient des scripts reprenant et complétant test.tcl et tkutil.tcl. Cet ensemble de scripts permet de compléter la zone de visualisation définie dans les paragraphes ci-dessus par une zone graphique auto-dimensionnée. Le contenu de la box draguée par la souris est analysé en termes d'intensité des pixels en lignes ou en colonnes. L'analyse graphique donne la répartition de l'intensité dans l'image.
On pourra exécuter ce script à partir de la fenêtre Audela de choix de l'interface. Exécuter ../profil profil.tcl.
