#!/usr/local/bin/perl -w
#
# This software has been created by Genome Research Limited (GRL). 
# GRL hereby grants permission to use, copy, modify and distribute 
# this software and its documentation for non-commercial purposes 
# without fee at the user's own risk on the basis set out below.
# GRL neither undertakes nor accepts any duty whether contractual or 
# otherwise in connection with the software, its use or the use of 
# any derivative, and makes no representations or warranties, express
# or implied, concerning the software, its suitability, fitness for
# a particular purpose or non-infringement.
# In no event shall the authors of the software or GRL be responsible 
# or liable for any loss or damage whatsoever arising in any way 
# directly or indirectly out of the use of this software or its 
# derivatives, even if advised of the possibility of such damage.
# Our software can be freely distributed under the conditions set out 
# above, and must contain this copyright notice.




package Barcode;
use Checkbarcode;
use WrapDBI;
use Tk;

@ISA = qw(Checkbarcode);

*ESC 	= \chr(27);
*LF	= \chr(10);
*NULL 	= \chr(0);




sub new
{
my $pkg = shift;

my $setup	={	Label		=> [],
			Printer		=> '',
			Type		=> '',
			Quantity	=> '0001',
			Barcode		=> '',
			Name		=> '',
			Project		=> '',
			Owner		=> '',
			Suffix		=> '',
			User		=> '',
			Date		=> '',
			DHDL		=> 'NOTUSED',
			FHDL		=> '',
			HeaderLabel	=> 1,
			FooterLabel	=> 0};
			
if(@_)
{
	$setup->{"DHDL"} = shift;
}
else
{
	warn "No Database Handle Defined For Use By Barcode Module\n";
}
			
			
my ($d, $m, $y) = (localtime)[3,4,5];
$y = $y + 1900;
$m = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[$m];
$setup->{"Date"} = uc("$d-$m-$y");

$setup->{"User"} = `whoami`;
chomp $setup->{"User"};


# Label attribute is an array of hashes
bless $setup,$pkg;
return $setup;
}

############################################################
# Accessor methods
############################################################
sub Barcode {
my ($pkg,$t) = @_;
$t ? $pkg->{"Barcode"} = $t : return $pkg->{"Barcode"};
}

sub Name {
my ($pkg,$t) = @_;
$t ? $pkg->{"Name"} = $t : return $pkg->{"Name"};
}

sub Project {
my ($pkg,$t) = @_;
$t ? $pkg->{"Project"} = $t : return $pkg->{"Project"};
}

sub Owner {
my ($pkg,$t) = @_;
$t ? $pkg->{"Owner"} = $t : return $pkg->{"Owner"};
}

sub Suffix {
my ($pkg,$t) = @_;
$t ? $pkg->{"Suffix"} = $t : return $pkg->{"Suffix"};
}

sub Date {
my ($pkg,$t) = @_;
$t ? $pkg->{"Date"} = uc($t) : return $pkg->{"Date"};
}

sub Type {
my ($pkg,$t) = @_;
$t ? $pkg->{"Type"} = $t : return $pkg->{"Type"};
}

sub Quantity {
my ($pkg,$q) = @_;
$q = '0000'.$q;

$q ? $pkg->{"Quantity"} = substr($q,length($q)-4,4) : return $pkg->{"Quantity"};
}

sub HumanReadable {
my ($pkg,$q) = @_;


$q ? $pkg->{"HumanReadable"} = $q : return $pkg->{"HumanReadable"};
}

sub HeaderLabel {
my ($pkg,$p) = @_;

$pkg->{"HeaderLabel"} = $p;
return $pkg->{"HeaderLabel"};
}

sub FooterLabel {
my ($pkg,$p) = @_;

$pkg->{"FooterLabel"} = $p;
return $pkg->{"FooterLabel"};
}







sub Break {
my ($pkg) = @_;

$pkg->{"Barcode"}	= 'BREAK';

$pkg->Labellist();

}

sub User {
my ($pkg,$p) = @_;
$p ? $pkg->{"User"} = $p : return $pkg->{"User"};
}

sub Printer {
my ($pkg,$p) = @_;
$p ? $pkg->{"Printer"} = $p : return $pkg->{"Printer"};
}

