Débuter en Perl/Tk

**Jasmine80** · 03/08/2009, 11h55

Est-il possible de créer une fenêtre de @a_tm lignes de haut? Combien de pixels fait une ligne? ... ça dépend du caractère évidemment.
Quel est le caractère par défaut utilisé?
Si j'utilise 'courrier 10 bold', cela signifie-t-il 10 pixels de haut?

Merci,

**djibril** · 03/08/2009, 12h10

Voici un bout de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
#!/usr/bin/perl
use warnings;
use strict;
use utf8;
use Tk;
 
my $main = MainWindow->new(
  -background => 'blue',
  -title      => 'Calcul de la température de fusion : ',
);
$main->minsize( 250, 100 );
 
my $SeqLabel = $main->Label(
  -text       => 'Séquence : ',
  -background => 'blue',
  -foreground => 'white',
  -justify    => 'left',
);
my $SeqEntry = $main->Entry(
  -background => 'white',
  -width      => 30
);
 
my $NaLabel = $main->Label(
  -text       => 'Concentration en sel (M): ',
  -background => 'blue',
  -foreground => 'white',
);
my $NaEntry = $main->Entry(
  -background   => 'white',
  -textvariable => '5E-02',
  -width        => 15
);
 
my $CtLabel = $main->Label(
  -text       => 'Concentration en amorces (M): ',
  -background => 'blue',
  -foreground => 'white',
);
my $CtEntry = $main->Entry(
  -background   => 'white',
  -textvariable => '2E-07',
  -width        => 15
);
 
# bouton initialiser
my $btn_initialiser = $main->Button(
  -text             => 'Initialiser',
  -activeforeground => 'red',
  -borderwidth      => 5,
  -command          => \&Initialiser,
);
 
# bouton calculer
my $btn_tm = $main->Button(
  -text             => 'Tm',
  -activeforeground => 'red',
  -borderwidth      => 5,
  -command          => [ \&Result, $main, ],
);
 
# bouton quitter
my $btn_quitter = $main->Button(
  -text             => 'Quitter',
  -activeforeground => 'red',
  -borderwidth      => 5,
  -command          => \&Quitter,
);
 
# Effet clavier, touche entrée
$main->bind( 'Tk::Entry', '<Return>', sub { $btn_tm->invoke(); } );
 
# Placement de mes widgets
$SeqLabel->grid( -row => 0, -column => 0, -sticky => 'w' );
$SeqEntry->grid( -row => 0, -column => 1, -sticky => 'w', -columnspan => 2, );
 
$NaLabel->grid( -row => 1, -column => 0, -sticky => 'w' );
$NaEntry->grid( -row => 1, -column => 1, -sticky => 'w', -columnspan => 2, );
 
$CtLabel->grid( -row => 2, -column => 0, -sticky => 'w' );
$CtEntry->grid( -row => 2, -column => 1, -sticky => 'w', -columnspan => 2, );
 
$btn_initialiser->grid( -row => 3, -column => 0, -pady => 20, );
$btn_tm->grid( -row => 3, -column => 1, -pady => 20 );
$btn_quitter->grid( -row => 3, -column => 2, -pady => 20 );
 
MainLoop;
 
# Fonctions utiliser par l'interface graphique
sub Initialiser {
  $SeqEntry->delete( 0, 'end' );
 
  $NaEntry->delete( 0, 'end' );
  $NaEntry->insert( 'end', '0.05' );
 
  $CtEntry->delete( 0, 'end' );
  $CtEntry->insert( 'end', '2E-07' );
 
  return;
}
 
sub Quitter {
  exit(0);
}
 
# calcul du Tm
sub Result {
 
  my ($fenetre_principale) = @_;
 
  # récupération des données
  #----------------------------
  my $seq = $SeqEntry->get();
  my $Na  = $NaEntry->get();
  my $Ct  = $CtEntry->get();
 
  # suppression des espaces éventuels
  #------------------------------------
  $seq =~ s/\s//g;
  $seq = uc($seq);
 
  # Vérification
  #---------------
  if ( $seq !~ m/^[ATCGRKSWMYDVBHN]+$/ ) {
 
    # fenêtre d'erreur
    #--------------------
    my $error_frame = $fenetre_principale->Toplevel(
      -title      => 'ERROR MESSAGE',
      -background => 'red',
    );
    $error_frame->minsize( 300, 100 );
 
    $error_frame->Label(
      -text       => "Message d'erreur",
      -background => 'red',
      -font       => "courrier 10 bold",
    )->pack(qw/ -side top -fill x -expand 1 /);
 
    my $text_resultat
      = $error_frame->Scrolled( 'Text', -scrollbars => 'osoe', )->pack(qw/ -fill both -expand 1 /);
    $text_resultat->insert( 'end', "La séquence ne peut contenir\nque des lettres du code IUPAC" );
 
    # ou
    #$text_resultat->insert('end', 'La séquence ne peut contenir');
    #$text_resultat->insert('end', 'que des lettres du code IUPAC');
  }
  else {
 
    #-------------------------
    # fenêtre de résultat
    #-------------------------
 
    my $amorce_l = length($seq);
 
    my %correspondances = (
      'R' => [ 'A', 'G' ],
      'K' => [ 'G', 'T' ],
      'S' => [ 'C', 'G' ],
      'W' => [ 'A', 'T' ],
      'M' => [ 'A', 'C' ],
      'Y' => [ 'C', 'T' ],
      'D' => [ 'A', 'G', 'T' ],
      'V' => [ 'A', 'C', 'G' ],
      'B' => [ 'C', 'G', 'T' ],
      'H' => [ 'A', 'C', 'T' ],
      'N' => [ 'A', 'C', 'G', 'T' ]
    );
 
    my @liste_amorces;
    core( sub { push( @liste_amorces, $_ ); }, $seq, %correspondances );
 
    my @a_tm;
    my %h_tm;
 
    foreach my $seq (@liste_amorces) {
      my $tm = Tm( $seq, $Ct, $Na );
      $h_tm{$seq} = $tm;
      push( @a_tm, $tm );
    }
 
    my $moyenne_tm;
    map { $moyenne_tm += $_ } @a_tm;
    $moyenne_tm /= int(@a_tm);
 
    my $fenetre_resultat = $fenetre_principale->Toplevel(
      -title      => 'Tm de $seq (Na : $Na  Ct : $Ct)',
      -background => 'blue',
    );
    $fenetre_resultat->minsize( 500, 600 );
    $fenetre_resultat->Label(
      -text       => 'Mon résultat',
      -background => 'blue',
    )->pack(qw/ -side top -fill x/);
 
    $fenetre_resultat->Button(
      -text    => 'Fermer',
      -command => sub { $fenetre_resultat->destroy; },
    )->pack(qw/ -side bottom /);
 
    my $text_resultat
      = $fenetre_resultat->Scrolled( 'Text', -scrollbars => 'osoe', )->pack(qw/ -fill both -expand 1 /);
 
    # ligne d'affichage
    my $r;
    while ( my ( $s, $t ) = each %h_tm ) {
      $text_resultat->insert( 'end', "$s : $t\n" );
      $r++;
    }
    if ( int(@a_tm) > 1 ) {
      $text_resultat->insert( 'end', "$seq : $moyenne_tm\n" );
    }
 
  }
  return;
}
 
