I am using tk module to build a checklist for user to choose. I am totally beginner to this module. Currently the checklist created is all in the same series column, since it will be a long list, any idea how could I separate few of the options to another column? Also, any idea how to align those text to the left while checkbox to the right? To display it cleanly and neatly.
#!/usr/bin/perl
use Tk;
$main = MainWindow->new();
$label = $main->Label(-text => "Presence Check");
$label->pack();
$frame = $main->Frame(-relief=>"groove", -borderwidth=>2);
#$frame = $main->Frame(-relief=>"groove", -borderwidth=>2)->pack(-side => 'top', -expand => 1, -fill =>'both');
#$frame = $main->Frame->pack(-side => 'left', -fill => 'x');
$check1 = $frame->Checkbutton(-text=>"Document A (docx, pdf)",
-variable=>\$a,
-onvalue=>"APRESENT",
-offvalue=>"AABSENT");
#$check1->pack(-side=>"top");
$check2 = $frame->Checkbutton(-text=>"Document B (xlsx)",
-variable=>\$b,
-onvalue=>"BPRESENT",
-offvalue=>"BABSENT");
$check2->pack(-side=>"top");
$check3 = $frame->Checkbutton(-text=>"C specification",
-variable=>\$c,
-onvalue=>"CPRESENT",
-offvalue=>"CABSENT");
$check3->pack(-side=>"top");
$check4 = $frame->Checkbutton(-text=>"A-Specification",
-variable=>\$aspec,
-onvalue=>"ASPECPRESENT",
-offvalue=>"ASPECSABSENT");
$check4->pack(-side=>"top");
$check5 = $frame->Checkbutton(-text=>"Important Report",
-variable=>\$report,
-onvalue=>"REPORTPRESENT",
-offvalue=>"REPORTSABSENT");
$check5->pack(-side=>"top");
$check6 = $frame->Checkbutton(-text=>"Handbook",
-variable=>\$handbook,
-onvalue=>"HANDBOOKPRESENT",
-offvalue=>"HANDBOOKABSENT");
$check6->pack(-side=>"top");
$check7 = $frame->Checkbutton(-text=>"Data Spreadsheet",
-variable=>\$dataxls,
-onvalue=>"DATAPRESENT",
-offvalue=>"DATAABSENT");
$check7->pack(-side=>"top");
$check8 = $frame->Checkbutton(-text=>"D file",
-variable=>\$dfile,
-onvalue=>"DFILEPRESENT",
-offvalue=>"DFILEABSENT");
$check8->pack(-side=>"top");
$check10 = $frame->Checkbutton(-text=>"xx doc",
-variable=>\$xxdoc,
-onvalue=>"XXDOCPRESENT",
-offvalue=>"XXDOCABSENT");
$check10->pack(-side=>"top");
$check18 = $frame->Checkbutton(-text=>"yy Doc",
-variable=>\$yydoc,
-onvalue=>"YYDOCPRESENT",
-offvalue=>"YYDOCABSENT");
$check18->pack(-side=>"top");
$frame->pack();
$button = $main->Button(-text => "Exit",
-command => \&exit_button);
$button->pack();
MainLoop();
sub exit_button {
print "$a $b $c $aspec $report $handbook $dataxls $dfile $xxdoc $yydoc \n";
#print "$rv\n";
exit,
}
... any idea how could I separate few of the options to another
column? Also, any idea how to align those text to the left while
checkbox to the right?
Here is an example of how you can use the grid geometry manager to align the labels and checkboxes:
use feature qw(say);
use strict;
use warnings;
use Tk;
my $mw = MainWindow->new();
my #label_texts = (
"Document A (docx, pdf)",
"Document B (xlsx)",
"C specification"
);
my #labels;
my #checkvars;
my #check_buttons;
for my $text ( #label_texts ) {
my $label = $mw->Label(-text => $text);
push #labels, \$label;
my $check_var;
my $check = $mw->Checkbutton(
-text=>"",
-variable=>\$check_var,
);
push #checkvars, \$check_var;
push #check_buttons, \$check;
Tk::grid($label, $check, -sticky => 'w');
}
my $button = $mw->Button(
-text => "Exit",
-command => \&exit_button
);
Tk::grid($button, "-");
MainLoop();
sub exit_button {
for my $i (0..$#checkvars) {
my $var = $checkvars[$i];
my $state = $$var;
$state = 'undef' if !defined $state;
say "Variable $i: ", $state;
}
exit;
}
Please see attached screenshot to this code snippet if it is what you desired
!/usr/bin/perl
#
# vim: ai:ts=4:sw=4
#
use strict;
use warnings;
use feature 'say';
use Tk;
use Data::Dumper;
my $main = MainWindow->new( -title => 'Checkboxes' );
my $label = $main->Label(-text => 'Presence Check');
$label->pack();
my $frame = $main->Frame(-relief=>'groove', -borderwidth=>2);
my $values;
my #chk_boxes = (
[\$values->{doc_a},'Document A (docx, pdf)'],
[\$values->{doc_b},'Document B (xlsx)'],
[\$values->{spec_c},'C specification'],
[\$values->{spec_a},'A-Specification'],
[\$values->{report},'Important Report'],
[\$values->{hand_b},'Handbook'],
[\$values->{data_s},'Data Spreadsheet'],
[\$values->{data_d},'D file'],
[\$values->{doc_xx},'xx doc'],
[\$values->{doc_yy},'yy Doc']
);
check_box(\#chk_boxes);
$frame->pack();
my $button = $main->Button(
-text => 'Exit',
-command => \&exit_button
);
$button->pack();
MainLoop();
sub exit_button {
while( my($k,$v) = each %{$values} ) {
say "$k => $v" if $v;
}
exit;
}
sub check_box {
my $data = shift;
my $index = 0;
for my $chk_box ( #{$data} ) {
my $column = $index % 2;
my $row = int($index/2);
$frame->Checkbutton(
-text => $chk_box->[1],
-variable => $chk_box->[0]
)->grid( -column => $column, -row => $row, -sticky => 'w');
$index++;
}
}
Perhaps following form of data input may be preferable
#!/usr/bin/perl
#
# vim: ai:ts=4:sw=4
#
use strict;
use warnings;
use feature 'say';
use Tk;
use Data::Dumper;
my $main = MainWindow->new( -title => 'Checkboxes' );
my $label = $main->Label(-text => 'Presence Check');
$label->pack();
my $frame = $main->Frame(-relief=>'groove', -borderwidth=>2);
my $values;
my #chk_boxes;
while( <DATA> ) {
chomp;
my($var,$desc) = split '\t';
push #chk_boxes, [\$values->{$var}, $desc];
}
check_box(\#chk_boxes);
$frame->pack();
my $button = $main->Button(
-text => 'Exit',
-command => \&exit_button
);
$button->pack();
MainLoop();
sub exit_button {
while( my($k,$v) = each %{$values} ) {
say "$k => $v" if $v;
}
exit;
}
sub check_box {
my $data = shift;
my $index = 0;
for my $chk_box ( #{$data} ) {
my $column = $index % 2;
my $row = int($index/2);
$frame->Checkbutton(
-text => $chk_box->[1],
-variable => $chk_box->[0]
)->grid( -column => $column, -row => $row, -sticky => 'w');
$index++;
}
}
__DATA__
doc_a Document A (docx, pdf)
doc_b Document B (xlsx)
spec_c C specification
spec_a A-Specification
report Important Report
hand_b Handbook
data_s Data Spreadsheet
data_d D file
doc_xx xx Doc
doc_yy yy Doc
Add-on:
sub check_box {
my $data = shift;
my $index = 0;
for my $chk_box ( #{$data} ) {
my $column = $index % 2;
my $row = int($index/2);
my $chk_x = $frame->Checkbutton(
-text => $chk_box->[1],
-variable => $chk_box->[0]
)->grid( -column => $column, -row => $row, -sticky => 'w');
$chk_x->select if $index == 4;
$index++;
}
}
I have a GUI that runs a script from a command button, but how can I get it to display output in the text widget?
If I wanted to display the output via a logfile insert, could I have the command on the same button/sub as the run button?
use warnings;
use strict;
use Tk;
use Tk::Text ;
use POSIX 'strftime';
my $DATE = strftime("Report.pl for %dth %b %Y" , localtime());
my $mw = MainWindow->new;
my $filename = "c:\\Temp\\perl.txt";
$mw->geometry("720x500");
$mw->title(" backupadmin ");
my $main_frame = $mw->Frame()->pack(-side => 'top', -fill => 'x');
my $left_frame = $main_frame->Frame(-background => "snow2")->pack(-side => 'left', -fill => 'y');
my $right_frame = $main_frame->Scrolled("Text", -scrollbars => 'se',-background => "black",-foreground => "yellow",-height => '44')->pack(-expand => 1, -fill => 'both');
my $failures_button = $left_frame->Button(-text => " $DATE ",
-command => [\&runscript])->pack;
my $Close_button = $left_frame->Button(-text => ' Close ',
-command => [$mw => 'destroy'])->pack;
my $Help_button = $left_frame->Button(-text => " Help Guide ",
-command => [\&load_file])->pack(-side => "bottom");
my $Close_help = $left_frame->Button(-text => ' Close Help ',
-command => [$right_frame => \&clear_file])->pack(-side => "bottom");
MainLoop;
sub runscript {
system("report.pl");
}
sub load_file {
open (FH, "$filename");
while (<FH>) { $right_frame->insert("end", $_); }
close (FH);
}
sub clear_file {
$right_frame->('quit');
}
If your report.pl script outputs to STDOUT, then you could try something like this in your runscript callback:
sub runscript {
right_frame->delete('1.0','end');
my $text = `report.pl`;
$right_frame->insert('end', $text);
}
Alternatively, if report.pl outputs to c:\temp\perl.txt then you could try the following:
sub runscript {
right_frame->delete('1.0','end');
system("report.pl");
load_file();
}
I am trying to plot SNPs onto a gene (or below). The code I have is the following:
#!/usr/bin/perl
use strict;
use warnings;
use Bio::Graphics;
use Bio::SeqFeature::Generic;
my #SNPs = "408777 408900 409100 409480";
my $gene_name = "GSTd10";
my $scaffold = "KB668289";
my $gene_start = 408763;
my $gene_end = 409489;
my $length = $gene_end - $gene_start + 50;
open my $png, ">", "$gene_name.png" or die "Cannot open $gene_name.png: $!\n";
#Create a panel for the image#
my $panel=Bio::Graphics::Panel->new(-offset => $gene_start, -length => $length, -width => 1000, -pad_left => 100, -pad_right => 10, -pad_top => 10);
my $track_whole=$panel->add_track(-glyph => 'graded_segments', -label => 1, -bgcolor => 'black', -font2color => 'black',);
my $feature= Bio::SeqFeature::Generic->new(-display_name => $gene_name, -start => $gene_start, -end => $gene_end,);
$track_whole->add_feature($feature);
my $track=$panel->add_track(-glyph => 'graded_segments', -label => 1, -bgcolor =>'blue', -min_score => 0, -max_score => 30, -font2color => 'black');
foreach my $SNP (#SNPs)
{
my $feature= Bio::SeqFeature::Generic->new(-label => $SNP, -start => $SNP, -end => $SNP);
$track->add_feature($feature);
}
#This will print out the final panel i.e. you must have created an object called $panel above
print $png $panel -> png;
Whenever I run this script, I only get printed one line.
Where is the mistake in order to print all values in #SNPs? In addition, is there a way of printing ^ instead of a block?
In this line
my #SNPs = "408777 408900 409100 409480";
You're just creating an array with a single element of that whole string.
Try
my #SNPs = qw(408777 408900 409100 409480);
use Thread;
use warnings;
use Tk;
my $x = 10;
my $mw = new MainWindow;
$mw->Label(-text => 'honeywell')->place(-x => $x, -y => 50);
my $thr = new Thread \&sub1;
sub sub1 {
for ($i = 0 ; $i < 20 ; $i++) {
$x += 20;
sleep(2);
$mw->update;
}
}
MainLoop;
I am trying to update the label so that the text appears going down.I want to implement it using thread.But the text os not sliding down.Can anyone plz help me?
Try this code:
use strict;
use warnings;
use Tk;
my $x = 10;
my $mw = new MainWindow;
my $label = $mw->Label(-text => 'honeywell')->place(-x => $x, -y => 50);
$mw->repeat(2000, \&sub1);
sub sub1 {
return if $x >= 400;
$x += 20;
$label->place(-x => $x, -y => 50);
$mw->update;
}
MainLoop;
I don't think that this will ever work (using Thread or threads).
place uses the content of $x and does not bind the variable $x. So changing the variable after the initial placement won't do anything to the label.
I want to add a new widget to my script that will open a new window with text and will close automatically after 1sec.
how can I do it ?
I think what you want is Tk::after.
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
my $mw = MainWindow->new;
my $spawn = $mw->Button(
-text => 'spawn',
-command => sub {
my $subwindow = MainWindow->new;
my $label = $subwindow->Label(-text => "spawned");
$label->pack;
$subwindow->after(1_000, sub { $subwindow->destroy; });
}
);
$spawn->pack;
my $exit = $mw->Button(
-text => 'exit',
-command => sub { print "exiting...\n"; exit }
);
$exit->pack;
MainLoop;