###########################################################
# 
###########################################################
sub PrintJobHeaderLabel {
my ($pkg, $type) 	= @_;
my $FHDL 		= $pkg->{"FHDL"};
my $PrintTime 		= localtime();

if($pkg->{"HeaderLabel"} == 0){return;}

$_ = $type;
SWITCH: {

	$_ == 1  && do { 
			print $FHDL $ESC,"PC001;0020,0035,1,1,G,00,B",$LF,$NULL;
			print $FHDL $ESC,"PC002;0020,0065,1,1,G,00,B",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			print $FHDL $ESC,"RC001;Printed By $pkg->{\"User\"}",$LF,$NULL;
			print $FHDL $ESC,"RC002;$PrintTime",$LF,$NULL;
			print $FHDL $ESC,"XS;I,0001,0002C5201",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			
			last SWITCH; 
			};


	$_ == 2  && do { 
			print $FHDL $ESC,"PC001;0112,0020,05,05,H,+02,11,B",$LF,$NULL;
			print $FHDL $ESC,"PC002;0062,0020,05,05,H,+02,11,B",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			print $FHDL $ESC,"RC001;Printed By $pkg->{\"User\"}",$LF,$NULL;
			print $FHDL $ESC,"RC002;$PrintTime",$LF,$NULL;
			print $FHDL $ESC,"XS;I,0001,0002C5201",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			
			last SWITCH; 
			};
			
	warn "Barcode Module : No Header Label defined For Label Type $type\n";
	}#End Of Switch

}
sub PrintJobFooterLabel {
my ($pkg, $type) 	= @_;
my $FHDL 		= $pkg->{"FHDL"};
my $PrintTime 		= localtime();

if($pkg->{"FooterLabel"} == 0){return;}

$_ = $type;
SWITCH: {

	$_ == 1  && do { 
			print $FHDL $ESC,"PC001;0050,0035,1,1,G,00,B",$LF,$NULL;
			print $FHDL $ESC,"PC002;0020,0065,1,1,G,00,B",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			print $FHDL $ESC,"RC001;* THIS IS THE BOTTOM OF YOUR LABEL LIST *",$LF,$NULL;
			print $FHDL $ESC,"RC002;TAKE CARE WHEN APPLYING LABELS TO 384 PLATES",$LF,$NULL;
			print $FHDL $ESC,"XS;I,0001,0002C5201",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			
			last SWITCH; 
			};


	$_ == 2  && do { 
			print $FHDL $ESC,"PC001;0112,0020,05,05,H,+02,11,B",$LF,$NULL;
			print $FHDL $ESC,"PC002;0062,0020,05,05,H,+02,11,B",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			print $FHDL $ESC,"RC001;BOTTOM",$LF,$NULL;
			print $FHDL $ESC,"RC002;$PrintTime",$LF,$NULL;
			print $FHDL $ESC,"XS;I,0001,0002C5201",$LF,$NULL;
			print $FHDL $ESC,"C",$LF,$NULL;
			
			last SWITCH; 
			};
			
	warn "Barcode Module : No Header Label defined For Label Type $type\n";
	}#End Of Switch

}
sub FormatLabel {
my ($pkg, $type) = @_;
my $FHDL = $pkg->{"FHDL"};
my $DriverRef = {};




# Need To ensure printer knows what size label its got
# Oracle says what can run on what.
if($pkg->{"Type"} =~ /LP/){$pkg->FooterLabel(1);} 

$_ = $type;
SWITCH: {
	# Long labels 96 x 8 mm main label type in WP.
	$_ == 1  && do { 
			print $FHDL $ESC,"D0110,0920,0080",$LF,$NULL;
			print $FHDL $ESC,"AY;+08,0",$LF,$NULL;
			print $FHDL $ESC,"AX;+004,+000,+00",$LF,$NULL;
			print $FHDL $ESC,"T20C32",$LF,$NULL;	
		 	last SWITCH; 
			};
			
	# wrap around eppendorf tube labels		
	$_ == 2  && do { 
			print $FHDL $ESC,"D0430,0300,0400",$LF,$NULL;
			print $FHDL $ESC,"AY;+08,0",$LF,$NULL;
			print $FHDL $ESC,"AX;+022,+000,+00",$LF,$NULL;
			print $FHDL $ESC,"T20C32",$LF,$NULL;
			last SWITCH; 
			};
			
	# small eppendorf tube labels (Not In Use)
	$_ == 3  && do { 
			print $FHDL $ESC,"D0250,0300,0210",$LF,$NULL;
			print $FHDL $ESC,"AY;+08,0",$LF,$NULL;
			print $FHDL $ESC,"AX;-000,+000,+00",$LF,$NULL;
			print $FHDL $ESC,"T20C32",$LF,$NULL;
			last SWITCH; 
			};
			
	# Front side microtitre plate labels (Robot/Megabace plates)	
	$_ == 5  && do { 
			print $FHDL $ESC,"D0098,0710,0070",$LF,$NULL;
			#print $FHDL $ESC,"AY;+08,0",$LF,$NULL;
			print $FHDL $ESC,"AX;-000,+000,+00",$LF,$NULL;
			print $FHDL $ESC,"T20C32",$LF,$NULL;
			last SWITCH; 
			};		
	}# end of SWITCH for base label type

# see If user has asked for a header label saying who this print jobe belongs to.
$pkg->PrintJobHeaderLabel($type);



	
# determine label layout using prefix
$_ = $pkg->{"Type"};
SWITCH: {
	# Customised Label Formats
	/^LG/  && do { 
			$pkg->LigationLabel();
			
		 	last SWITCH; 
			};
			
	/^DS/  && do { 
			$pkg->PetriDishLabels();
			
		 	last SWITCH; 
			};	
						
	/^GS/  && do { 
			$pkg->TextOnly_Small();

		 	last SWITCH; 
			};	
			
	/^ID/  && do { 
			$pkg->IdentityLabels();

		 	last SWITCH; 
			};
	/^FZ/  && do { 
			$pkg->FreezerLabels();

		 	last SWITCH; 
			};
			
	/^MS|MR|MW|MA|MP/  && do { 
			$pkg->MicroArrayPlateLabels();

		 	last SWITCH; 
			};
					
	/^MG/  && do { 
			$pkg->MegaBaceLabels();

		 	last SWITCH; 
			};		
	
	/^TR/  && do { 
			$pkg->ReAmplificationLabels();

		 	last SWITCH; 
			};
	
				
	# Default Label Format For Type 1 labels		
	if($type == 1){$pkg->DefaultLabelLayout_1();}
	
	# Default Label Format For Type 2 labels
	if($type == 2){$pkg->DefaultLabelLayout_2();}
	
	}# end of SWITCH for label format
	
$pkg->PrintJobFooterLabel($type);	
}


sub Labellist {
my ($pkg) = @_;


push @{$pkg->{"Label"}},{	"Barcode" 	=> $pkg->{"Barcode"}, 
				"Name" 		=> $pkg->{"Name"},
				"Project" 	=> $pkg->{"Project"}, 
				"Suffix"	=> $pkg->{"Suffix"},
				"Owner" 	=> $pkg->{"Owner"}, 
				"Date" 		=> $pkg->{"Date"},
				"HumanReadable"	=> $pkg->{"HumanReadable"}};

$pkg->{"Barcode"}	= '';
$pkg->{"Name"} 		= '';
$pkg->{"Project"}	= ''; 
$pkg->{"Suffix"} 	= '';
$pkg->{"Owner"}		= '';
$pkg->{"HumanReadable"} = '';


}