sub core {
 
  my ( $code, $amorce, %correspondances ) = @_;
 
  if ( my ( $start, $middle, $end ) = ( $amorce =~ /^([ACGT]*)([RKSWMYDVBHN])(\w*)$/i ) ) {
    foreach my $alt ( @{ $correspondances{$middle} } ) {
      core( $code, "$start$alt$end" );
    }
  }
  else {
 
    # Le mot clé "local" "localise" une variable globale de sorte
    # que à la sortie du bloc celle-ci reprenne
    # la valeur qu'elle avait juste avant d'être localisée
    local $_ = $amorce;
 
    # $code->() est simplement une manière d'appeler la fonction référencée par $code
    $code->();
  }
}
 
sub Tm {
 
  my $Amorce = $_[0];
  my $Ct     = $_[1];
  my $Na     = $_[2];
  $Amorce = uc($Amorce);
 
  my %dH = (
    AA => -9.1,
    TT => -9.1,
    AT => -8.6,
    TA => -6.0,
    CA => -5.8,
    TG => -5.8,
    GT => -6.5,
    AC => -6.5,
    CT => -7.8,
    AG => -7.8,
    GA => -5.6,
    TC => -5.6,
    CG => -11.9,
    GC => -11.1,
    GG => -11.0,
    CC => -11.0,
  );
 
  my %dS = (
    AA => -24.0,
    TT => -24.0,
    AT => -23.9,
    TA => -16.9,
    CA => -12.9,
    TG => -12.9,
    GT => -17.3,
    AC => -17.3,
    CT => -20.8,
    AG => -20.8,
    GA => -13.5,
    TC => -13.5,
    CG => -27.8,
    GC => -26.7,
    GG => -26.6,
    CC => -26.6,
  );
 
  my $H = 0;
  my $S = 0;
 
  my $NbScan = length($Amorce) - 2 + 1;
  for ( my $i = 0; $i < $NbScan; $i++ ) {
 
    my $N2 = substr( $Amorce, $i, 2 );
    if ( ( !exists $dH{$N2} ) | ( !exists $dS{$N2} ) ) {
      print "ERREUR N2 ($N2) $Amorce, $i\n";
    }
    unless ( $N2 =~ /N/i ) {
      $H += $dH{$N2};
      $S += $dS{$N2};
    }
  }
 
  my $Tm = 1000 * $H / ( ( -10.8 + $S ) + 1.987 * log( $Ct / 4 ) ) - 273.15 + 16.6 * ( log($Na) / log(10) );
  $Tm = sprintf( "%.3f", $Tm );
  return $Tm;
}

Tu remarqueras que dans le widget fenêtre de résultats, je n'ai pas mélangé grid et pack comme tu l'as fait, j'ai juste utilisé pack. De plus, j'ai utilisé le Widget Text pour afficher le résultat.

'courrier 10 bold' => gras, police 10, type courrier.
Ne cherche pas à te prendre la tête en cherchant la hauteur d'une ligne. Si tu veux espacer tes lignes, regarde les options de pack ou même grid.
La doc est ici : Tk::Pack et Tk::Grid. Sache qu'il y a une doc CPAN pour chaque type de widget (Tk::Label, Tk::Frame, Tk::Entry, etc). C'est un peu difficile de s'y retrouver au début, mais une fois qu'on a compris, ça va tout seul.
Dis moi si tu penses à des nouveaux Q/R pour la FAQ Perl/Tk ici.

**Jasmine80** · 03/08/2009, 12h29

Envoyé par djibril

Ne cherche pas à te prendre la tête en cherchant la hauteur d'une ligne.

C'est juste que je peux avoir 500 lignes de résultat comme je peux n'avoir qu'une seule. Quel est dans ce cas l'affichage le plus judicieux? Un énorme carde avec une seule ligne, ça fait vide.

Je vais regarder la doc, merci.

**djibril** · 03/08/2009, 12h52

Le code de ton widget résultat est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
my $text_resultat = $fenetre_resultat->Scrolled( 'Text', 
  -scrollbars => 'osoe', 
)->pack(qw/ -fill both -expand 1 /);

Si tu veux pas avoir une petite fenêtre, tu peux écrire ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
my $text_resultat = $fenetre_resultat->Scrolled( 'Text', 
  -scrollbars => 'osoe', 
  -height => 2,
)->pack(qw/ -fill both -expand 1 /);

Tu auras une petite fenêtre de 3 lignes environs. Même si tu as plus de lignes, il y aura une barre ascenseur verticale. tu peux même en dehors de ton while tester le nombre de ligne de résultat. S'il y en a plus de 100 par exemple, tu peux changer la hauteur du widget text à 20 par exemple en utilisant la méthode configure. C'est une méthode permettant de modifier la configuration d'un widget à tout moment.
Ex :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

$text_resultat->configure(-height => 20,);

T'auras ainsi un widget un peu plus dynamique.

Mais en ce qui me concerne, avoir une grande fenêtre vide n'est pas choquant.

**Jasmine80** · 03/08/2009, 16h46

$slave->pack?(options)?

...

-expand => boolean

Specifies whether the slave should be expanded to consume extra space in their master. Boolean may have any proper boolean value, such as 1 or no. Defaults to 0.

