<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl -w  
use lib 'C:/Perl64/cpan/build/Tk-804.028_503';
use lib 'C:/Perl64/cpan/build/Tk-804.028_503';

use Tk;
use Cwd;
use Tk::DirSelect;
use Tk::ROText;
require Tk::Pane;

#################################################################################
#										#
#	Script name:	Bracket.pl						#
#	Author: 	Anneleen Van Geystelen					#
#	Version:	v1.0							#
#	Created:	18/06/2011						#
#	Last Modified:	02/03/2012						#
#										#
#	Description:	This Perl script is the Tk frame around the script	#
#			Bracket_batch.pl which can also be run without this GUI.#
#										#
# 	PERL MODULES:	Tk							#
#			Cwd							#
#			Tk::DirSelect						#
#			Tk::ROText						#
#			Tk::Pane						#
#										#
#################################################################################

#################################################################################
#				VARIABLES					#
#################################################################################

#################################################################################
#				END OF VARIABLES				#
#################################################################################

#################################################################################
#			 PERL SUBROUTINES					#
#################################################################################

# Change backslashes in forward slashes and forward slashes in backslashes depending on the system.
sub getPathRigth {
	my ($path) = @_;
	while ($path =~ m/\\/ ) {
		$path =~ s/\\/\//; 
	}
	return $path;
}

#################################################################################
#			END OF PERL SUBROUTINES 		  		#
#################################################################################

# Keep track of number of runs.
my $run = 0;

# Open main window. 
my $mw = new MainWindow;
$mw-&gt;geometry("1000x700+0+0");
$mw-&gt;title("Bracket");

# Create some space above first line. 
my $frm_name = $mw -&gt; Frame(-pady =&gt; '15') -&gt; pack();
$frm_name-&gt;Label(-text =&gt; "    ", -width =&gt; 15)-&gt;pack(-side =&gt; 'left');