sub Checkprinter {
my $pkg = shift;
my $sql;
my $DefaultPrinter;

###################################################
# If printer already defined, assume programmer
# knows what they are doing. (......mmmh)
###################################################




if($pkg->{"DHDL"} ne 'NOTUSED')# Are we using Oracle
{

if(!$pkg->{"Printer"})
{
	if($pkg->{"User"} =~ /^T(\d{1,3})$/)
	{
	# treat owner as a team
	$sql ="	SELECT 	BP.DESCRIPTION, BP.ACTIVE_LABEL
		FROM 	BARCODE_PRINTER BP, DEFAULT_PRINTERS DP, BARCODE_PREFIX BF
		WHERE	BF.ID_PREFIX		= '$pkg->{\"Type\"}'		AND
			BF.ID_LABEL		= BP.ACTIVE_LABEL		AND
			BP.ISCURRENT		= 1				AND
			BP.ID_PRINTER		= DP.ID_PRINTER			AND
			DP.TEAMNAME		= $1				AND
			ROWNUM			= 1";
	}else
	{
	$sql =" SELECT 	BP.DESCRIPTION, BP.ACTIVE_LABEL 
		FROM 	BARCODE_PRINTER BP, DEFAULT_PRINTERS DP, TEAM_PERSON TP, PERSON P, BARCODE_PREFIX BF
		WHERE	BF.ID_PREFIX		= '$pkg->{\"Type\"}'		AND
			BF.ID_LABEL		= BP.ACTIVE_LABEL		AND
			BP.ISCURRENT		= 1				AND
			BP.ID_PRINTER		= DP.ID_PRINTER			AND
			DP.TEAMNAME		= TP.TEAMNAME			AND	
			TP.ID_PERSON		= P.ID_PERSON			AND
			P.ISCURRENT		= 1				AND	
			P.EMAIL			= '$pkg->{\"User\"}'		AND
			ROWNUM			= 1";
	}
	

}
else
{

	$sql ="	SELECT 	BP.DESCRIPTION, BP.ACTIVE_LABEL
		FROM 	BARCODE_PRINTER BP, DEFAULT_PRINTERS DP, BARCODE_PREFIX BF
		WHERE	BF.ID_PREFIX		= '$pkg->{\"Type\"}'		AND
			BF.ID_LABEL		= BP.ACTIVE_LABEL		AND
			BP.ISCURRENT		= 1				AND
			BP.DESCRIPTION		= '$pkg->{\"Printer\"}'		AND
			ROWNUM			= 1";
}


my $prepare = $pkg->{"DHDL"}->prepare($sql);
$prepare->execute();
$DefaultPrinter = $prepare->fetchrow_arrayref();
$prepare->finish();

if((!$DefaultPrinter->[0])&&(!$pkg->{"Printer"})){die "Cannot Determine Which Barcode Printer to Use With $pkg->{\"Type\"}\n";}
if((!$DefaultPrinter->[0])&&($pkg->{"Printer"})){die "Invalid Printer\nYou Cannot Print $pkg->{\"Type\"} On $pkg->{\"Printer\"}\n";}
$pkg->{"Printer"} = $DefaultPrinter->[0];

}# If Oracle not used


# Check printer online status
my $PrinterStatus = `lpq -P$pkg->{"Printer"}`;


if((length($PrinterStatus) < 1)||($PrinterStatus !~ /Printer OK/))
{
	## Erase the contents of the barcode object
	if($pkg->{"Label"}){undef $pkg->{"Label"};}
	
	if(open (ERFHDL, ">> /nfs/disk65/barcode/LOGS/error.log"))
	{
		my $ErrorDate = localtime();
		my $who = `whoami`;
		my $host = $ENV{HOST};
		chomp $who;
		printf ERFHDL "%-15s %-15s\n","Error Occured On",$ErrorDate;
		printf ERFHDL "%-15s %-15s\n","Unix User",$who;
		printf ERFHDL "%-15s %-15s\n","Barcode User",$pkg->{"User"};
		printf ERFHDL "%-15s %-15s\n","Program",$0;
		printf ERFHDL "%-15s %-15s\n","Host",$host;
		printf ERFHDL "%-15s %-15s\n\n","Label Type",$pkg->{"Type"};
		
		print ERFHDL "ERROR MESSAGE FROM lpq -P $pkg->{\"Printer\"} :\n\n$PrinterStatus\n\n";	
	
	close ERFHDL;
	}
	die "ERROR : Label Printer, $pkg->{\"Printer\"}, Unavailable\n\nPlease select another printer\n\n$PrinterStatus";
}





if(!$pkg->{"Printer"}){$pkg->{"Printer"} = 'd311bc';}

if(open FHDL, "| lpr -l -P$pkg->{\"Printer\"}") 
{
	#open FHDL, ">label01.txt";
	$pkg->{"FHDL"} = *FHDL;
	return $DefaultPrinter->[1];
}
else
{
	## Erase the contents of the barcode object
	if($pkg->{"Label"}){undef $pkg->{"Label"};}
	die "Cannot open pipe to Label printer $pkg->{\"Printer\"}";	
}


}


##################################################################
# Main Printing Module
##################################################################

