Débuter en Perl/Tk

**Jasmine80** · 31/07/2009, 13h33

Envoyé par djibril

N'hésites pas à te remettre au perl/TK, c'est vraiment simple. Le seul inconvénient et le manque de documentation et de livre à ce sujet vu qu'O'reilly n'édite plus. Néanmoins, il y a la FAQ perl/Tk, et connaissant tes questions, ça me permettrait de l'améliorer et l'enrichir

.

Quand on débute est-ce plus simple de partir de zéro ou alors d'essayer de comprendre un script déjà existant et de l'adapter à ses besoins? Je suis plus pour cette seconde option. ... la FAQ parle-t-elle des champs de saisie? Je ne l'ai pas encore épluchée en détails mais à première vue, je n'ai rien vu ^^ mais peut-être est-ce dû à un problème de vocabulaire de ma part.

**djibril** · 31/07/2009, 13h47

Pour débuter en Perl/Tk, je te conseille de repartir de zéro.
1- Il faut dans un premier temps comprendre le gestionnaire d'espace, la FAQ est là pour, il y a un script disponible à exécuter (et non à comprendre

) qui permet de tester toutes les options de pack.
2- Pour le reste, tu peux lire la FAQ et demander sur le forum. En fonction des questions, je pourrais rajouter des Questions/Réponses dans la FAQ Perl/Tk.
3- Ensuite, tu peux en effet te baser sur des scripts existant.

Pour ton code à transformer en TK, ça peut être mis en place rapidement.

**Jasmine80** · 31/07/2009, 16h23

Voici mon 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
#!/usr/bin/perl
 
use warnings;
use strict;
 
 
use Tk;
 
my $main = MainWindow->new();
$main->title("Calcul de la température de fusion : ");
$main->configure(-background => 'blue');
$main->minsize( qw(250 100) );
 
 
my $SeqLabel = $main->Label( -text => 'Séquence : ',
			-background => 'blue',
			-foreground => 'white',
			-width => 30
			);
my $SeqEntry = $main->Entry(-background => 'white',
			-width => 30
			);
 
 
my $NaLabel = $main->Label( -text => 'Concentration en sel (M): ',
			-background => 'blue',
			-foreground => 'white',
			-width => 30
			);
my $NaEntry = $main->Entry(-background => 'white',
			-textvariable => '0.05',
			-width => 15
			);
 
my $CtLabel = $main->Label( -text => 'Concentration en amorces (M): ',
			-background => 'blue',
			-foreground => 'white',
			-width => 30
			);
my $CtEntry = $main->Entry(-background => 'white',
			-textvariable => '2E-07',	
			-width => 15
			);
 
 
$SeqLabel->grid(-row => 0, -column => 0, );
$SeqEntry->grid(-row => 0, -column => 1, -columnspan => 2,);
 
$NaLabel->grid(-row => 1, -column => 0, );
$NaEntry->grid(-row => 1, -column => 1, );
 
$CtLabel->grid(-row => 2, -column => 0, );
$CtEntry->grid(-row => 2, -column => 1, );
 
 
# bouton initialiser
my $btn_initialiser = $main  -> Button ( -text => 'Initialiser' ,  -activeforeground => 'red', -borderwidth => 5, -command => \&Initialiser ) ;
$btn_initialiser -> grid(-row=>4,-column=>0);
 
# bouton calculer
my $btn_tm = $main  -> Button ( -text => 'Tm' ,  -activeforeground => 'red', -borderwidth => 5, -command => \&Tm ) ;
$btn_tm -> grid(-row=>4,-column=>1);
 
# bouton quitter
my $btn_quitter = $main -> Button ( -text => 'Quitter' ,  -activeforeground => 'red', -borderwidth => 5, -command => \&Quitter ) ;
$btn_quitter -> grid(-row=>4,-column=>2);
 
 
MainLoop;
 
 
 
 
sub Initialiser{
	$SeqEntry->textvariable('');
        $NaEntry->textvariable('0.05');
	$CtEntry->textvariable('2E-07');
}
 
sub Quitter{
        exit ( 0 ) ;
}
 