Je ne comprends pas ce que cela signifie. Qu'est-ce que l'esclave et le maître? L'esclave est-il la fenêtre sur laquelle s'effectue ce pack? Qui est le maître, la fenêtre parente?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
	if ( int(@a_tm) > 1 ) {
		$text_resultat->insert( 'end', "$seq : $moyenne_tm °C\n" );
	}

Est-il possible de faire en sorte que cette ligne se démarque des autres? En la mettant en gras par exemple?

Merci beaucoup pour ton aide.

**djibril** · 03/08/2009, 17h24

Envoyé par Jasmine80

Je ne comprends pas ce que cela signifie. Qu'est-ce que l'esclave et le maître? L'esclave est-il la fenêtre sur laquelle s'effectue ce pack? Qui est le maître, la fenêtre parente?

l'option -expand permet de définir l'espace qui sera alloué à ton widget et non le widget qui le contient.
Je vais essayer de t'expliquer avec des captures d'écran car ce n'est pas évident. Essaye d'exécuter le script de la FAQ Perl/tk sur pack.
Pour le bouton jaune, tu changes expand 0 à 1. voilà ce que tu obtiens => voir fichier joint.

Tu remarqueras qu'il y a un grand espace entre le bouton rouge et vert. En fait, tout l'espace vide a été alloué au bouton jaune car on a mis expand à 1. Du coup, si tu mets l'option -fill à both, tu verras que ça prend tout l'espace

.
Le parent des boutons est la fenêtre dans le script. S'ils avaient été crées dans un cadre (Widget Frame), le parent serait le cadre.

Envoyé par Jasmine80

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
	if ( int(@a_tm) > 1 ) {
		$text_resultat->insert( 'end', "$seq : $moyenne_tm °C\n" );
	}

Est-il possible de faire en sorte que cette ligne se démarque des autres? En la mettant en gras par exemple?

Merci beaucoup pour ton aide.

oui, quand tu utilises des insert, tu peux différencier tout ce que tu affiches. Pour cela, il faut que tu donnes en 3eme argument à insert, qui est un marqueur ou une liste de marqueurs.

Voici un exemple :
$texte->(indice, chaine, ['marqueur1', 'marqueur2', ...]);

Créons 2marqueurs de texte pour mettre un texte en gras et en italique, en rouge, etc. Il faut utiliser la méthode tagConfigure du Widget Tk::Text.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
    # Tag GRAS
    $text_resultat->tagConfigure('GRAS',
      -font => '{courrier} 20 {bold} italic',
    );
    # Tag Rouge
    $text_resultat->tagConfigure('ROUGE',
      -foreground => 'red',
    );

Ensuite, je l'applique sur ton texte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
    # ligne d'affichage
    my $r;
    while ( my ( $s, $t ) = each %h_tm ) {
      $text_resultat->insert( 'end', "$s : $t\n", ['GRAS','ROUGE']  );
      $r++;
    }
    if ( int(@a_tm) > 1 ) {
      $text_resultat->insert( 'end', "$seq : $moyenne_tm\n", ['GRAS'] );
    }

Voici ce que donnes ton script :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
#!/usr/bin/perl
use warnings;
use strict;
use utf8;
use Tk;
 
my $main = MainWindow->new(
  -background => 'blue',
  -title      => 'Calcul de la température de fusion : ',
);
$main->minsize( 250, 100 );
 
my $SeqLabel = $main->Label(
  -text       => 'Séquence : ',
  -background => 'blue',
  -foreground => 'white',
  -justify    => 'left',
);
my $SeqEntry = $main->Entry(
  -background => 'white',
  -width      => 30
);
 
my $NaLabel = $main->Label(
  -text       => 'Concentration en sel (M): ',
  -background => 'blue',
  -foreground => 'white',
);
my $NaEntry = $main->Entry(
  -background   => 'white',
  -textvariable => '5E-02',
  -width        => 15
);
 
my $CtLabel = $main->Label(
  -text       => 'Concentration en amorces (M): ',
  -background => 'blue',
  -foreground => 'white',
);
my $CtEntry = $main->Entry(
  -background   => 'white',
  -textvariable => '2E-07',
  -width        => 15
);
 
# bouton initialiser
my $btn_initialiser = $main->Button(
  -text             => 'Initialiser',
  -activeforeground => 'red',
  -borderwidth      => 5,
  -command          => \&Initialiser,
);
 
# bouton calculer
my $btn_tm = $main->Button(
  -text             => 'Tm',
  -activeforeground => 'red',
  -borderwidth      => 5,
  -command          => [ \&Result, $main, ],
);
 
# bouton quitter
my $btn_quitter = $main->Button(
  -text             => 'Quitter',
  -activeforeground => 'red',
  -borderwidth      => 5,
  -command          => \&Quitter,
);
 
# Effet clavier, touche entrée
$main->bind( 'Tk::Entry', '<Return>', sub { $btn_tm->invoke(); } );
 
# Placement de mes widgets
$SeqLabel->grid( -row => 0, -column => 0, -sticky => 'w' );
$SeqEntry->grid( -row => 0, -column => 1, -sticky => 'w', -columnspan => 2, );
 
$NaLabel->grid( -row => 1, -column => 0, -sticky => 'w' );
$NaEntry->grid( -row => 1, -column => 1, -sticky => 'w', -columnspan => 2, );
 
$CtLabel->grid( -row => 2, -column => 0, -sticky => 'w' );
$CtEntry->grid( -row => 2, -column => 1, -sticky => 'w', -columnspan => 2, );
 
$btn_initialiser->grid( -row => 3, -column => 0, -pady => 20, );
$btn_tm->grid( -row => 3, -column => 1, -pady => 20 );
$btn_quitter->grid( -row => 3, -column => 2, -pady => 20 );
 
MainLoop;
 
# Fonctions utiliser par l'interface graphique
sub Initialiser {
  $SeqEntry->delete( 0, 'end' );
 
  $NaEntry->delete( 0, 'end' );
  $NaEntry->insert( 'end', '0.05' );
 
  $CtEntry->delete( 0, 'end' );
  $CtEntry->insert( 'end', '2E-07' );
 
  return;
}
 
sub Quitter {
  exit(0);
}
 