sub Printlabel {
my $pkg = shift;
my $ref;
my $parameters;


# has type been set ?
if(!$pkg->{"Type"})	{if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Prefix Not defined, Cannot generate Label (s)";}
if(!$pkg->{"User"})	{if($pkg->{"Label"}){undef $pkg->{"Label"};} die "ERROR : Label owner not defined, Cannot generate Label (s)";}


my $PrinterLabel = $pkg->Checkprinter();
############################################
# Cludge For when Oracle is Down
if(!$PrinterLabel)
{ 
	$PrinterLabel 	= 1;
	if($pkg->{"Type"} =~ /DR|LG|GS/){$PrinterLabel = 2;}
	if($pkg->{"Type"} =~ /MG/){$PrinterLabel = 5;}
	
}
#
############################################


$pkg->FormatLabel($PrinterLabel);
my $time = localtime();
warn "==========================================\n";
warn "Label Printing Report\n";
warn "User 		: $pkg->{\"User\"}\n";
warn "Printer		: $pkg->{\"Printer\"}\n";
warn "Label Type 	: $pkg->{\"Type\"}\n";
warn "Time 		: $time\n";
warn "==========================================\n";

undef $pkg->{"Label"};
close $pkg->{"FHDL"};


}

##################################################################
# This is the default label layout for type 1 labels
##################################################################
sub DefaultLabelLayout_1 {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;
my $lcounter 	= '0001';


##############################################################
# Set Up label postions and fonts
# Date
print $FHDL $ESC,"PC001;0040,0035,1,1,G,00,B",$LF,$NULL;
# Human readable Form
print $FHDL $ESC,"PC002;0040,0065,1,1,G,00,B",$LF,$NULL;
# Name
print $FHDL $ESC,"PC003;0505,0035,1,1,G,00,B",$LF,$NULL;
# Project
print $FHDL $ESC,"PC004;0505,0065,1,1,G,00,B",$LF,$NULL;
# Suffix
print $FHDL $ESC,"PC005;0750,0035,1,1,G,00,B",$LF,$NULL;
# Owner
print $FHDL $ESC,"PC006;0750,0065,1,1,G,00,B",$LF,$NULL;

# Name 		Reduced Size
print $FHDL $ESC,"PC007;0505,0035,05,1,G,+03,00,B",$LF,$NULL;
# Project 	Reduced Size
print $FHDL $ESC,"PC008;0505,0065,05,1,G,+03,00,B",$LF,$NULL;
# Suffix 	Reduced Size
print $FHDL $ESC,"PC009;0750,0035,05,1,G,+03,00,B",$LF,$NULL;
# Owner		Reduced Size
print $FHDL $ESC,"PC010;0750,0065,05,1,G,+03,00,B",$LF,$NULL;
# Human readable Form Reduced Size
print $FHDL $ESC,"PC012;0040,0065,05,1,G,00,B",$LF,$NULL;



# Labelcounter		Reduced Size
print $FHDL $ESC,"PC011;0910,0065,05,1,G,+03,33,W",$LF,$NULL;

# 384 sidelabel
print $FHDL $ESC,"PC013;0008,0020,05,1,G,+03,11,W",$LF,$NULL;

# EAN 13 medium res barcode
print $FHDL $ESC,"XB01;0250,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;
##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	my $HumanReadable;

	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Has Humanreadable been Overwritten by nasty nibletts 384 well stuff.......
	my $SideLabel;
	if($CurrentLabel->{"HumanReadable"})
	{
		$SideLabel = $HumanReadable;
		$SideLabel =~ s/[0-9]+/ /;
		
		print $FHDL $ESC,"RC013;$SideLabel",$LF,$NULL;
		$HumanReadable = $CurrentLabel->{"HumanReadable"};
	}
	
	# Restrict Amount Of Info that can be printed in any label field
	$HumanReadable = $HumanReadable.$pad;
	#$HumanReadable 			= substr($HumanReadable			,0,18);
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"}	,0,18);
	$CurrentLabel->{"Project"}	= substr($CurrentLabel->{"Project"}	,0,18);
	$CurrentLabel->{"Suffix"}	= substr($CurrentLabel->{"Suffix"}	,0,14);
	$CurrentLabel->{"Owner"}	= substr($CurrentLabel->{"Owner"}	,0,14);
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g; 
	$CurrentLabel->{"Project"} 	=~ s/_/-/g;
	
	
	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	
	$i = '02';
	$HumanReadable =~ s/\s *$//g;
	if(length($HumanReadable) > 9){$i = 12;}
	print $FHDL $ESC,"RC0$i;$HumanReadable",$LF,$NULL;
	
	$i = 3; 
	if(length($CurrentLabel->{"Name"}) > 9){$i = 7;}
	print $FHDL $ESC,"RC00$i;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	
	$i = 4; 
	if(length($CurrentLabel->{"Project"}) > 9){$i = 8;}
	print $FHDL $ESC,"RC00$i;$CurrentLabel->{\"Project\"}",$LF,$NULL;
	
	$i = 5; 
	if(length($CurrentLabel->{"Suffix"}) > 7){$i = 9;}
	print $FHDL $ESC,"RC00$i;$CurrentLabel->{\"Suffix\"}",$LF,$NULL;
	
	$i = '06'; 
	if(length($CurrentLabel->{"Owner"}) > 7){$i = 10;}
	print $FHDL $ESC,"RC0$i;$CurrentLabel->{\"Owner\"}",$LF,$NULL;
	
	
	print $FHDL $ESC,"RC011;$lcounter",$LF,$NULL;
	
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	
	
	
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	$lcounter++;
	
}

}
##################################################################
# This is the freezer label layout for type 1 labels
##################################################################
sub FreezerLabels {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts

# Name
print $FHDL $ESC,"PC003;0330,0055,1,1,H,00,B",$LF,$NULL;


# EAN 13 medium res barcode
print $FHDL $ESC,"XB01;0050,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;
##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Restrict Amount Of Info that can be printed in any label field
	
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"}	,0,22);
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	print $FHDL $ESC,"RC003;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	
}

}

