#!/usr/bin/perl -w use strict; use Tk; use Tk::ErrorDialog; use Tk::Label; use Tk::Button; use Tk::Checkbutton; use Tk::Frame; use Tk::Entry; use Tk::Radiobutton; use Tk::Scale; use Tk::Scrollbar; use Tk::Text; use Tk::LabEntry; use Tk::LabFrame; use Tk::ErrorDialog; use File::Basename; &main(); sub main { my $mw = MainWindow->new(-title=>'FRICK'); my $inputfr = $mw->LabFrame(-label=>'Filter/Retrieve IDs by Charlie Kim', -labelside=>'acrosstop' )->pack(-side=>'top', -anchor=>'nw', -fill=>'both', ); my $datafile; my $datafile_e = $inputfr->LabEntry(-state=>'normal', -label=>'.pcl or .cdt data file', -labelPack=> [qw/-side left -anchor e/], -textvariable=> \$datafile, -width=>30, -background=>'white', )->grid(-row=>0, -column=>0, -sticky=>'e', ); $inputfr->Button(-text=>'Browse', -command=> [ \&selectsinglefile , \$mw, \$datafile_e ], -borderwidth=>1, -padx=> 0, -pady=> 0, )->grid(-row=>0, -column=>1, ); my $idfile; my $idfile_e = $inputfr->LabEntry(-state=>'normal', -label=>'ID list file', -labelPack=> [qw/-side left -anchor e/], -textvariable=> \$idfile, -width=>30, -background=>'white', )->grid(-row=>1, -column=>0, -sticky=>'e', ); $inputfr->Button(-text=>'Browse', -command=> [ \&selectsinglefile , \$mw, \$idfile_e ], -borderwidth=>1, -padx=> 0, -pady=> 0, )->grid(-row=>1, -column=>1, ); $mw->Button(-text=>"Filter IDs", -command=> [\&fickmain,\$datafile,\$idfile,\$mw], -state=> 'normal', )->pack(); $mw->Button(-text=>"Retrieve IDs", -command=> [\&rickmain,\$datafile,\$idfile,\$mw], -state=> 'normal', )->pack(); $mw->Button(-text=>"Exit", -command=> sub { exit }, )->pack(); MainLoop; } sub rickmain { my ($datafileref, $idfileref, $mwref) = @_; my $mw = $$mwref; if (!$$datafileref || !$$idfileref) { $mw->messageBox(-title=>'File not specified', -message=>'Must specify data and ID files', -type=>'OK', ); return; } open(IDFILE,"$$idfileref") or die "Could not open ID file\n"; my %id; while() { chomp; $_ =~ s/\t//g; $id{$_}++; } close IDFILE; open(DATAFILE,"$$datafileref") or die "Could not open data file\n"; my $defaultsave = basename($$datafileref); $defaultsave =~ s/\.(\w{3})$//; $defaultsave .= "_retrieved\.pcl"; my $savetypes = [ "{All files} * ", "{PCL files} {.pcl} ", "{CDT files} {.cdt} ", "{Text files} {.txt} ", ]; my $outfile = $mw->getSaveFile(-title=>'Save Results As', -filetypes=>$savetypes, -initialfile=>$defaultsave, ); if (!$outfile) { $mw->messageBox(-title=>'Output file required', -message=>'No output file specified', -type=>'OK', ); return; } open(OUTFILE,">$outfile") or die "Could not open output file\n"; # my $filtercount = 0; my $retrievecount = 0; chomp($_=); my $cdt = 0; $cdt++ if /^GID/; print OUTFILE "$_\n"; while() { chomp; print OUTFILE "$_\n" if /^EWEIGHT/; my @line = split(/\t/); next unless $line[$cdt]; # print "DATA: $line[$cdt]\n" if $line[$cdt] eq 'SCUT85'; if ($id{$line[$cdt]}) { # $filtercount++;# $retrievecount++; print OUTFILE "$_\n"; next; } # print OUTFILE "$_\n"; # $filtercount++; } close DATAFILE; close OUTFILE; $mw->messageBox(-title=>'Program Finished', -message=>"Processing complete\nRetrieved $retrievecount IDs\n", -type=>'OK', ); } sub fickmain { my ($datafileref, $idfileref, $mwref) = @_; my $mw = $$mwref; if (!$$datafileref || !$$idfileref) { $mw->messageBox(-title=>'File not specified', -message=>'Must specify data and ID files', -type=>'OK', ); return; } open(IDFILE,"$$idfileref") or die "Could not open ID file\n"; my %id; while() { chomp; $_ =~ s/\t//g; $id{$_}++; } close IDFILE; open(DATAFILE,"$$datafileref") or die "Could not open data file\n"; my $defaultsave = basename($$datafileref); $defaultsave =~ s/\.(\w{3})$//; $defaultsave .= "_filtered\.pcl"; my $savetypes = [ "{All files} * ", "{PCL files} {.pcl} ", "{CDT files} {.cdt} ", "{Text files} {.txt} ", ]; my $outfile = $mw->getSaveFile(-title=>'Save Results As', -filetypes=>$savetypes, -initialfile=>$defaultsave, ); if (!$outfile) { $mw->messageBox(-title=>'Output file required', -message=>'No output file specified', -type=>'OK', ); return; } open(OUTFILE,">$outfile") or die "Could not open output file\n"; my $filtercount = 0; chomp($_=); my $cdt = 0; $cdt++ if /^GID/; print OUTFILE "$_\n"; while() { chomp; my @line = split(/\t/); next unless $line[$cdt]; # print "DATA: $line[$cdt]\n" if $line[$cdt] eq 'SCUT85'; if ($id{$line[$cdt]}) { $filtercount++; next; } print OUTFILE "$_\n"; ; } close DATAFILE; close OUTFILE; $mw->messageBox(-title=>'Program Finished', -message=>"Processing complete\nFiltered $filtercount IDs\n", -type=>'OK', ); } sub selectsinglefile { my $mainwindowref = shift; my $mainwindow = $$mainwindowref; my $entryref = shift; my $entry = $$entryref; my $opentypes = [ "{All files} * ", "{PCL files} {.pcl} ", "{CDT files} {.cdt} ", "{Text files} {.txt} ", ]; my $file = $mainwindow->getOpenFile(-filetypes=>$opentypes); if (defined $file and $file ne '') { $entry->delete(0, 'end'); $entry->insert(0, $file); $entry->xview('end'); } }