# calcul du Tm
sub Result {
 
  my ($fenetre_principale) = @_;
 
  # récupération des données
  #----------------------------
  my $seq = $SeqEntry->get();
  my $Na  = $NaEntry->get();
  my $Ct  = $CtEntry->get();
 
  # suppression des espaces éventuels
  #------------------------------------
  $seq =~ s/\s//g;
  $seq = uc($seq);
 
  # Vérification
  #---------------
  if ( $seq !~ m/^[ATCGRKSWMYDVBHN]+$/ ) {
 
    # fenêtre d'erreur
    #--------------------
    my $error_frame = $fenetre_principale->Toplevel(
      -title      => 'ERROR MESSAGE',
      -background => 'red',
    );
    $error_frame->minsize( 300, 100 );
 
    $error_frame->Label(
      -text       => "Message d'erreur",
      -background => 'red',
      -font       => "courrier 10 bold",
    )->pack(qw/ -side top -fill x -expand 1 /);
 
    my $text_resultat
      = $error_frame->Scrolled( 'Text', -scrollbars => 'osoe', )->pack(qw/ -fill both -expand 1 /);
    $text_resultat->insert( 'end', "La séquence ne peut contenir\nque des lettres du code IUPAC" );
 
    # ou
    #$text_resultat->insert('end', 'La séquence ne peut contenir');
    #$text_resultat->insert('end', 'que des lettres du code IUPAC');
  }
  else {
 
    #-------------------------
    # fenêtre de résultat
    #-------------------------
 
    my $amorce_l = length($seq);
 
    my %correspondances = (
      'R' => [ 'A', 'G' ],
      'K' => [ 'G', 'T' ],
      'S' => [ 'C', 'G' ],
      'W' => [ 'A', 'T' ],
      'M' => [ 'A', 'C' ],
      'Y' => [ 'C', 'T' ],
      'D' => [ 'A', 'G', 'T' ],
      'V' => [ 'A', 'C', 'G' ],
      'B' => [ 'C', 'G', 'T' ],
      'H' => [ 'A', 'C', 'T' ],
      'N' => [ 'A', 'C', 'G', 'T' ]
    );
 
    my @liste_amorces;
    core( sub { push( @liste_amorces, $_ ); }, $seq, %correspondances );
 
    my @a_tm;
    my %h_tm;
 
    foreach my $seq (@liste_amorces) {
      my $tm = Tm( $seq, $Ct, $Na );
      $h_tm{$seq} = $tm;
      push( @a_tm, $tm );
    }
 
    my $moyenne_tm;
    map { $moyenne_tm += $_ } @a_tm;
    $moyenne_tm /= int(@a_tm);
 
    my $fenetre_resultat = $fenetre_principale->Toplevel(
      -title      => 'Tm de $seq (Na : $Na  Ct : $Ct)',
      -background => 'blue',
    );
    $fenetre_resultat->minsize( 500, 600 );
    $fenetre_resultat->Label(
      -text       => 'Mon résultat',
      -background => 'blue',
    )->pack(qw/ -side top -fill x/);
 
    $fenetre_resultat->Button(
      -text    => 'Fermer',
      -command => sub { $fenetre_resultat->destroy; },
    )->pack(qw/ -side bottom /);
 
    my $text_resultat
      = $fenetre_resultat->Scrolled( 'Text', -scrollbars => 'osoe', )->pack(qw/ -fill both -expand 1 /);
 
    # Tag GRAS
    $text_resultat->tagConfigure('GRAS',
      -font => '{courrier} 20 {bold} italic',
    );
    # Tag Rouge
    $text_resultat->tagConfigure('ROUGE',
      -foreground => 'red',
    );
 
    # ligne d'affichage
    my $r;
    while ( my ( $s, $t ) = each %h_tm ) {
      $text_resultat->insert( 'end', "$s : $t\n", ['GRAS','ROUGE']  );
      $r++;
    }
    if ( int(@a_tm) > 1 ) {
      $text_resultat->insert( 'end', "$seq : $moyenne_tm\n", ['GRAS'] );
    }
    $text_resultat->insert( 'end', 'FIN' );
  }
  return;
}
 
sub core {
 
  my ( $code, $amorce, %correspondances ) = @_;
 
  if ( my ( $start, $middle, $end ) = ( $amorce =~ /^([ACGT]*)([RKSWMYDVBHN])(\w*)$/i ) ) {
    foreach my $alt ( @{ $correspondances{$middle} } ) {
      core( $code, "$start$alt$end" );
    }
  }
  else {
 
    # Le mot clé "local" "localise" une variable globale de sorte
    # que à la sortie du bloc celle-ci reprenne
    # la valeur qu'elle avait juste avant d'être localisée
    local $_ = $amorce;
 
    # $code->() est simplement une manière d'appeler la fonction référencée par $code
    $code->();
  }
}
 
sub Tm {
 
  my $Amorce = $_[0];
  my $Ct     = $_[1];
  my $Na     = $_[2];
  $Amorce = uc($Amorce);
 
  my %dH = (
    AA => -9.1,
    TT => -9.1,
    AT => -8.6,
    TA => -6.0,
    CA => -5.8,
    TG => -5.8,
    GT => -6.5,
    AC => -6.5,
    CT => -7.8,
    AG => -7.8,
    GA => -5.6,
    TC => -5.6,
    CG => -11.9,
    GC => -11.1,
    GG => -11.0,
    CC => -11.0,
  );
 
  my %dS = (
    AA => -24.0,
    TT => -24.0,
    AT => -23.9,
    TA => -16.9,
    CA => -12.9,
    TG => -12.9,
    GT => -17.3,
    AC => -17.3,
    CT => -20.8,
    AG => -20.8,
    GA => -13.5,
    TC => -13.5,
    CG => -27.8,
    GC => -26.7,
    GG => -26.6,
    CC => -26.6,
  );
 
  my $H = 0;
  my $S = 0;
 
  my $NbScan = length($Amorce) - 2 + 1;
  for ( my $i = 0; $i < $NbScan; $i++ ) {
 
    my $N2 = substr( $Amorce, $i, 2 );
    if ( ( !exists $dH{$N2} ) | ( !exists $dS{$N2} ) ) {
      print "ERREUR N2 ($N2) $Amorce, $i\n";
    }
    unless ( $N2 =~ /N/i ) {
      $H += $dH{$N2};
      $S += $dS{$N2};
    }
  }
 
  my $Tm = 1000 * $H / ( ( -10.8 + $S ) + 1.987 * log( $Ct / 4 ) ) - 273.15 + 16.6 * ( log($Na) / log(10) );
  $Tm = sprintf( "%.3f", $Tm );
  return $Tm;
}