##################################################################
# This is the freezer label layout for type 1 labels
##################################################################
sub ReAmplificationLabels {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts

# Name
print $FHDL $ESC,"PC003;0600,0030,05,05,H,+01,00,B",$LF,$NULL;

# Project
print $FHDL $ESC,"PC002;0600,0065,1,1,G,+03,00,B",$LF,$NULL;

# EAN 13 medium res barcode
print $FHDL $ESC,"XB01;0100,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;
##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Restrict Amount Of Info that can be printed in any label field
	
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"}	,0,20);
	
	
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	print $FHDL $ESC,"RC002;$HumanReadable",$LF,$NULL;
	
	print $FHDL $ESC,"RC003;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	
}

}
##################################################################
# This is the label layout for type front side labels used 
# for DP concentration plates destined for megabace machines
##################################################################
sub MegaBaceLabels {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts

# Name
print $FHDL $ESC,"PC001;0430,0050,05,1,H,00,B",$LF,$NULL;

# Have to use code 128 due to limitations on the barcode s
# CODE 128
print $FHDL $ESC,"XB01;0070,0000,9,1,02,0,0080",$LF,$NULL;

##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	
	#($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode("DP",$CurrentLabel->{"Barcode"});
	#if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Restrict Amount Of Info that can be printed in any label field
	
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"}	,0,22);
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	
	
	print $FHDL $ESC,"RC001;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	
}

}
##################################################################
# This is the default label layout for type 2 labels
##################################################################
sub DefaultLabelLayout_2 {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                                ';
my $i;


# Set Up label postions and fonts
#DATE
print $FHDL $ESC,"PC001;0038,0210,05,05,H,+03,11,B",$LF,$NULL;

#Project
print $FHDL $ESC,"PC002;0120,0210,05,05,H,+02,11,B",$LF,$NULL;
print $FHDL $ESC,"PC003;0070,0210,05,05,H,+02,11,B",$LF,$NULL;


#Name (On round Label)
print $FHDL $ESC,"PC005;0240,0165,05,1,G,+00,00,B",$LF,$NULL;
print $FHDL $ESC,"PC006;0220,0193,05,1,G,+00,00,B",$LF,$NULL;

#Suffix (On round label)
print $FHDL $ESC,"PC007;0225,0217,05,1,G,+01,00,B",$LF,$NULL;


print $FHDL $ESC,"PC008;0150,0210,05,1,G,+01,11,B",$LF,$NULL;

#EAN 13 medium res
print $FHDL $ESC,"XB01;0043,0100,5,3,01,0,0100,+0000000000,002,0,00",$LF,$NULL;
# Now Using Code 128 For all small labels
#print $FHDL $ESC,"XB01;0023,0065,9,3,01,0,0130,+0000000000,005,1,00",$LF,$NULL;


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	my $HumanReadable;

	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	# Remove a digit from EAN 13 to convert to 128.
	#$CurrentLabel->{"Barcode"} = substr($CurrentLabel->{"Barcode"},0,3).substr($CurrentLabel->{"Barcode"},4);
	
	# Restrict Amount Of Info that can be printed in any label field
	$HumanReadable = $HumanReadable.$pad;
	
	$CurrentLabel->{"Name"} 	= $CurrentLabel->{"Name"}.$pad;
	$CurrentLabel->{"Project"} 	= $CurrentLabel->{"Project"}.$pad;
	$CurrentLabel->{"Suffix"}	= $CurrentLabel->{"Suffix"}.$pad;
	$CurrentLabel->{"Owner"}	= $CurrentLabel->{"Owner"}.$pad;
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g; 
	$CurrentLabel->{"Project"} 	=~ s/_/-/g;
	
	$HumanReadable 			= substr($HumanReadable			,0,11);
	$CurrentLabel->{"Suffix"}	= substr($CurrentLabel->{"Suffix"}	,0,8);
	$CurrentLabel->{"Owner"}	= substr($CurrentLabel->{"Owner"}	,0,12);
	
	# Printing underscopes on TEC printers is ugly, change any to dashes.
	$CurrentLabel->{"Name"} 	=~ s/_/-/g; 
	$CurrentLabel->{"Project"} 	=~ s/_/-/g;
	
	my ($ProjectLine1,$ProjectLine2) = split /-/,$CurrentLabel->{"Project"};
	$ProjectLine1 = substr($ProjectLine1,0,11);
	
	if($ProjectLine2)
	{
		$ProjectLine2 = '-'.substr($ProjectLine2,0,11)
	}
	else
	{
		$ProjectLine2 = substr($ProjectLine1,10,11);
	}
	
	$NameLine1 = substr($CurrentLabel->{"Name"},0,2);
	$NameLine2 = substr($CurrentLabel->{"Name"},2,10);

	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	print $FHDL $ESC,"RC002;$ProjectLine1",$LF,$NULL;
	print $FHDL $ESC,"RC003;$ProjectLine2",$LF,$NULL;

	print $FHDL $ESC,"RC005;$NameLine1",$LF,$NULL;
	print $FHDL $ESC,"RC006;$NameLine2",$LF,$NULL;

	print $FHDL $ESC,"RC007;$CurrentLabel->{\"Suffix\"}",$LF,$NULL;

	print $FHDL $ESC,"RC008;$CurrentLabel->{\"Owner\"}",$LF,$NULL;
	
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
}


}

sub MicroArrayPlateLabels {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts
# Date
print $FHDL $ESC,"PC001;0400,0035,05,1,G,+03,00,B",$LF,$NULL;
# Human Readable
print $FHDL $ESC,"PC002;0600,0030,1,1,G,+03,00,W",$LF,$NULL;

# Name
print $FHDL $ESC,"PC003;0400,0065,1,1,G,+03,00,B",$LF,$NULL;

# EAN 13 medium res barcode
print $FHDL $ESC,"XB01;0130,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;
##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Restrict Amount Of Info that can be printed in any label field
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"},0,30);
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	
	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	print $FHDL $ESC,"RC002;$HumanReadable",$LF,$NULL;
	
	
	print $FHDL $ESC,"RC003;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	
}

}

