Callback perl TK

Version imprimable

Callback perl TK

Bonjour je suis débutant en perl, j'essaye d'intégrer une interface graphique (une simple boite oui non) a un script écrit par un collègue dans le cadre de mon travaille.

Bien évidemment selon la réponse de l'utilsateur a cette boite oui/non le script aura un chemin différent.

Oui ==> on continue a derouler le script
Non ==> on sort du script

J'ai fais un premier essai en essayant d'ajouter le mot clé die dans le callback du bouton non:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 # Creation de la fenetre ( parent widget ) my $mw = MainWindow->new(-title => "Check Teg width"); my $f = $mw->Frame(-borderwidth => 5, -relief => 'groove')->pack(-side => 'top', -fill => 'x'); $f->Label(-text => "${TegName} hasn't a regular width, would you force the release ? \n")->pack; $f->Button(-text => "YES", -command => sub { exit })->pack(-side => 'left', -padx=>50, -pady=>5); $f->Button(-text => "NO", -command => sub { die })->pack(-side => 'right', -padx=>50, -pady=>5); MainLoop; }
Bien entendu ca ne fonctionne pas ;) , je suis passé en mode debugger mais comme c'est une usine a gaz il y a trop d'appel de fichier et vu mon niveau je suis perdu...

J'obtiens ces messages d'erreurs lorsque j'appuie sur le bouton non
Tk::Button::butUp at /perl/5.8.8/Linux/rh5/x86_64/lib/site_perl/5.8.8/x86_64-linux/Tk/Button.pm line 177
<ButtonRelease-1>
(command bound to event)
Tk::Error: Died at /Mydev/src/Config_generator_file/script/Config_generator_file.pl line 164.
Tk callback for .frame.button1
Tk::__ANON__[/perl/5.8.8/Linux/rh5/x86_64/lib/site_perl/5.8.8/x86_64-linux/Tk.pm:251] at /sw/freetools/perl/5.8.8/Linux/rh5/x86_64/lib/site_perl/5.8.8/x86_64-linux/Tk.pm line 251

Ensuite j'ai essyé d'ajouter une fonction car il y a un module associé au script
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 # Creation de la fenetre ( parent widget ) my $mw = MainWindow->new(-title => "Check Teg width"); my $f = $mw->Frame(-borderwidth => 5, -relief => 'groove')->pack(-side => 'top', -fill => 'x'); $f->Label(-text => "${TegName} hasn't a regular width, would you force the release ? \n")->pack; $f->Button(-text => "YES", -command => sub { exit })->pack(-side => 'left', -padx=>50, -pady=>5); $f->Button(-text => "NO", -command =>\&quit)->pack(-side => 'right', -padx=>50, -pady=>5); MainLoop; }
Appel de la fonction quit dans mon module .pm
Code:

1 2 3 4 sub quit { die("\n"); }
idem ca ne fonctionne pas...

La j'en suis au point ou je vais essayer ==> si j'appuie sur le bouton non je modifie une variable et fonction de l'état de la variable je rentre dans une structure de controle ( un if) et je fais un die du script mais je trouve cette méthode peu élégante...

Merci pour votre aide.

Bonjour,

Quelque soit le langage de programmation et de surcroit quand on code des interfaces graphiques, l'indentation est primordiale car on s'y perd très vite.
Regarde la FAQ Perl/Tk, elle contient pas mal de réponses à tes futurs questions.

Voilà un programme conçu pour toi, il t'aidera je l'espère à continuer :

Code:

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
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
 
# Creation de la fenetre ( parent widget )
my $mw = MainWindow->new( -title => "Check Teg width" );
my $mon_cadre = $mw->Frame(
	-borderwidth => 5,
	-relief      => 'groove'
);
 
my $label = $mon_cadre->Label( -text => "Souhaitez-vous stopper le programme ?" );
 
my $bouton_yes = $mon_cadre->Button(
	-text    => "YES",
	-command => \&arret_programme,
);
 
my $bouton_non = $mon_cadre->Button( 
	-text => "NO", 
	-command => \&fermer_interface_graphique, 
);
 