# calcul du Tm
sub Tm{
 
        # 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;
 
	# Vérification
        #---------------
	if ($seq !~ m/^[atcgrkswmydvbhn]+$/i){
 
		# fenêtre d'erreur
		#--------------------
		my $error_frame = MainWindow->new();
		$error_frame->title("ERROR MESSAGE");
		$error_frame->configure(-background => 'red');
		$error_frame->minsize( qw(300 100) );
 
		my $ErLabel = $error_frame->Label( -text => 'La séquence ne peut contenir que des lettres du code IUPAC',
					-background => 'blue',
					-foreground => 'white',
					-width => 30
					);
		MainLoop;
 
	}
	else{
		# fenêtre de résultat
		#-------------------------
		my $result_frame = MainWindow->new();
		$result_frame->title("Tm de $seq (Na : $Na  Ct : $Ct) ");
		$result_frame->configure(-background => 'blue');
		$result_frame->minsize( qw(500 600) );
 
	}
 
 
 
}

Et mes questions :
1) comment faire un saut de ligne avec grid? J'ai essayé en passant de row = 2 à row = 4 mais sans résultat.
2) si je crée plusieurs fenêtres dois-je à chaque fois utiliser une Mainloop?
3) comment faire afin que la touche enter ait le même effet que le bouton Tm?

Tout conseil est le bien venu.

Merci pour ton aide,

**djibril** · 31/07/2009, 16h57

Bon, je vais jeter un coup d'oeil à ton script. Mais je vais tout de même répondre à tes questions

1) comment faire un saut de ligne avec grid? J'ai essayé en passant de row = 2 à row = 4 mais sans résultat.

Tu ne peux pas. Néanmoins, tu peux utiliser les option pady pour augmenter l'espace entre tes lignes

2) si je crée plusieurs fenêtres dois-je à chaque fois utiliser une Mainloop?

Pas forcément. Si ta nouvelle fenêtre est un enfant du premier, ce n'est une obligation.

3) comment faire afin que la touche enter ait le même effet que le bouton Tm?

C'est à dire ?

**Jasmine80** · 31/07/2009, 17h04

Merci de regarder à mon script.

Citation:
3) comment faire afin que la touche enter ait le même effet que le bouton Tm?
C'est à dire ?

Et bien, pour que les calculs s'effectuent, on appuie sur le bouton 'Tm' qui va renvoyer le résultat dans une nouvelle fenêtre. J'aimerais également que la touche 'enter' ait le même effet.

Merci,

**djibril** · 31/07/2009, 17h10

Ah ok, j'avais pas saisie. Tu parles de la toucher Entrée du clavier. Il suffit que le bouton ait le focus. Il faut naviguer avec la touche tabulation et dès que le bouton a le focus, tu tapes sur entrée et c'est OK.

**djibril** · 31/07/2009, 17h32

Voici un exemple 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
#!/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 => '0.05',
    -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          => [ \&Tm, $main ],
);
 
# bouton quitter
my $btn_quitter = $main->Button(
    -text             => 'Quitter',
    -activeforeground => 'red',
    -borderwidth      => 5,
    -command          => \&Quitter,
);
 
# 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 Tm {
    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;
 
    # Vérification
    #---------------
    if ( $seq !~ m/^[atcgrkswmydvbhn]+$/i ) {
 
        # fenêtre d'erreur
        #--------------------
        my $error_frame = $fenetre_principale->Toplevel(
            -title      => 'ERROR MESSAGE',
            -background => 'red',
        );
        $error_frame->minsize( 300, 100 );
 
        my $ErLabel = $error_frame->Label(
            -text =>
                'La séquence ne peut contenir que des lettres du code IUPAC',
            -background => 'blue',
            -foreground => 'white',
            -width      => 30
        );
    }
    else {
 
        #-------------------------
        # fenêtre de résultat
        #-------------------------
        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 => 'white',
        )->pack(qw/ -side top -fill x/);
 
        $fenetre_resultat->Button(
            -text    => 'Fermer',
            -command => sub { $fenetre_resultat->destroy; },
        )->pack();
 
    }
    return;
}

Tu peux t'en inspirer. Si t'as besoin de questions, n'hésite pas.

**Jedai** · 31/07/2009, 19h30

Envoyé par djibril

Ah ok, j'avais pas saisie. Tu parles de la toucher Entrée du clavier. Il suffit que le bouton ait le focus. Il faut naviguer avec la touche tabulation et dès que le bouton a le focus, tu tapes sur entrée et c'est OK.