# Customised Label Formats
sub LigationLabel {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                                ';


#DATE
print $FHDL $ESC,"PC001;0030,0210,05,05,H,+03,11,B",$LF,$NULL;

#Project
print $FHDL $ESC,"PC002;0103,0210,05,05,H,+02,11,B",$LF,$NULL;
print $FHDL $ESC,"PC003;0053,0210,05,05,H,+02,11,B",$LF,$NULL;


#Name (On round Label)
print $FHDL $ESC,"PC005;0215,0184,05,1,G,+00,00,B",$LF,$NULL;
print $FHDL $ESC,"PC006;0210,0207,05,1,G,+00,00,B",$LF,$NULL;

#Suffix (On round label)
print $FHDL $ESC,"PC007;0218,0230,05,1,G,+01,00,B",$LF,$NULL;


print $FHDL $ESC,"PC008;0132,0210,05,1,G,+01,11,B",$LF,$NULL;

#EAN 13 medium res
print $FHDL $ESC,"XB01;0023,0100,5,3,01,0,0100,+0000000000,002,0,00",$LF,$NULL;
# Now Using Code 128 For all small labels
#print $FHDL $ESC,"XB01;0023,0065,9,3,01,0,0130,+0000000000,005,1,00",$LF,$NULL;


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	my $HumanReadable;

	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Remove a digit from EAN 13 to convert to 128.
	# $CurrentLabel->{"Barcode"} = substr($CurrentLabel->{"Barcode"},0,3).substr($CurrentLabel->{"Barcode"},4);
	
	
	# Restrict Amount Of Info that can be printed in any label field
	$HumanReadable = $HumanReadable.$pad;
	
	$CurrentLabel->{"Name"} 	= $CurrentLabel->{"Name"}.$pad;
	$CurrentLabel->{"Project"} 	= $CurrentLabel->{"Project"}.$pad;
	$CurrentLabel->{"Suffix"}	= $CurrentLabel->{"Suffix"}.$pad;
	$CurrentLabel->{"Owner"}	= $CurrentLabel->{"Owner"}.$pad;
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g; 
	$CurrentLabel->{"Project"} 	=~ s/_/-/g;
	
	$HumanReadable 			= substr($HumanReadable			,0,11);
	$CurrentLabel->{"Suffix"}	= substr($CurrentLabel->{"Suffix"}	,0,8);
	$CurrentLabel->{"Owner"}	= substr($CurrentLabel->{"Owner"}	,0,12);
	
	
	
	my ($ProjectLine1,$ProjectLine2) = split /-/,$CurrentLabel->{"Project"};
	$ProjectLine1 = substr($ProjectLine1,0,11);
	
	if($ProjectLine2)
	{
		$ProjectLine2 = '-'.substr($ProjectLine2,0,11)
	}
	else
	{
		$ProjectLine2 = substr($ProjectLine1,10,11);
	}
	
	# Printing underscores on TEC printers is ugly, change any to dashes.
	$ProjectLine1 			=~ s/_/-/g; 
	$ProjectLine2 			=~ s/_/-/g;
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	
	$NameLine1 = substr($CurrentLabel->{"Name"},0,10);
	# $NameLine2 = substr($CurrentLabel->{"Name"},10,10);

	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	print $FHDL $ESC,"RC002;$ProjectLine1",$LF,$NULL;
	print $FHDL $ESC,"RC003;$ProjectLine2",$LF,$NULL;

	print $FHDL $ESC,"RC005;$NameLine1",$LF,$NULL;
	print $FHDL $ESC,"RC006;$CurrentLabel->{\"Suffix\"}",$LF,$NULL;

	# print $FHDL $ESC,"RC007;$CurrentLabel->{\"Suffix\"}",$LF,$NULL;

	print $FHDL $ESC,"RC008;$CurrentLabel->{\"Owner\"}",$LF,$NULL;
	
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
}








}

sub TextOnly_Small {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                                ';


#DATE
print $FHDL $ESC,"PC001;0012,0210,05,05,H,+03,11,B",$LF,$NULL;

#Project
print $FHDL $ESC,"PC002;0103,0210,05,05,H,+02,11,B",$LF,$NULL;
print $FHDL $ESC,"PC003;0052,0210,05,05,H,+02,11,B",$LF,$NULL;


#Name (On round Label)
print $FHDL $ESC,"PC005;0218,0184,05,1,G,+00,00,B",$LF,$NULL;
print $FHDL $ESC,"PC006;0212,0207,05,1,G,+00,00,B",$LF,$NULL;

#Suffix (On round label)
print $FHDL $ESC,"PC007;0218,0230,05,1,G,+01,00,B",$LF,$NULL;

print $FHDL $ESC,"PC008;0133,0210,05,1,G,+01,11,B",$LF,$NULL;




foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	

	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	
	$CurrentLabel->{"Name"} 	= $CurrentLabel->{"Name"}.$pad;
	$CurrentLabel->{"Project"} 	= $CurrentLabel->{"Project"}.$pad;
	$CurrentLabel->{"Suffix"}	= $CurrentLabel->{"Suffix"}.$pad;
	$CurrentLabel->{"Owner"}	= $CurrentLabel->{"Owner"}.$pad;
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g; 
	$CurrentLabel->{"Project"} 	=~ s/_/-/g;
	
	$CurrentLabel->{"Suffix"}	= substr($CurrentLabel->{"Suffix"}	,0,8);
	$CurrentLabel->{"Owner"}	= substr($CurrentLabel->{"Owner"}	,0,12);
	
	
	my ($ProjectLine1,$ProjectLine2) = split /-/,$CurrentLabel->{"Project"};
	$ProjectLine1 = substr($ProjectLine1,0,11);
	
	if($ProjectLine2)
	{
		$ProjectLine2 = '-'.substr($ProjectLine2,0,11)
	}
	else
	{
		$ProjectLine2 = substr($ProjectLine1,10,11);
	}
	
	# Printing underscores on TEC printers is ugly, change any to dashes.
	$ProjectLine1 			=~ s/_/-/g; 
	$ProjectLine2 			=~ s/_/-/g;
	$CurrentLabel->{"Name"} 	=~ s/_/-/g;
	
	
	$NameLine1 = substr($CurrentLabel->{"Name"},0,10);
	$NameLine2 = substr($CurrentLabel->{"Name"},10,10);
	
	#Blank square
	print $FHDL $ESC,"LC;0018,0095,0140,0185,1,2,002",$LF,$NULL;
	
	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	print $FHDL $ESC,"RC002;$ProjectLine1",$LF,$NULL;
	print $FHDL $ESC,"RC003;$ProjectLine2",$LF,$NULL;

	print $FHDL $ESC,"RC005;$NameLine1",$LF,$NULL;
	print $FHDL $ESC,"RC006;$NameLine2",$LF,$NULL;

	print $FHDL $ESC,"RC007;$CurrentLabel->{\"Suffix\"}",$LF,$NULL;

	print $FHDL $ESC,"RC008;$CurrentLabel->{\"Owner\"}",$LF,$NULL;
	
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
}

}