# Create second line.
my $frm_name2 = $mw -&gt; Frame( -pady =&gt; '15') -&gt; pack();
$frm_name2-&gt;Label(-text =&gt; "Input Folder  ", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name2-&gt;Button( -text =&gt; "Select", -command =&gt; \&amp;selectFolder2, -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
my $text2 = $frm_name2-&gt;Entry()-&gt;pack(-side =&gt; 'right');
$text2-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 80);

# Create third line.
my $frm_name3 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name3-&gt;Label(-text =&gt; "Case Number  ", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name3-&gt;Label(-text =&gt; "", -width =&gt; 86)-&gt;pack(-side =&gt; 'right');
my $text3 = $frm_name3-&gt;Entry()-&gt;pack(-side =&gt; 'right');
$text3-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 10);

# Create fourth line.
my $frm_name4 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name4-&gt;Label(-text =&gt; "Kit #1  ", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name4-&gt;Label(-text =&gt; "", -width =&gt; 86)-&gt;pack(-side =&gt; 'right');
my $text4 = $frm_name4-&gt;Entry()-&gt;pack(-side =&gt; 'right');
$text4-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 10);

# Create fifth line.
my $frm_name5 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name5-&gt;Label(-text =&gt; "File Kit #1  ", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name5-&gt;Button( -text =&gt; "Select", -command =&gt; \&amp;selectFile5, -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
my $text5 = $frm_name5-&gt;Entry()-&gt;pack(-side =&gt; 'right');
$text5-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 80);

# Create sixth line.
my $frm_name6 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name6-&gt;Label(-text =&gt; "Kit #2  ", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name6-&gt;Label(-text =&gt; "", -width =&gt; 86)-&gt;pack(-side =&gt; 'right');
my $text6 = $frm_name6-&gt;Entry()-&gt;pack(-side =&gt; 'right');
$text6-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 10);	

# Create seventh line.	 
my $frm_name7 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name7-&gt;Label(-text =&gt; "File Kit #2  ", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name7-&gt;Button( -text =&gt; "Select", -command =&gt; \&amp;selectFile7, -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
my $text7 = $frm_name7-&gt;Entry()-&gt;pack(-side =&gt; 'right');
$text7-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 80);

# Create eighth line. 		 
my $frm_name8 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name8-&gt;Label(-text =&gt; "Output Folder  ", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name8-&gt;Button( -text =&gt; "Select", -command =&gt; \&amp;selectFolder8, -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
my $text8 = $frm_name8-&gt;Entry()-&gt;pack(-side =&gt; 'right');
$text8-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 80);

# Create ninth line. 		 
my $frm_name80 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name80-&gt;Label(-text =&gt; "Thresholds Soft Brackets", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name80-&gt;Label( -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
my $text80 = $frm_name80-&gt;Entry(-text =&gt; "Use the \"Enter Thresholds\" button.")-&gt;pack(-side =&gt; 'right');
$text80-&gt;configure(-background  =&gt; 'white',
		 -foreground  =&gt; 'black',
		 -width =&gt; 80);

# Create row of buttons. 
my $frm_name9 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame		 
my $enterButton = $frm_name9-&gt;Button( 
		 -text =&gt; "Enter Thresholds", 
		 -command =&gt;\&amp;enter, 
		 -width =&gt; 25, 
		 -background=&gt;"black", 
		 -activebackground =&gt; "white", 
		 -foreground  =&gt; 'white', 
		 -activeforeground =&gt; 'black', 
		 -height=&gt;2)-&gt;pack(-side=&gt;'left', -padx=&gt; '40');
my $runButton = $frm_name9-&gt;Button( 
		 -text =&gt; "Run", 
		 -command =&gt;\&amp;run, 
		 -width =&gt; 25, 
		 -background=&gt;"black", 
		 -activebackground =&gt; "white", 
		 -foreground  =&gt; 'white', 
		 -activeforeground =&gt; 'black', 
		 -disabledforeground =&gt; 'darkgrey', 
		 -height=&gt;2)-&gt;pack(-side=&gt;'left', -padx=&gt; '40');	 
$frm_name9-&gt;Button( 
		 -text =&gt; "Exit", 
		 -command =&gt;sub{exit}, 
		 -width =&gt; 25, 
		 -background=&gt;"black", 
		 -activebackground =&gt; "white", 
		 -foreground  =&gt; 'white', 
		 -activeforeground =&gt; 'black', 
		 -height=&gt;2)-&gt;pack(-side=&gt;'left', -padx=&gt; '40');

# Create output box. 
my $frm_name10 = $mw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame
$frm_name10-&gt;Label(-text =&gt; "", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
$frm_name10-&gt;Label( -text =&gt; "", -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
my $text10 = $frm_name10-&gt;Scrolled('ROText', -scrollbars=&gt;"oe") -&gt; pack;
		 	 
MainLoop;

#################################################################################
#				 TK SUBROUTINES					#
#################################################################################

# Open window to select script file.
sub selectFile1 {
	my $file = $mw-&gt;getOpenFile();
	$file = getPathRigth($file);
	$text1-&gt;delete(0, 'end'); 
	$text1-&gt;insert("end", "$file"); 
}

# Open window to select input directory.
sub selectFolder2 {
	my $ds  = $mw-&gt;DirSelect();
	my $dir = $ds-&gt;Show();
	$dir = getPathRigth($dir);
	$text2-&gt;delete(0, 'end'); 
	$text2-&gt;insert("end", "$dir"); 	
}

# Open window to select input file for kit 1.
sub selectFile5 {
	my $file = $mw-&gt;getOpenFile();
	$file = getPathRigth($file);
	$text5-&gt;delete(0, 'end'); 
	$text5-&gt;insert("end", "$file"); 
}

# Open window to select input file for kit 2.
sub selectFile7 {
	my $file = $mw-&gt;getOpenFile();
	$file = getPathRigth($file);
	$text7-&gt;delete(0, 'end'); 
	$text7-&gt;insert("end", "$file"); 
}

# Open window to select output directory.
sub selectFolder8 {
	my $ds  = $mw-&gt;DirSelect();
	my $dir = $ds-&gt;Show();
	$dir = getPathRigth($dir);
	$text8-&gt;delete(0, 'end'); 
	$text8-&gt;insert("end", "$dir"); 	
}

# Replaces spaces in path of file or directory.
sub replaceSpacesInPath {
	my ($string) = @_;
	my $offset = length($string);
	my $result = rindex($string, " ", $offset);
	my @results;
	while ($result != -1) {
		push(@results, $result);
		$offset = $result - 1;
		$result = rindex($string, " ", $offset);
	}  

	foreach $result (@results) {
		$string = substr($string, 0, $result)."\\".substr($string, $result, length($string));
	}
	return $string;
}

# Run script.
sub enter {
	%markers;
	my $kit1File = $text5-&gt;get();
	my $kit2File = $text7-&gt;get();
	if ($kit1File ne '') {
		if (!(-e $kit1File)) {
			$text10-&gt;delete('1.0', 'end'); 
			$text10-&gt;insert('end', "Please give a valid path to file of kit #1.\n");
		} elsif (!(-e $kit2File) &amp;&amp; $kit2File ne '') {
			$text10-&gt;delete('1.0', 'end'); 
			$text10-&gt;insert('end', "Please give a valid path to file of kit #2.\n");
		} else {
			open (KIT1, "&lt; $kit1File");
			# Put all markers of kit #1 in hash. 
			while (&lt;KIT1&gt;) {
				my $line = $_; 
				chomp($line); 
				$line =~ s/\x{d}//;
				$markers{$line} = 0.5; 
			}
			close KIT1;
			# Put all markers of kit #2 in array. 
			if ($kit2File ne '') {
				open (KIT2, "&lt; $kit2File");
				while (&lt;KIT2&gt;) {
					my $line = $_; 
					$line =~ s/\x{d}//;
					chomp($line); 
					$markers{$line} = 0.5; 
				}
				close KIT2;
			}
			# Create new window.
			$sw = new MainWindow;
			$sw-&gt;geometry("500x700+1050+0");
			$sw-&gt;title("Bracket: give thresholds per marker");
			# Create boxes for each of the markers.
			my $pane = $sw-&gt;Scrolled('Pane', Name =&gt; 'scroll test',
				       -width =&gt; 600,
				       -height =&gt; 400,
				       -scrollbars =&gt; 'osoe',
				       -sticky =&gt; 'ne',
				      );
			$pane-&gt;pack;
			foreach $marker (sort keys %markers) {
				${"frm".$marker} = $pane -&gt; Frame(-pady =&gt; '15') -&gt; pack();
				${"frm".$marker}-&gt;Label(-text =&gt; "$marker  ", -width =&gt; 15, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
				${"frm".$marker}-&gt;Label(-text =&gt; "", -width =&gt;40)-&gt;pack(-side =&gt; 'right');
				${"text".$marker} = ${"frm".$marker}-&gt;Entry(-text=&gt;$markers{$marker})-&gt;pack(-side =&gt; 'right');
				${"text".$marker}-&gt;configure(-background  =&gt; 'white',
						 -foreground  =&gt; 'black',
						 -width =&gt; 10);
			}
			# Create file select box.
			my $frm0 = $sw -&gt; Frame() -&gt; pack(-pady =&gt; '15'); #New Frame	
			$frm0-&gt;Label(-text =&gt; "", -width =&gt;10)-&gt;pack(-side =&gt; 'right');
			$frm0-&gt;Label(-text =&gt; "OR", -width =&gt; 15, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
			$frm1 = $sw-&gt;Frame()-&gt;pack(-pady =&gt; '15'); #New Frame	
			$frm1-&gt;Label(-text =&gt; "File with thresholds ", -width =&gt; 15, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
			$frm1-&gt;Button( -text =&gt; "Select", -command =&gt; \&amp;selectFileParam, -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
			$text1a = $frm1-&gt;Entry(-text=&gt;'')-&gt;pack(-side =&gt; 'right');
			$text1a-&gt;configure(-background  =&gt; 'white',
					 -foreground  =&gt; 'black',
					 -width =&gt; 80);

			$frmButton = $sw-&gt;Frame()-&gt;pack(-pady =&gt; '15'); #New Frame		 
			$enterButton = $frmButton-&gt;Button( 
					 -text =&gt; "Enter", 
					 -command =&gt;\&amp;pass, 
					 -width =&gt; 25, 
					 -background=&gt;"black", 
					 -activebackground =&gt; "white", 
					 -foreground  =&gt; 'white', 
					 -activeforeground =&gt; 'black', 
					 -height=&gt;2)-&gt;pack(-side=&gt;'left', -padx=&gt; '40');

			# Create output box. 
			$frmOut = $sw-&gt;Frame()-&gt; pack(-pady =&gt; '15'); #New Frame
			$frmOut-&gt;Label(-text =&gt; "", -width =&gt; 25, -anchor=&gt;'e')-&gt;pack(-side =&gt; 'left');
			$frmOut-&gt;Label( -text =&gt; "", -width =&gt; 15 )-&gt;pack(-side =&gt; 'right');
			$textOut = $frmOut-&gt;Scrolled('ROText', -scrollbars=&gt;"oe") -&gt; pack;
			
			
			sub selectFileParam {
				my $file = $sw-&gt;getOpenFile();
				$file = getPathRigth($file);
				$text1a-&gt;delete(0, 'end'); 
				$text1a-&gt;insert("end", "$file"); 
			}		
			
			sub pass {
				my $values;
				my @thresholds;
				$filename = $text1a-&gt;get();
				if ($filename eq '') {
					foreach $marker (sort keys %markers) {
						$value = ${"text".$marker}-&gt;get();
						$values = $values."$marker $value ";
						push(@thresholds, $value);
					}
				} else {
					open (FILE, "&lt; $filename");
					while (&lt;FILE&gt;) {
						my $line = $_; 
						chomp($line);
						($marker, $value) = split(/\t/,$line); 
						$values = $values."$marker $value ";
						push(@thresholds, $value);
					}
					close FILE;
				}
				if (testThresholds(@thresholds) eq 0) {
					# Print comment in box.
					if ($textOut-&gt;get('1.0', 'end') eq "\n") {
						$textOut-&gt;insert("end", "Please give thresholds between 0  and 1 for each marker.\n");
					}
				} else {
					# Print values in box.
					$text80-&gt;delete('0', 'end');
					while ($values =~ /\x{d}/) {
						$values =~ s/\x{d}//;
					}
					$text80-&gt;insert("end", "$values");
					$textOut-&gt;insert("end","OK.\n");
					$sw-&gt;destroy;
				}
			}
		}
	} else {
		# Print comment in box.
		$text10-&gt;delete('1.0', 'end'); 
		$text10-&gt;insert("end", "Please give valid paths to files of the kits.\n");
	}

}

# Run script.
sub run {
	$run++;
	my $dir = getcwd;
	my $script = $dir."/Bracket_batch.pl";
	# my $arg0 = "\'".getPathRigth($script)."\'";
	my $arg0 = getPathRigth($script);
	my $arg1 = $text2-&gt;get();
	$arg1 = replaceSpacesInPath($arg1);

	my $arg2 = $text3-&gt;get();
	my $arg3 = $text4-&gt;get();
	my $arg4 = $text5-&gt;get();
	$arg4 = replaceSpacesInPath($arg4);

	my $arg5 = $text6-&gt;get();
	my $arg6 = $text7-&gt;get();
	$arg6 = replaceSpacesInPath($arg6);
	my $arg7 = $text8-&gt;get();
	$arg7 = replaceSpacesInPath($arg7);

	my $arg8 = $text80-&gt;get();
	my @arg8 = split(/ /, $arg8);
	$text10-&gt;delete('1.0', 'end'); 
	$runButton-&gt;configure(-state =&gt; 'disabled');
	if ($arg5 eq '') {$arg5 = '-'}
	if ($arg6 eq '') {$arg6 = '-'}
	if ($arg1 ne '' &amp;&amp; $arg2 ne '' &amp;&amp; $arg3 ne '' &amp;&amp; $arg4 ne '' &amp;&amp; $arg5 ne '' &amp;&amp; $arg6 ne '' &amp;&amp; $arg7 ne '' &amp;&amp; $arg8 ne '') {
		$text10-&gt;insert("end", "Run $run\nProgram started\n");
		my @results = `perl $arg0 $arg1 $arg2 $arg3 $arg4 $arg5 $arg6 $arg7 @arg8`;
		if (@results ne "") {
			$text10-&gt;insert("end", "\n\t@results\n");
		} 
		$text10-&gt;insert("end", "Program ended\n");
	} else {
		$text10-&gt;insert("end", "Run $run\n\n\tPlease fill in all fields.\n");
	}
	$runButton-&gt;configure(-state =&gt; 'normal');
}

sub testThresholds {
    my @list = @_;
    my $ret = 1;
    foreach $threshold (@list) {
    	if ($threshold eq '' || $threshold &lt; 0 || $threshold &gt; 1) {
    		$ret = 0;
    	}
    }
    return $ret;
}
</pre></body></html>