Je pense qu'il aimerait que Enter ait cet effet même s'il est pressé alors qu'un champ est actif, dans ce cas il faut utiliser bind, par exemple :

Code :

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

$main->bind('Tk::Entry','<Return>', &Tm);

--
Jedaï

**djibril** · 31/07/2009, 21h19

En effet jedai, c'est aussi une possibilité. d'ailleurs, j'ajouterais une petite modification et écrirais plutôt ainsi.

Code :

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

$main->bind( 'Tk::Entry','<Return>', sub { $btn_tm->invoke(); } );

En faite, ainsi, on n'a plus besoin de se soucier des arguments à passer à la procédure. On invoque, on simule un clique sur le bouton faisant appel à la procédure TM. De plus, bind à la bonne habitude d'envoyer un premier argument à la procédure appelée correspondant à la référence du Widget. Donc si on l'oublie, cela peut poser problème.

Voilà, ce qui donne

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
#!/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 => '0.05',
    -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          => [ \&Tm, $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 Tm {
    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;
 
    # Vérification
    #---------------
    if ( $seq !~ m/^[atcgrkswmydvbhn]+$/i ) {
 
        # fenêtre d'erreur
        #--------------------
        my $error_frame = $fenetre_principale->Toplevel(
            -title      => 'ERROR MESSAGE',
            -background => 'red',
        );
        $error_frame->minsize( 300, 100 );
 
        my $ErLabel = $error_frame->Label(
            -text =>
                'La séquence ne peut contenir que des lettres du code IUPAC',
            -background => 'blue',
            -foreground => 'white',
            -width      => 30
        );
    }
    else {
 
        #-------------------------
        # fenêtre de résultat
        #-------------------------
        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 => 'white',
        )->pack(qw/ -side top -fill x/);
 
        $fenetre_resultat->Button(
            -text    => 'Fermer',
            -command => sub { $fenetre_resultat->destroy; },
        )->pack();
 
    }
    return;
}

**nibroc** · 01/08/2009, 13h16

Le livre (en anglais) Mastering Perl/Tk de Steve Lidie et Nancy Walsh est toujours en vente (Puis-je dire chez qui ?)
Nibroc

**stoyak** · 01/08/2009, 14h05

Envoyé par nibroc

Le livre (en anglais) Mastering Perl/Tk de Steve Lidie et Nancy Walsh est toujours en vente (Puis-je dire chez qui ?)
Nibroc

oui

**nibroc** · 01/08/2009, 16h20

Envoyé par stoyak

oui

Chez Amazon.com ou Amazon.fr, voici un lien chez ce dernier
http://www.amazon.fr/Mastering-Perl-...9132688&sr=1-1

Nibroc

**djibril** · 01/08/2009, 17h27

Il est aussi disponible en français.

**Jedai** · 01/08/2009, 21h57

Envoyé par djibril

Il est aussi disponible en français.

Tu oublies que malheureusement O'Reilly France a fermé, donc on ne peut trouver un de leurs ouvrages que par coup de chance et en occasion... C'était pourtant à mon sens l'un des meilleurs éditeur dans le domaine (bien sûr la maison mère est toujours là).

--
Jedaï

**djibril** · 02/08/2009, 13h52

Envoyé par Jedai

Tu oublies que malheureusement O'Reilly France a fermé, donc on ne peut trouver un de leurs ouvrages que par coup de chance et en occasion... C'était pourtant à mon sens l'un des meilleurs éditeur dans le domaine (bien sûr la maison mère est toujours là).

--
Jedaï

C'est sûr.

**Jasmine80** · 03/08/2009, 09h32

Merci pour votre aide. J'ai quelques questions.

Pourquoi utiliser 'une utf8'? Les accents ne sont plus reconnus.
Pourquoi mélanger du grid et du pack?
Comment se fait-il que le texte n'apparaisse pas dans la fenêtre d'erreur?

Code :

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

1
2
3
4
5
6
7
        my $ErLabel = $error_frame->Label(
            -text =>
                'La séquence ne peut contenir que des lettres du code IUPAC',
            -background => 'blue',
            -foreground => 'white',
            -width      => 30
        );