sub PetriDishLabels {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts
# Date
print $FHDL $ESC,"PC001;0300,0035,1,1,G,00,B",$LF,$NULL;
# Name
print $FHDL $ESC,"PC003;0520,0035,1,1,G,+03,00,B",$LF,$NULL;
# Project
print $FHDL $ESC,"PC004;0300,0065,1,1,G,+03,00,B",$LF,$NULL;
# Suffix
print $FHDL $ESC,"PC005;0770,0035,1,1,G,+03,00,B",$LF,$NULL;

# Name 		Reduced Size
print $FHDL $ESC,"PC007;0520,0065,05,1,G,+03,00,B",$LF,$NULL;
# Project 	Reduced Size
print $FHDL $ESC,"PC008;0300,0065,05,1,G,+03,00,B",$LF,$NULL;
# Suffix 	Reduced Size
print $FHDL $ESC,"PC009;0770,0035,05,1,G,+03,00,B",$LF,$NULL;

# EAN 13 medium res barcode
print $FHDL $ESC,"XB01;0030,0000,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;
##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Restrict Amount Of Info that can be printed in any label field
	
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"}	,0,22);
	$CurrentLabel->{"Project"}	= substr($CurrentLabel->{"Project"}	,0,60);
	$CurrentLabel->{"Suffix"}	= substr($CurrentLabel->{"Suffix"}	,0,9);
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g; 
	$CurrentLabel->{"Project"} 	=~ s/_/-/g;
	
	
	print $FHDL $ESC,"RC001;$pkg->{\"Date\"}",$LF,$NULL;
	
	
	$i = 3; 
	if(length($CurrentLabel->{"Name"}) > 18){$i = 7;}
	print $FHDL $ESC,"RC00$i;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	
	$i = 4; 
	if(length($CurrentLabel->{"Project"}) > 30){$i = 8;}
	
	print $FHDL $ESC,"RC00$i;$CurrentLabel->{\"Project\"}",$LF,$NULL;
	print $FHDL $ESC,"RC005;$CurrentLabel->{\"Suffix\"}",$LF,$NULL;
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	
}

}


sub IdentityLabels {
my $pkg 	= shift;
my $FHDL 	= $pkg->{"FHDL"};
my $pad 	= '                ';
my $i;

##############################################################
# Set Up label postions and fonts

# Name
print $FHDL $ESC,"PC003;0600,0035,1,1,G,00,B",$LF,$NULL;
# Owner
print $FHDL $ESC,"PC006;0600,0065,1,1,G,00,B",$LF,$NULL;

print $FHDL $ESC,"PC004;0300,0035,1,1,G,00,B",$LF,$NULL;
print $FHDL $ESC,"PC005;0300,0065,1,1,G,00,B",$LF,$NULL;


# EAN 13 medium res barcode
print $FHDL $ESC,"XB01;0030,0005,5,3,02,0,0070,+0000000000,002,0,00",$LF,$NULL;
##############################################################


foreach my $CurrentLabel (@{$pkg->{"Label"}})
{
	# Clear label layout form printers memory
	print $FHDL $ESC,"C",$LF,$NULL;
	print $FHDL $ESC,"LC;0580,0010,0580,0075,0,2",$LF,$NULL;
	
	# Used ased for a blank label to be printed in middle of the job
	if($CurrentLabel->{"Barcode"} eq 'BREAK'){print $FHDL $ESC,"T20C32",$LF,$NULL; next;}
	
	($CurrentLabel->{"Barcode"}, $HumanReadable) = Calculatebarcode($pkg->{"Type"},$CurrentLabel->{"Barcode"});
	if($CurrentLabel->{"Barcode"} == -1){warn "Invalid Number Type In Sanger Barcode Calculation\n"; next;}
	
	# Restrict Amount Of Info that can be printed in any label field
	
	$CurrentLabel->{"Name"} 	= substr($CurrentLabel->{"Name"}	,0,20);
	$CurrentLabel->{"Owner"}	= substr($CurrentLabel->{"Owner"}	,0,20);
	
	$CurrentLabel->{"Name"} 	=~ s/_/-/g; 
	$CurrentLabel->{"Owner"} 	=~ s/_/-/g;
	
	
	print $FHDL $ESC,"RC003;$CurrentLabel->{\"Name\"}",$LF,$NULL;
	print $FHDL $ESC,"RC006;$CurrentLabel->{\"Owner\"}",$LF,$NULL;
	
	print $FHDL $ESC,"RB01;$CurrentLabel->{\"Barcode\"}",$LF,$NULL;
	
	print $FHDL $ESC,"RC004;ORACLE (LIVE)",$LF,$NULL;
	print $FHDL $ESC,"RC005;Sample Tracking",$LF,$NULL;
	
	print $FHDL $ESC,"XS;I,$pkg->{\"Quantity\"},0002C3201",$LF,$NULL;
	
}

}