Voilà, tout est amplifié pour que tu comprennes bien comment ça fonctionne.
Il est vraiment très simple en Perl/Tk de faire des chose simplement en peu de codes. Tu peux supprimer, créer modifier un marqueur de texte très simplement.

**Jasmine80** · 04/08/2009, 09h35

Merci beaucoup, c'est bien plus clair maintenant. Ce script de la FAQ sur pack est vraiment très bien fait et m'a permis de comprendre facilement. Une dernière chose à régler et ça sera terminé. J'aimerais que la case où placer la séquence soit plus longue.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

$SeqEntry->grid( -row => 1, -column => 1, -sticky => 'w', -columnspan => 4);

J'essaie en augmentant -columnspan mais sa taille est limitée. Que dois-je faire?
Cette fonction permet quand même de déterminer l'étendue de la case ... d'où vient cette limite?

Script final :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
#!/usr/bin/perl
 
use warnings;
use strict;
 
use Tk;
 
 
 
my $main = MainWindow->new(
    -background => 'blue',
    -title      => "Calcul de la température de fusion",
);
$main->minsize( 250, 150 );
 
my $RefLabel = $main->Label(
    -text       => "T° basée sur l'analyse des plus proches voisins (revu par Genosys)",
    -background => 'blue',
    -foreground => 'white',
    -justify    => 'left',
);
 
my $SeqLabel = $main->Label(
    -text       => 'Séquence : ',
    -background => 'blue',
    -foreground => 'white',
    -justify    => 'left',
);
my $SeqEntry = $main->Entry(
    -background => 'white',
    -width      => 30
);
 
my $NaLabel = $main->Label(
    -text       => 'Concentration en sel (M): ',
    -background => 'blue',
    -foreground => 'white',
);
my $NaEntry = $main->Entry(
    -background   => 'white',
    -textvariable => '5E-02',
    -width        => 15
);
 
my $CtLabel = $main->Label(
    -text       => 'Concentration en amorces (M): ',
    -background => 'blue',
    -foreground => 'white',
);
my $CtEntry = $main->Entry(
    -background   => 'white',
    -textvariable => '2E-07',
    -width        => 15
);
 
# bouton initialiser
my $btn_initialiser = $main->Button(
    -text             => 'Initialiser',
    -activeforeground => 'red',
    -borderwidth      => 5,
    -command          => \&Initialiser,
);
 
# bouton calculer
my $btn_tm = $main->Button(
    -text             => 'Tm',
    -activeforeground => 'red',
    -borderwidth      => 5,
    -command          => [ \&Result, $main, ],
);
 
# bouton quitter
my $btn_quitter = $main->Button(
    -text             => 'Quitter',
    -activeforeground => 'red',
    -borderwidth      => 5,
    -command          => \&Quitter,
);
 
# Effet clavier, touche entrée
$main->bind( 'Tk::Entry','<Return>', sub { $btn_tm->invoke(); } );
 
# Placement de mes widgets
$RefLabel->grid( -row => 0, -column => 0, -sticky => 'w', -pady => 20, -columnspan =>2);
 
$SeqLabel->grid( -row => 1, -column => 0, -sticky => 'w' );
$SeqEntry->grid( -row => 1, -column => 1, -sticky => 'w', -columnspan => 4);
 
$NaLabel->grid( -row => 2, -column => 0, -sticky => 'w' );
$NaEntry->grid( -row => 2, -column => 1, -sticky => 'w', -columnspan => 2);
 
$CtLabel->grid( -row => 3, -column => 0, -sticky => 'w' );
$CtEntry->grid( -row => 3, -column => 1, -sticky => 'w', -columnspan => 2);
 
$btn_initialiser->grid( -row => 4, -column => 0, -pady => 20, );
$btn_tm->grid( -row => 4, -column => 1, -pady => 20 );
$btn_quitter->grid( -row => 4, -column => 2, -pady => 20 );
 
MainLoop;
 
# Fonctions utiliser par l'interface graphique
sub Initialiser {
    $SeqEntry->delete(0, 'end');
 
    $NaEntry->delete(0, 'end');
    $NaEntry->insert('end', '5E-02');  
 
    $CtEntry->delete(0, 'end');
    $CtEntry->insert('end', '2E-07');
 
    return;
}
 
sub Quitter {
    exit(0);
}
 
