#!/usr/bin/perl -- #~ #~ 2014-05-11-19:59:34 #~ ## perltidy -olq -csc -csci=10 -cscl="sub : BEGIN END if " -otr -opr -ce -nibc -i=4 -pt=0 "-nsak=*" #!/usr/bin/perl -- use Tk; use strict; Main( @ARGV ); exit( 0 ); sub Main { my $mw = MainWindow->new; $mw->geometry( "200x300" ); $mw->title( "MAIN WINDOW" ); my $button_frame1 = $mw->Frame()->pack( -side => "top" ); $button_frame1->Button( -text => "GI EXTRACTOR", -command => \&window1 ) ->pack(); MainLoop; } ## end sub Main sub window1 { my $mw = MainWindow->new; $mw->geometry( "700x700" ); $mw->title( "GI EXTRACTOR WINDOW" ); my $button_frame1 = $mw->Frame()->pack( -side => "top" ); my $lname1; ## eew var name:) #~ $button_frame1->Button(-text => "Browse File", -command => \&update_output1)->pack(-side => "top"); $button_frame1->Button( -text => "Browse File", -command => [ \&update_output1, $mw, \$lname1 ] )->pack( -side => "top" ); my $bf1 = $mw->Frame()->pack( -side => "top" ); $bf1->Label( -text => "You Have Selected The Following File" ) ->pack( -side => "left" ); $bf1->Entry( -bg => 'red', -textvariable => \$lname1 ) ->pack( -side => "left" ); my $b_f1 = $mw->Frame()->pack( -side => "top" ); #~ $b_f1->Button(-text => "Ok", -command => \&u_o1)->pack(-side => "bottom"); my $output_frame1 = $mw->Frame()->pack( -side => "bottom" ); my $output_scroll1 = $output_frame1->Scrollbar(); my $output_text1 = $output_frame1->Text( -yscrollcommand => [ 'set', $output_scroll1 ] ); $output_scroll1->configure( -command => [ 'yview', $output_text1 ] ); $output_scroll1->pack( -side => "right", -expand => "no", -fill => "y" ); $output_text1->pack(); $b_f1->Button( -text => "Ok", -command => [ \&u_o1, $output_text1, \$lname1 ] )->pack( -side => "bottom" ); } ## end sub window1 sub update_output1 { #~ my $button_frame1 = $mw->getOpenFile(); #~ my $button_frame1 = shift( @_ )->getOpenFile(); my( $mmmwww, $lnameref ) = @_; my $button_frame1 = $mmmwww->getOpenFile(); $$lnameref = $button_frame1; } sub u_o1 { my( $output_text1, $lnameref ) = @_; my $output1; use autodie; #~ open( FH, "<$lname1" ); open my( $fh ), '<', $$lnameref; while( my $_ = ) { if( $_ =~ /^>gi/ ) { my @arr = split( /\|/, $_ ); $output1 = $arr[0] . $arr[1]; } } close( $fh ); $output_text1->delete( '0.0', 'end' ); $output_text1->insert( "end", $output1 ); } ## end sub u_o1