$label->pack();
$mon_cadre->pack( -side => 'top', -fill => 'x' );
$bouton_yes->pack( -side => 'left',  -padx => 50, -pady => 5 );
$bouton_non->pack( -side => 'right', -padx => 50, -pady => 5 );
 
MainLoop;
 
print "suite de mon programme\n";
 
sub fermer_interface_graphique {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub arret_programme {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
 
	# Arrêt du programme complet
	exit;
}

03/08/2017, 11h26
julien terrier

Bonjour,

merci pour le retour, effectivement pour l'indentation je n'ai pas vraiment suivi le standard mais je l'ai fait consciemment ;) surement a tord, cette façon me semblait plus lisible, pas assez l'habitude...

Merci pour le programme je vais m'appuyer sur ta proposition ;) .

Une question, c'est par soucis de compréhension que tu as séparé la création des widget et leurs affichages ou bien tu fonctionnes tout le temps comme ca ?

Merci pour ton aide.
03/08/2017, 13h47
djibril

Bonjours,

J'essaye toujours de séparer le code d'affichage, c'est mieux pour la lisibilité, la compréhension, la maintenance...

Merci j'ai réussi ma boite avec tes conseils ;)

Code:

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
# Module create IHM
 
sub ihm_box_yesno
{
# Creation de la fenetre ( parent widget )
my $mw = MainWindow->new(-title => "Check Teg width");
my $frame = $mw->Frame(
	-borderwidth => 5, 
	-relief => 'groove'
);
 
$frame->Label(-text => "${TegName} hasn't a regular width, would you force the release ? \n",
	      -foreground => 'red' )->pack;
 
my $button_yes = $frame->Button(
		-text => "YES", 
		-command => \&close_ihm,
);
 
my $button_no = $frame->Button(
		-text => "NO", 
		-command =>  \&close_program,
); 
 
$frame->pack( -side => 'top', -fill => 'x' );							  
$button_yes->pack( -side => 'left',  -padx => 50, -pady => 5 );
$button_no->pack( -side => 'right', -padx => 50, -pady => 5 );
 
MainLoop;
 
sub close_ihm {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
}
 
sub close_program {
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl 
	$mw->destroy;
	print "\n";
	print "***************************************************************************\n";
	print "*                                                                         *\n";
	print "*                    Config_generator_file was aborted                    *\n";
	print "*                                                                         *\n";
	print "***************************************************************************\n";
	print "\n";
 
	# Arrêt du programme complet
	exit;
}
}
1;

03/08/2017, 22h23
djibril

Hum, ce n'est pas bien d'imbriquer des sous-programmes (sub).

Voilà, c'est mieux ainsi :

Code:

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
sub ihm_box_yesno {
 
	# Creation de la fenetre ( parent widget )
	my $mw = MainWindow->new( -title => "Check Teg width" );
	my $frame = $mw->Frame(
		-borderwidth => 5,
		-relief      => 'groove'
	);
 
	my $label = $frame->Label(
		-text       => "${TegName} hasn't a regular width, would you force the release ? \n",
		-foreground => 'red'
	);
 
	my $button_yes = $frame->Button(
		-text    => "YES",
		-command => [\&close_ihm, $mw],
	);
 
	my $button_no = $frame->Button(
		-text    => "NO",
		-command => [\&close_program, $mw],
	);
 
	$label->pack();
	$frame->pack( -side => 'top', -fill => 'x' );
	$button_yes->pack( -side => 'left', -padx => 50, -pady => 5 );
	$button_no->pack( -side => 'right', -padx => 50, -pady => 5 );
 
	MainLoop;
}
 
sub close_ihm {
	my $mw = shift;
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl
	$mw->destroy;
}
 
sub close_program {
	my $mw = shift;
 
	# Destruction de l'interface graphique, mais pas arrêt du programme Perl
	#$mw->destroy;
	print "\n";
	print "***************************************************************************\n";
	print "*                                                                         *\n";
	print "*                    Config_generator_file was aborted                    *\n";
	print "*                                                                         *\n";
	print "***************************************************************************\n";
	print "\n";
 
	# Arrêt du programme complet
	exit;
}
 
1;

04/08/2017, 10h57
julien terrier

Oui les arguments ;) j'ai pas eu le temps de répondre que tu avais déjà fais la correction ;)....

Grazie