**Jasmine80** · 03/08/2009, 09h52

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
	# ligne d'affichage
	my $r;
 
	while ( my($s, $t) = each %h_tm ){
 
		$fenetre_resultat->Label(
		    -text       => "$s : $t",
		    -background => 'blue',
		)->grid( -row => $r, -column => 0, -sticky => 'w' );
 
		$r++;
	}

Comment faire afin d'afficher les résultats ligne par ligne?

Voici le script en entier :

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
#!/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, 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 );
 
        my $ErLabel = $error_frame->Label(
            -text =>
                'La séquence ne peut contenir que des lettres du code IUPAC',
            -background => 'blue',
            -foreground => 'white',
            -width      => 30
        );
    }
    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 => 'white',
        )->pack(qw/ -side top -fill x/);
 
 
	# ligne d'affichage
	my $r;
 
	while ( my($s, $t) = each %h_tm ){
 
		$fenetre_resultat->Label(
		    -text       => "$s : $t",
		    -background => 'blue',
		)->grid( -row => $r, -column => 0, -sticky => 'w' );
 
		$r++;
	}
 
	$fenetre_resultat->Label(
	    -text       => "$seq : $moyenne_tm",
	    -background => 'blue',
	)->grid( -row => $r, -column => 0, -sticky => 'w' );	
 
 
        $fenetre_resultat->Button(
            -text    => 'Fermer',
            -command => sub { $fenetre_resultat->destroy; },
        )->pack();
 
    }
    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 {
    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];
        $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;
}

Merci

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

Pour l'affichage dans la fenêtre d'erreur, le problème venait du fait que je n'avais pas utilisé le pack :

Code :

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

1
2
3
4
5
6
7
        $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;

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

Envoyé par Jasmine80

Merci pour votre aide. J'ai quelques questions.

Pourquoi utiliser 'une utf8'? Les accents ne sont plus reconnus.
Pourquoi mélanger du grid et du pack?
Comment faire afin d'afficher les résultats ligne par ligne?

J'ai l'habitude de travailler sous Windows, ou Linux. De ce faite, dans un souci d'encodage et de compatibilité, tous mes scripts sont en utf8. Sous Windows, j'ai réglé mon éditeur pour que mes scripts soient en utf8. Ensuite, je rajoute use utf8; et les accents sont bien affichés dans mes widgets.

En ce qui concerne les gestionnaires d'espace. Dans 90% du temps, tu utiliseras pack. Il est simple d'utilisation. Il te faut juste un peu d'habitude pour maitriser toutes les options. Dans la Faq Perl/tk, il y a un script que tu peux utiliser pour tester diverses options et voir le résultat, c'est très instructif.
On utilise grid généralement dès qu'on a une disposition en grille de calcul, ça facilite le positionnement vertical.
pack et grid ne peuvent pas être utilisés dans un même cadre (Frame), pour l'utiliser dans la même fenêtre, il faut que chacun soit utilisé dans un cadre différent. Exemple :
Je crée un cadre avec Frame et à l'intérieur je place des image et champ via pack. Je crée un 2ème cadre dans lequel je crée des boutons que j'aligne via grid.

Pour afficher les résultats ligne à ligne, il y a plusieurs solutions :
- utiliser label avec des \n. Mais ce n'est pas très jolie, surtout si les lignes de résultat sont longues.
- tu peux utiliser un Widget Text, tu pourras même y associer une barre scrollebar.

Voilà

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

Merci pour ces conseils Djibril, je vais y regarder.

Mon script ne fonctionne que si j'enlève les lignes d'affichage :

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
	while ( my($s, $t) = each %h_tm ){
 
		$fenetre_resultat->Label(
		    -text       => "$s : $t",
		    -foreground => 'white',
		    -background => 'blue',
		)->grid( -row => $r, -column => 0, -sticky => 'w' );
 
		$r++;
	}
 
	if ( int(@a_tm) > 1 ){
		$fenetre_resultat->Label(
		    -text       => "$seq : $moyenne_tm",
		    -font => "courrier 10 bold",
		    -foreground => 'white',
		    -background => 'blue',
		)->grid( -row => $r, -column => 0, -sticky => 'w', -pady => 20 );	
	}

Où est mon erreur?
Cela serait-il plus simple avec pack?

Merci,

Débuter en Perl/Tk

Interfaces Graphiques Perl

Discussions similaires

Partager

Partager