# calcul du Tm
sub Result {
 
    my ($fenetre_principale) = @_;
    # récupération des données
    #----------------------------
    my $seq = $SeqEntry->get();
    my $Na  = $NaEntry->get();
    my $Ct  = $CtEntry->get();
 
    # suppression des espaces éventuels
    #------------------------------------
    $seq =~ s/\s//g;
    $seq = uc($seq);
 
 
    # Vérification
    #---------------
    if ( $seq !~ m/^[ATCGRKSWMYDVBHN]+$/ ) {
 
        # fenêtre d'erreur
        #--------------------
        my $error_frame = $fenetre_principale->Toplevel(
            -title      => 'MESSAGE D\'ERREUR',
            -background => 'red',
        );
        $error_frame->minsize( 250, 50 );
 
        $error_frame->Label(
            -text =>
                "La séquence ne peut contenir\nque des lettres du code IUPAC",
            -background => 'red',
	    -font => "courrier 10 bold",
            -foreground => 'black',
        )->pack;
 
    }
    else {
 
        #-------------------------
        # fenêtre de résultat
        #-------------------------
 
	my $amorce_l = length($seq);
 
	my %correspondances =
	    (
		    'R' => ['A', 'G'],
		    'K' => ['G', 'T'],
		    'S' => ['C', 'G'],
		    'W' => ['A', 'T'],
		    'M' => ['A', 'C'],
		    'Y' => ['C', 'T'],
		    'D' => ['A', 'G', 'T'],
		    'V' => ['A', 'C', 'G'],
		    'B' => ['C', 'G', 'T'],
		    'H' => ['A', 'C', 'T'],
		    'N' => ['A', 'C', 'G', 'T']
	    );
 
 
	my @liste_amorces;
	core( sub { push (@liste_amorces, $_);}, $seq) ;
 
	my @a_tm;
	my %h_tm;
 
	foreach my $seq (@liste_amorces){
	    my $tm = Tm($seq,$Ct,$Na);
	    $h_tm{$seq}= $tm;
	    push (@a_tm, $tm);
	}
 
	my $moyenne_tm;
	map{$moyenne_tm += $_} @a_tm;
	$moyenne_tm /= int(@a_tm);
	$moyenne_tm = sprintf("%.3f", $moyenne_tm);
 
 
	my $fenetre_resultat = $fenetre_principale->Toplevel(
		-title      => "Tm de $seq (Na : $Na  Ct : $Ct)",
		-background => 'blue',
	);
	$fenetre_resultat->minsize( 500, 600 );
 
	$fenetre_resultat->Label(
		-text       => 'Résultat',
		-foreground => 'white',
		-background => 'blue',
	)->pack(qw/ -side top -fill x/);
 
	$fenetre_resultat->Button(
		-text    => 'Fermer',
		-command => sub { $fenetre_resultat->destroy; },
	)->pack(qw/ -side bottom /);
 
	my $text_resultat
	= $fenetre_resultat->Scrolled( 'Text', -scrollbars => 'osoe', )->pack(qw/ -fill both -expand 1 /);
 
 
	# Tag GRAS
	$text_resultat->tagConfigure('GRAS',
		-font => '{Times New Roman} 8 {bold}',
	);
	# Tag Rouge
	$text_resultat->tagConfigure('ROUGE',
		-foreground => 'red',
	);
 
 
	# lignes d'affichage
	while ( my ( $s, $t ) = each %h_tm ) {
		$text_resultat->insert( 'end', "$s : $t °C\n" );
	}
	if ( int(@a_tm) > 1 ) {
		$text_resultat->insert( 'end', "$seq : $moyenne_tm °C\n", ['GRAS','ROUGE'] );
	}
 
 
    }
    return;
}
 
 
 
sub core
{
  my ($code, $amorce) = @_ ; 
 
  my %correspondances = (
    'R' => ['A', 'G'],
    'K' => ['G', 'T'],
    'S' => ['C', 'G'],
    'W' => ['A', 'T'],
    'M' => ['A', 'C'],
    'Y' => ['C', 'T'],
    'D' => ['A', 'G', 'T'],
    'V' => ['A', 'C', 'G'],
    'B' => ['C', 'G', 'T'],
    'H' => ['A', 'C', 'T'],
    'N' => ['A', 'C', 'G', 'T']
  );
 
  if ( my ($start, $middle, $end) = ($amorce =~ /^([ACGT]*)([RKSWMYDVBHN])(\w*)$/i) )  {
    foreach my $alt (@{$correspondances{$middle}}) {
      core( $code, "$start$alt$end" );
    }
  }
  else {
    local $_ = $amorce ;                                                                          # Le mot clé "local" "localise" une variable globale de sorte que à la sortie du bloc celle-ci reprenne la valeur qu'elle avait juste avant d'être localisée
    $code->();                                                                                    # $code->() est simplement une manière d'appeler la fonction référencée par $code
  }
}
 
 
 
sub Tm{
 
        my $Amorce = $_[0];
        my $Ct = $_[1];
        my $Na = $_[2];
 
        my %dH =
        (
                AA => -9.1,
                TT => -9.1,
                AT => -8.6,
                TA => -6.0,
                CA => -5.8,
                TG => -5.8,
                GT => -6.5,
                AC => -6.5,
                CT => -7.8,
                AG => -7.8,
                GA => -5.6,
                TC => -5.6,
                CG => -11.9,
                GC => -11.1,
                GG => -11.0,
                CC => -11.0,
        );
 
        my %dS =
        (
                AA => -24.0,
                TT => -24.0,
                AT => -23.9,
                TA => -16.9,
                CA => -12.9,
                TG => -12.9,
                GT => -17.3,
                AC => -17.3,
                CT => -20.8,
                AG => -20.8,
                GA => -13.5,
                TC => -13.5,
                CG => -27.8,
                GC => -26.7,
                GG => -26.6,
                CC => -26.6,
        );
 
        my $H = 0;
        my $S = 0;
 
        my $NbScan = length($Amorce)-2+1;
        for(my$i=0; $i<$NbScan; $i++)
        {
 
                my $N2 = substr($Amorce, $i, 2);
                if((!exists $dH{$N2}) | (!exists $dS{$N2})){print "ERREUR N2 ($N2) $Amorce, $i\n";};
                unless($N2=~/N/i)
                {
                        $H += $dH{$N2};
                        $S += $dS{$N2};
                }
        }
 
 
 
        my $Tm = 1000 * $H / ((-10.8 + $S)+1.987*log($Ct/4)) - 273.15 + 16.6*(log($Na)/log(10));
        $Tm = sprintf("%.3f", $Tm);
        return $Tm;
}

^^ Après, il ne me restera plus qu'à transformer ce script en un exécutable.

Merci,

**djibril** · 04/08/2009, 10h34

Pour augmenter la longueur du champ de la séquence ne se règle pas avec columnspan de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

$SeqEntry->grid( -row => 1, -column => 1, -sticky => 'w', -columnspan => 4);

columnspan te sert uniquement pour qu'il soit de taille équivalente à 2 colonnes minimum étant donné que la ligne de boutons (3eme ligne) fait 3 colonnes.

Pour changer la longueur tu peux lui fixer sa taille, c'est d'ailleurs ce que tu fait actuellement en l'a fixant à 30. Tu peux la mettre à 100 par exemple.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
my $SeqEntry = $main->Entry(
    -background => 'white',
    -width         => 100,
);

Tu peux même à la place de Entry faire un widget si tu souhaite que l'utilisateur mette une très grande séquence sur plusieurs lignes

.

Voilà ton script avec width à 100.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
#!/usr/bin/perl
 
use warnings;
use strict;
 
use Tk;
 
 
 