sub Viewprinters {
my ($pkg) = @_;
my $radio;
my $ref;


if($pkg->{Printerlist}){undef $pkg->{Printerlist}};
if(Tk::Exists($pkg->{"Window"})){$pkg->{"Window"}->destroy();};



# get default printers put them at the head of the list
#$ref = $pkg->Query(1);
my $sql ="	SELECT 	1,BP.DESCRIPTION
		FROM 	BARCODE_PRINTER BP, BARCODE_PREFIX BF
		WHERE	BP.ISCURRENT		= 1
		AND	BP.ACTIVE_LABEL		= BF.ID_LABEL	
		AND	BF.ID_PREFIX		= '$pkg->{\"Type\"}'
		ORDER BY 2";



my $prepare = $pkg->{"DHDL"}->prepare($sql);
$prepare->execute();
$ref = $prepare->fetchall_arrayref();
$prepare->finish();

foreach(@{$ref})
{
#get rid of any spaces in printername
$_->[0] =~ s/ //g;
push @{$pkg->{Printerlist}},$_;
}

$pkg->{"Window"} = new MainWindow();
$pkg->{"Window"}->title("(F1) Oracle Label Generation Application (OLGA)");
$pkg->{"Window"}->minsize(400, 250); 
$pkg->{"Window"}->maxsize(400, 250);
#$pkg->{"Window"}->geometry("1x1+210+220");
my $f = $pkg->{"Window"}->Frame(-height => 250, -width => 400);
$f->pack();
$pkg->{"Window"}->packPropagate(0);
$f->packForget();



$pkg->{"Window"}->protocol('WM_DELETE_WINDOW', 	sub {# Do nothing
					});
my $frame1 = $pkg->{"Window"}->Frame(	-width 			=> -1,
					-relief 		=> "ridge",
					-bg 			=> "gray85",
					-borderwidth 		=> 2
				)->grid(-row 			=> 1,
					-column 		=> 1, 
					-sticky 		=> 'we');


my $frame2 = $pkg->{"Window"}->Frame(	-width 			=> -1,
					-relief 		=> "ridge",
					-bg 			=> "gray85",
					-borderwidth 		=> 2
				)->grid(-row 			=> 2,
					-column 		=> 1, 
					-sticky 		=> 'we');




my $t = $frame1->Label(				-font 			=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
						-text			=> "Set Default Printer",
						-width			=> 25,
						-anchor			=> 'w',	
		)->grid(			-row			=> 1, 
						-column			=> 1,
						-sticky			=> 'we');	

$frame1->Label(					
						-font 			
						#=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
						=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',

						-text			=> "Printer     Status",
						-bg			=> "lightblue",
						-width			=> 35,
						-anchor			=> 'w',	
		)->grid(			-row			=> 2, 
						-column			=> 1,
						-columnspan		=> 2,
						-sticky			=> 'we');	
						
$pkg->{Browse} = $frame1->Listbox(		-width 			=> 35,
						-selectmode 		=> 'single',
						-fg 			=> 'black',
						-selectbackground 	=> 'green',
						-font			
						#=> '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
						=> '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',

						-height			=> 5,	
		)->grid(			-row			=> 3, 
						-column			=> 1);


my $scroll = $frame1->Scrollbar(		-width 			=> 12,
						-command 		=> ['yview',$pkg->{Browse}]
		)->grid(			-row			=> 3, 
						-column			=> 2,
						-sticky			=> 'ns');




$pkg->{Browse}->configure(	 -yscrollcommand 	=> ['set', $scroll]);


$pkg->{Browse}->bind('<ButtonPress-1>', 	[\&Testchoice,	$pkg,0]);

$frame2->Button(		-fg 				=> 'black',
				-bg 				=> 'grey85',
				-width				=> 10,
				-anchor 			=> 'center',
				-text				=> 'Exit',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'lemonchiffon1',
				-command 			=> sub {
									#$pkg->{"Window"}->grabRelease();
									$pkg->{"Window"}->destroy();
									undef $pkg->{Printerlist};
									return;},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 1,
				-padx				=> 5,
				-pady				=> 5, 
				-sticky 			=> 'w');									


$frame2->Button(		-fg 				=> 'black',
				-bg 				=> 'grey85',
				-width				=> 10,
				-anchor 			=> 'center',
				-text				=> 'Refresh',
				-height 			=> 1,
				-state 				=> 'normal',
				-font 				=>'-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1',
				-activebackground 		=> 'lemonchiffon1',
				-command 			=> sub {
									if($pkg->{Printerlist})
									{
									
									foreach(@{$pkg->{Printerlist}})
									{undef $_->[5];}
									$pkg->Viewlist();
									}
									},
				-relief 			=> 'raised'
		)->grid(	-row 				=> 1, 
				-column 			=> 2,
				-padx				=> 5,
				-pady				=> 5, 
				-sticky 			=> 'w');




$pkg->Viewlist();

#$pkg->{"Window"}->grab();

MainLoop;

}

##############################################################################
sub Testchoice {
my ($e,$pkg) = @_;
if(!$pkg){$pkg = $e;}

if(!$pkg->{Printerlist}){$pkg->{Browse}->selectionClear(0, 'end');return;}

my @s = $pkg->{Browse}->curselection();

my $reply = `lpq -P$pkg->{Printerlist}->[$s[0]][1]`;

if(length($reply) < 1){
	$pkg->{Printerlist}->[$s[0]][5] = "Printer Is Unavailable";
	$pkg->{Browse}->bell();
	undef $pkg->{"Printer"};
	}
elsif($reply =~ /Printer Off Line/){
	$pkg->{Printerlist}->[$s[0]][5] = "Printer Is Off Line";
	$pkg->{Browse}->bell();
	undef $pkg->{"Printer"};
	}
else{
	$pkg->{Printerlist}->[$s[0]][5] = "Printer Is Okay";
	$pkg->{"Printer"} = $pkg->{Printerlist}->[$s[0]][1];
	$pkg->{"Printer"} =~ s/ //g;
	}


	
my $pad = $pkg->{Printerlist}->[$s[0]][1];	
while(length($pad) < 11){$pad = "$pad ";}	
	
$pkg->{Browse}->delete($s[0]);
$pkg->{Browse}->insert($s[0], "$pad $pkg->{Printerlist}->[$s[0]][5]");

if ($pkg->{Printerlist}->[$s[0]][5] =~ /Printer Is Okay/)
{$pkg->{Browse}->selection('set' => $s[0],$s[0]);}
}


################################################################################
sub Viewlist {
my ($e, $pkg) = @_;
if(!$pkg){$pkg = $e;}
				
$pkg->{Browse}->delete(0,'end');

if(!$pkg->{Printerlist})
{
	$pkg->{Browse}->insert('end',"Contact Bug");
	$pkg->{Browse}->insert('end',"No printer available");
	undef $pkg->{"Printer"};
	undef $pkg->{Printerlist};
}
else
{
	foreach(@{$pkg->{Printerlist}})
	{
	$_->[1] = substr($_->[1],0,11);					
	$pkg->{Browse}->insert('end',$_->[1]);
		if(($pkg->{"Printer"})&&($_->[1] =~ /$pkg->{"Printer"}/))
		{
		$CurrentPrinter = $pkg->{Browse}->index('end');
		$pkg->{Browse}->selection('set' => 'end','end');
		$pkg->Testchoice();
		}

	}#foreach in printerlist
$pkg->{Browse}->see($CurrentPrinter);

}


}









1;