my $main = MainWindow->new(
    -background => 'blue',
    -title      => "Calcul de la température de fusion",
);
$main->minsize( 250, 150 );
 
my $RefLabel = $main->Label(
    -text       => "T° basée sur l'analyse des plus proches voisins (revu par Genosys)",
    -background => 'blue',
    -foreground => 'white',
    -justify    => 'left',
);
 
my $SeqLabel = $main->Label(
    -text       => 'Séquence : ',
    -background => 'blue',
    -foreground => 'white',
    -justify    => 'left',
);
my $SeqEntry = $main->Entry(
    -background => 'white',
    -width      => 100,
);
 
my $NaLabel = $main->Label(
    -text       => 'Concentration en sel (M): ',
    -background => 'blue',
    -foreground => 'white',
);
my $NaEntry = $main->Entry(
    -background   => 'white',
    -textvariable => '5E-02',
    -width        => 15
);
 
my $CtLabel = $main->Label(
    -text       => 'Concentration en amorces (M): ',
    -background => 'blue',
    -foreground => 'white',
);
my $CtEntry = $main->Entry(
    -background   => 'white',
    -textvariable => '2E-07',
    -width        => 15
);
 
# bouton initialiser
my $btn_initialiser = $main->Button(
    -text             => 'Initialiser',
    -activeforeground => 'red',
    -borderwidth      => 5,
    -command          => \&Initialiser,
);
 
# bouton calculer
my $btn_tm = $main->Button(
    -text             => 'Tm',
    -activeforeground => 'red',
    -borderwidth      => 5,
    -command          => [ \&Result, $main, ],
);
 
# bouton quitter
my $btn_quitter = $main->Button(
    -text             => 'Quitter',
    -activeforeground => 'red',
    -borderwidth      => 5,
    -command          => \&Quitter,
);
 
# Effet clavier, touche entrée
$main->bind( 'Tk::Entry','<Return>', sub { $btn_tm->invoke(); } );
 
# Placement de mes widgets
$RefLabel->grid( -row => 0, -column => 0, -sticky => 'w', -pady => 20, -columnspan =>2);
 
$SeqLabel->grid( -row => 1, -column => 0, -sticky => 'w' );
$SeqEntry->grid( -row => 1, -column => 1, -sticky => 'w', -columnspan => 2);
 
$NaLabel->grid( -row => 2, -column => 0, -sticky => 'w' );
$NaEntry->grid( -row => 2, -column => 1, -sticky => 'w', -columnspan => 2);
 
$CtLabel->grid( -row => 3, -column => 0, -sticky => 'w' );
$CtEntry->grid( -row => 3, -column => 1, -sticky => 'w', -columnspan => 2);
 
$btn_initialiser->grid( -row => 4, -column => 0, -pady => 20, );
$btn_tm->grid( -row => 4, -column => 1, -pady => 20 );
$btn_quitter->grid( -row => 4, -column => 2, -pady => 20 );
 
MainLoop;
 
# Fonctions utiliser par l'interface graphique
sub Initialiser {
    $SeqEntry->delete(0, 'end');
 
    $NaEntry->delete(0, 'end');
    $NaEntry->insert('end', '5E-02');  
 
    $CtEntry->delete(0, 'end');
    $CtEntry->insert('end', '2E-07');
 
    return;
}
 
sub Quitter {
    exit(0);
}
 
# calcul du Tm
sub Result {
 
    my ($fenetre_principale) = @_;
    # récupération des données
    #----------------------------
    my $seq = $SeqEntry->get();
    my $Na  = $NaEntry->get();
    my $Ct  = $CtEntry->get();
 
    # suppression des espaces éventuels
    #------------------------------------
    $seq =~ s/\s//g;
    $seq = uc($seq);
 
 
    # Vérification
    #---------------
    if ( $seq !~ m/^[ATCGRKSWMYDVBHN]+$/ ) {
 
        # fenêtre d'erreur
        #--------------------
        my $error_frame = $fenetre_principale->Toplevel(
            -title      => 'MESSAGE D\'ERREUR',
            -background => 'red',
        );
        $error_frame->minsize( 250, 50 );
 
        $error_frame->Label(
            -text =>
                "La séquence ne peut contenir\nque des lettres du code IUPAC",
            -background => 'red',
	    -font => "courrier 10 bold",
            -foreground => 'black',
        )->pack;
 
    }
    else {
 
        #-------------------------
        # fenêtre de résultat
        #-------------------------
 
	my $amorce_l = length($seq);
 
	my %correspondances =
	    (
		    'R' => ['A', 'G'],
		    'K' => ['G', 'T'],
		    'S' => ['C', 'G'],
		    'W' => ['A', 'T'],
		    'M' => ['A', 'C'],
		    'Y' => ['C', 'T'],
		    'D' => ['A', 'G', 'T'],
		    'V' => ['A', 'C', 'G'],
		    'B' => ['C', 'G', 'T'],
		    'H' => ['A', 'C', 'T'],
		    'N' => ['A', 'C', 'G', 'T']
	    );
 
 
	my @liste_amorces;
	core( sub { push (@liste_amorces, $_);}, $seq) ;
 
	my @a_tm;
	my %h_tm;
 
	foreach my $seq (@liste_amorces){
	    my $tm = Tm($seq,$Ct,$Na);
	    $h_tm{$seq}= $tm;
	    push (@a_tm, $tm);
	}
 
	my $moyenne_tm;
	map{$moyenne_tm += $_} @a_tm;
	$moyenne_tm /= int(@a_tm);
	$moyenne_tm = sprintf("%.3f", $moyenne_tm);
 
 
	my $fenetre_resultat = $fenetre_principale->Toplevel(
		-title      => "Tm de $seq (Na : $Na  Ct : $Ct)",
		-background => 'blue',
	);
	$fenetre_resultat->minsize( 500, 600 );
 
	$fenetre_resultat->Label(
		-text       => 'Résultat',
		-foreground => 'white',
		-background => 'blue',
	)->pack(qw/ -side top -fill x/);
 
	$fenetre_resultat->Button(
		-text    => 'Fermer',
		-command => sub { $fenetre_resultat->destroy; },
	)->pack(qw/ -side bottom /);
 
	my $text_resultat
	= $fenetre_resultat->Scrolled( 'Text', -scrollbars => 'osoe', )->pack(qw/ -fill both -expand 1 /);
 
 
	# Tag GRAS
	$text_resultat->tagConfigure('GRAS',
		-font => '{Times New Roman} 8 {bold}',
	);
	# Tag Rouge
	$text_resultat->tagConfigure('ROUGE',
		-foreground => 'red',
	);
 
 
	# lignes d'affichage
	while ( my ( $s, $t ) = each %h_tm ) {
		$text_resultat->insert( 'end', "$s : $t °C\n" );
	}
	if ( int(@a_tm) > 1 ) {
		$text_resultat->insert( 'end', "$seq : $moyenne_tm °C\n", ['GRAS','ROUGE'] );
	}
 
 
    }
    return;
}
 
 
 
sub core
{
  my ($code, $amorce) = @_ ; 
 
  my %correspondances = (
    'R' => ['A', 'G'],
    'K' => ['G', 'T'],
    'S' => ['C', 'G'],
    'W' => ['A', 'T'],
    'M' => ['A', 'C'],
    'Y' => ['C', 'T'],
    'D' => ['A', 'G', 'T'],
    'V' => ['A', 'C', 'G'],
    'B' => ['C', 'G', 'T'],
    'H' => ['A', 'C', 'T'],
    'N' => ['A', 'C', 'G', 'T']
  );
 
  if ( my ($start, $middle, $end) = ($amorce =~ /^([ACGT]*)([RKSWMYDVBHN])(\w*)$/i) )  {
    foreach my $alt (@{$correspondances{$middle}}) {
      core( $code, "$start$alt$end" );
    }
  }
  else {
    local $_ = $amorce ;                                                                          # Le mot clé "local" "localise" une variable globale de sorte que à la sortie du bloc celle-ci reprenne la valeur qu'elle avait juste avant d'être localisée
    $code->();                                                                                    # $code->() est simplement une manière d'appeler la fonction référencée par $code
  }
}
 
 
 
sub Tm{
 
        my $Amorce = $_[0];
        my $Ct = $_[1];
        my $Na = $_[2];
 
        my %dH =
        (
                AA => -9.1,
                TT => -9.1,
                AT => -8.6,
                TA => -6.0,
                CA => -5.8,
                TG => -5.8,
                GT => -6.5,
                AC => -6.5,
                CT => -7.8,
                AG => -7.8,
                GA => -5.6,
                TC => -5.6,
                CG => -11.9,
                GC => -11.1,
                GG => -11.0,
                CC => -11.0,
        );
 
        my %dS =
        (
                AA => -24.0,
                TT => -24.0,
                AT => -23.9,
                TA => -16.9,
                CA => -12.9,
                TG => -12.9,
                GT => -17.3,
                AC => -17.3,
                CT => -20.8,
                AG => -20.8,
                GA => -13.5,
                TC => -13.5,
                CG => -27.8,
                GC => -26.7,
                GG => -26.6,
                CC => -26.6,
        );
 
        my $H = 0;
        my $S = 0;
 
        my $NbScan = length($Amorce)-2+1;
        for(my$i=0; $i<$NbScan; $i++)
        {
 
                my $N2 = substr($Amorce, $i, 2);
                if((!exists $dH{$N2}) | (!exists $dS{$N2})){print "ERREUR N2 ($N2) $Amorce, $i\n";};
                unless($N2=~/N/i)
                {
                        $H += $dH{$N2};
                        $S += $dS{$N2};
                }
        }
 
 
 
        my $Tm = 1000 * $H / ((-10.8 + $S)+1.987*log($Ct/4)) - 273.15 + 16.6*(log($Na)/log(10));
        $Tm = sprintf("%.3f", $Tm);
        return $Tm;
}

**Jasmine80** · 04/08/2009, 12h35

D'accord, merci beaucoup pour ton aide. Le script est terminé.

Dans sub Result, le return à la fin a-t-il une utilité? Par défaut, quand aucun return n'est indiqué, c'est la dernière valeur calculée qui est retournée par le sous-programme. A quoi sert un return sans rien d'autre à la suite?

Merci,

**djibril** · 04/08/2009, 12h38

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

return;

retourne undef

**Jasmine80** · 04/08/2009, 12h44

Envoyé par djibril

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

return;

retourne undef

Oui mais à quoi sert dans ce cas-ci de retourner une valeur indéfinie? Dans quel cas cela pourrait-il être utile?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
sub Result {
	...
 
    if ( $seq !~ m/^[ATCGRKSWMYDVBHN]+$/ ) {
	...
    }
 
    else {
	...
    }
 
    return;
}

On passe donc par le if ou le else qui renvoie une fenêtre et puis?

**djibril** · 04/08/2009, 12h48

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#!/usr/bin/perl
 
use warnings;
use strict;
 
if ( my $test = carre() ) {
  print "$test\n";
}
else {
  print "Aucun resultat";
}
sub carre {
  my $value = shift;
 
  if ( defined $value ) {
    return $value **2;
  }
 
  return;
}

retournera

Aucun resultat

Tu peux avoir besoin de tester si le retour est correct ou non dans divers contextes. Si tu ne mets pas de return, Perl renvoie la dernière expression évaluée dans ta fonction. Donc une bonne manière est toujours de renvoyer un undef si vraiment tu n'as rien à renvoyer ou si tu souhaites faire part d'un échec. Dans le cas contraire, tu retournes une valeur attendue.

**Jasmine80** · 04/08/2009, 12h52

D'accord, dans ce script c'est clair. Vu que rien ne récupère la valeur de retour de mon sous-programme Result, ce return peut donc être supprimé ... si j'ai bien compris.

Un super grand merci pour ton aide.

**djibril** · 04/08/2009, 13h01

non

.
Quand ton script ne doit rien retourner d'implicite, il faut retourner undef, donc écrire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

return;

C'est juste une bonne pratique, mais ça n'a rien d'obligatoire.
Ton script est donc OK, simple. Tu vois ce n'est pas très compliqué. Tu peux l'améliorer comme bon te semble, changer le design, les couleurs etc.

**Jasmine80** · 04/08/2009, 13h29

D'accord, merci beaucoup.

Débuter en Perl/Tk

Interfaces Graphiques Perl

Discussions similaires

Partager

Partager