#######################################################################
# 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.                      #
#######################################################################
#                                                                     #
# THIS MODULE CONTAINS VARIOUS FUNCTIONS USED BY DODO.                #
# THESE FUNCTIONS ARE FOR PRINTING POSTSCRIPT DATA FROM DODO          #
# AND FOR SPECIFYING PRINTERS                                         #
#                                                                     #
#######################################################################

package Postscript;
use strict;


sub Printplate
{
my ($pkg, $plate, $desc, $worker, @data) = @_;
my $row;
my $col;

my $printer = $ENV{'PRINTER'};

open(OUT,"| lpr -P$printer")|| die "Printplate::Cannot open pipe to printer\n";
# warn "Writing To File\n";

#open(OUT,">chrom.ps");
#$printer = "dw56789bw";
#my $fhdl = new FileHandle("| lpr -P$printer");
#my $fhdl = new FileHandle(">plate.ps");
my $fhdl = *OUT;


printf $fhdl qq#%\!PS-Adobe-1.0
 %%Creator: printmap
 %%Title: printfMap
 %%Orientation: Landscape
 %%Pages: 1
 %%DocumentFonts: Helvetica-Bold Helvetica
 %%EndComments
 %%EndProlog
 %%Page: 1 1

/gs { gsave } def
/rectstroke {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0 setlinewidth stroke
} def

/rectfill {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0.7 setgray
  fill
  grestore
} def
#;

$pkg->Sangerheader($fhdl,"Landscape");
printf $fhdl "/Helvetica-Bold findfont 18 scalefont setfont\n";
printf $fhdl  "%d %d moveto (%s) show\n",300,510,"STOAT Sample Tracking";
printf $fhdl "/Helvetica-Bold findfont 12 scalefont setfont\n";
printf $fhdl  "%d %d moveto (%s) show\n",65,490,"Plate";
printf $fhdl  "%d %d moveto (%s) show\n",65,475,"Description";
printf $fhdl  "%d %d moveto (%s) show\n",65,460,"Printed By ";
printf $fhdl  "%d %d moveto (%s) show\n",65,445,"Date";

printf $fhdl  "%d %d moveto (%s) show\n",551,490,"Volume In Wells";
printf $fhdl  "%d %d moveto (%s) show\n",551,475,"Source";
printf $fhdl  "%d %d moveto (%s) show\n",551,460,"Library";
printf $fhdl  "%d %d moveto (%s) show\n",551,445,"Vector";


printf $fhdl "/Helvetica findfont 12 scalefont setfont\n";

$plate =~ s/[(]|[)]//g;

printf $fhdl  "%d %d moveto (%s) show\n",135,490,$plate;
printf $fhdl  "%d %d moveto (%s) show\n",135,475,$desc;
printf $fhdl  "%d %d moveto (%s) show\n",135,460,$worker;
printf $fhdl  "%d %d moveto (%s) show\n",135,445,scalar(localtime(time));
printf $fhdl "/Helvetica-Bold findfont 8 scalefont setfont\n";

printf $fhdl  "%d %d moveto %d %d lineto stroke\n",550 ,500 ,799, 500;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",550 ,485 ,799, 485;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",550 ,470 ,799, 470;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",550 ,455 ,799, 455;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",550 ,440 ,799, 440;

printf $fhdl  "%d %d moveto %d %d lineto stroke\n",550 ,500 ,550, 440;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",676 ,500 ,676, 440;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",799 ,500 ,799, 440;
#previous
my $old= 0;
foreach(@data)
	{
	
	$row = int(($_->[1]-1)/12);
	$col = ($_->[1]- ($row*12))-1;
	
	if(length($_->[0]) > 0)	
	{printf $fhdl  "%d %d moveto (%s) show\n",65 + ($col * 62),410 - ($row * 45),substr($_->[0],0,11);}

	if(length($_->[0]) > 11)	
	{printf $fhdl  "%d %d moveto (%s) show\n",65 + ($col * 62),402 - ($row * 45),substr($_->[0],11,11);}

	if(length($_->[0]) > 22)	
	{printf $fhdl  "%d %d moveto (%s) show\n",65 + ($col * 62),394 - ($row * 45),substr($_->[0],22,11);}
	
	if($_->[2] > 0){printf $fhdl  "%d %d moveto (%s) show\n",65 + ($col * 62),386 - ($row* 45),"PRIORITY";}
	if($_->[5]){printf $fhdl  "%d %d moveto (%s) show\n",65 + ($col * 62),378 - ($row* 45),substr($_->[5],0,11);}
	
	}
	


printf $fhdl "/Helvetica findfont 10 scalefont setfont\n";
for $row (0..7)
{
printf $fhdl  "%d %d moveto\n(%s) show\n",40,400 - ($row * 45),chr(65 + $row);
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",55 ,420 - ($row * 45) ,799, 420 - ($row * 45);
}
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",55 ,420 - (8 * 45) ,799, 420 - (8 * 45);

for $col(0..11)
{
	printf $fhdl  "%d %d moveto\n(%d) show\n",88 + ($col * 61.5),425,$col+1;
	printf $fhdl  "%d %d moveto %d %d lineto stroke\n",55 + ($col * 62) ,420 ,55+ ($col * 62), 60;
}
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",55 + (12 * 62) ,420 ,55+ (12 * 62), 60;

printf $fhdl "\nshowpage\n";
# $fhdl->close;#|| die "could not close file\n";
close($fhdl)|| die "could not close pipe to printer\n";

}


sub Printstreaks
{
my ($pkg, $ref, $worker, $workdate) = @_;
my $pages;
my $currentpage;
my $fhdl;
my $i;
my $printer = $ENV{'PRINTER'};

$pages = int(@{$$ref}/24);
if (((@{$$ref}/24) - $pages) > 0)
{$pages++;}


for $currentpage (1..$pages)
{
open(OUT,"| lpr -P$printer")|| die "Printplate::Cannot open pipe to printer\n";
#open(OUT,"| lp -d$printer");
#open(OUT,">streakjune.ps");
$fhdl = *OUT;
printf $fhdl qq#%\!PS-Adobe-1.0
 %%Creator: DODO
 %%Title: printfRequests
 %%Orientation: Portrait
 %%Pages: 1
 %%DocumentFonts: Helvetica-Bold Helvetica
 %%EndComments
 %%EndProlog
 %%Page: 1 1

/gs { gsave } def
/rectstroke {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0 setlinewidth stroke
} def

/rectfill {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0.98 setgray
  fill
  grestore
} def
#;

$pkg->Sangerheader($fhdl,"Portrait");

printf $fhdl "/Helvetica-Bold findfont 18 scalefont setfont\n";
printf $fhdl  "%d %d moveto (%s) show\n",150,770,"DNAprep Clone Streaking Worksheet";
printf $fhdl "/Helvetica findfont 12 scalefont setfont\n";
# printf $fhdl  "%d %d moveto (%s) show\n",135,660,scalar(localtime(time)));
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,640,560,640;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,640,50,122;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",560,640,560,122;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,122,560,122;
#printf $fhdl  "%d %d moveto %d %d lineto stroke\n",473,640,473,122;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",518,640,518,122;
my $t = scalar(localtime(time));
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,730,"Assigned To",135,730,$worker;
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,700,"Work List For",135,700,$workdate;
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,670,"Printed On",135,670,$t;

my $row = 0;
my $col = 0;
	
	printf $fhdl "/Helvetica-Bold findfont 10 scalefont setfont\n";
	
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Culture ID.";
	$col = 1;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Clone";
	$col = 3.5;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Species Chr";
	
	
	$col = 5.0;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Plate ID";
	#$col = 6.2;
	$col = 7.0;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Well";
	#$col = 6.8;
	$col = 7.6;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Failed";

	printf $fhdl  "%d %d moveto %d %d rlineto stroke\n",50 ,620,510,0;

for $row (1..24)
{

	$i = $row + (24 * ($currentpage -1));
	if($$ref->[$i -1][0])
	{
	$$ref->[$i -1][2] = "$$ref->[$i -1][3]";
	$$ref->[$i -1][4] = "$$ref->[$i -1][4]  $$ref->[$i -1][5]";
	
	
	#$$ref->[$i -1][2] = "$$ref->[$row -1][2] ($$ref->[$row -1][3])";
	#$$ref->[$row -1][4] = "$$ref->[$row -1][4]  $$ref->[$row-1][5]";
	$col = 0.4;
	#printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$row -1][0];
	
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$i -1][0];
	$col = 1;
	#printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$row -1][1];
	
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$i -1][1];
	$$ref->[$i -1][6] = substr($$ref->[$i -1][6],0,6);
	$col = 3.5;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"$$ref->[$i -1][6]  $$ref->[$i -1][7]";
	
	
	
	$col = 5.0;
	#printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$row -1][2];
	
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$i -1][2];
	$col = 7.0;
	#printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$row -1][4];
	
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$i -1][4];
	}
	$col = 7.5;
	printf $fhdl  "%d %d moveto %d %d lineto stroke\n",55 + ($col * 62),622 - ($row * 20),560,622 - ($row * 20);
}


printf $fhdl  "%d %d moveto (%s) show\n",150, 80,"Please Remember to Tell Oracle What Streaks Have Failed";
printf $fhdl  "%d %d moveto (%s) show\n",50, 50,"Page $currentpage of $pages";
printf $fhdl "showpage";	
#close $fhdl;
#$fhdl->close()|| die "could not close file\n";
close($fhdl)|| die "could not close pipe to printer\n";

}
}


sub Printpreps
{
my ($pkg, $ref, $worker, $workdate) = @_;
my $fhdl; 
my $currentpage;
my $i;
my $printer = $ENV{'PRINTER'};

my $pages;


$pages = int(@{$$ref}/24);
if (((@{$$ref}/24) - $pages) > 0)
{$pages++;}

for $currentpage (1..$pages)
{
open (OUT, "| lpr -P$printer") || die "Printpreps::Cannot open pipe to printer\n";
#open (OUT, "| lp -d$printer");
#open (OUT, ">prepsjune.ps");
$fhdl = *OUT;
printf $fhdl qq#%\!PS-Adobe-1.0
 %%Creator: DODO
 %%Title: printfRequests
 %%Orientation: Portrait
 %%Pages: 1
 %%DocumentFonts: Helvetica-Bold Helvetica
 %%EndComments
 %%EndProlog
 %%Page: 1 1

/gs { gsave } def
/rectstroke {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0 setlinewidth stroke
} def

/rectfill {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0.98 setgray
  fill
  grestore
} def
#;

$pkg->Sangerheader($fhdl,"Portrait");

printf $fhdl "/Helvetica-Bold findfont 18 scalefont setfont\n";
printf $fhdl  "%d %d moveto (%s) show\n",140,770,"DNAprep Clone Preparation Worksheet";
printf $fhdl "/Helvetica findfont 12 scalefont setfont\n";
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,640,560,640;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,640,50,122;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",560,640,560,122;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,122,560,122;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",427,640,427,122;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",468,640,468,122;
my $t = scalar(localtime(time));
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,730,"Assigned To",135,730,$worker;
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,700,"Work List For",135,700,$workdate;
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,670,"Printed On",135,670,$t;

my $row = 0;
my $col = 0;
	
	printf $fhdl "/Helvetica-Bold findfont 10 scalefont setfont\n";
	
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Prep ID.";
	$col = 1;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Clone";
	$col = 3.1;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Species Chr";
	$col = 4.3;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Method";
	$col = 6.1;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Pass";
	$col = 6.7;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Prep Failed";

	printf $fhdl  "%d %d moveto %d %d rlineto stroke\n",50 ,620,510,0;

for $row (1..24)
{

	$i = $row + (24 * ($currentpage -1));
	if($$ref->[$i -1][0])
	{
	$$ref->[$i -1][4] = substr($$ref->[$i -1][4],0,5);
	
	$col = 0.2;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$i -1][0];
	$col = 1;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"$$ref->[$i-1][1]-$$ref->[$i -1][2]";
	$col = 3.1;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"$$ref->[$i -1][4]  $$ref->[$i -1][5]";
	$col = 4.3;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),$$ref->[$i -1][3];
	}
	$col = 6.0;
	printf $fhdl  "%d %d moveto %d %d lineto stroke\n",55 + ($col * 62),622 - ($row * 20),560,622 - ($row * 20);

}


printf $fhdl  "%d %d moveto (%s) show\n",50, 65,"Please Remember to Update Oracle. Tick preps that pass and enter failure reason for preps that fail";
printf $fhdl  "%d %d moveto (%s) show\n",50, 50,"Page $currentpage of $pages";
printf $fhdl "showpage";	
#close $fhdl;
#$fhdl->close()|| die "could not close file\n";
close($fhdl)|| die "could not close pipe to printer\n";

}
}






sub Sangerheader
{
my ($pkg, $fhdl, $orient) = @_;
my $x = 88;
my $y = 770;
if ($orient eq "Landscape")
{
printf $fhdl "90 rotate\n";
printf $fhdl "0 -595 translate\n";
$x = 88;
$y = 520;
}

printf $fhdl "/origstate save def\n";
printf $fhdl "/Times-Bold findfont 24 scalefont setfont\n";
printf $fhdl "%d %d moveto\n(%s) show\n",$x,$y + 35,"The Sanger Centre";
printf $fhdl "%d %d translate\n",35,$y;
printf $fhdl "20 dict begin\n";
printf $fhdl "/pix 28 string def\n";
printf $fhdl "/grays 28 string def  \n";
printf $fhdl "/npixls 0 def\n";
printf $fhdl "28.00800 58.96800 scale\n";
printf $fhdl "28 59 8\n";
printf $fhdl "[28 0 0 -59 0 59]\n";
printf $fhdl "{currentfile pix readhexstring pop}\n";
printf $fhdl "image\n";
printf $fhdl "ffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 ffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 ffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 ffffffffffb9ffffffffffffffffffffffffffffffffffffffffffff
 ffffffffb9b9b9b9b9ffffffffffffffffffffffffffffb9ffffffff
 ffffffffffffb9b9b9b9b9ffffffffffffffffffffffffb9ffffffff
 ffffffffffffffffb9b9b9b9b9b9ffffffffffffffff4dffffffffff
 ffffffffffffffffffffb9b9b9b9b9b9b9ffffffffb94dffffffffff
 ffffffffffffffffffffffffffb9b9b9b9b9b9ff4d4db9ffffffffff
 ffffffffffffffffffffffffffffffb9b9b9b94d4d4dffffffffffff
 ffffffffffffffffffffffffffffffffb94d4d4d4db9ffffffffffff
 ffffffffffffffffffffffffffffb94d4d4d4d4db9b9ffffffffffff
 ffffffffffffffffffffffb94d4d4d4d4d4dffffffb9ffffffffffff
 ffffffffffffffffff4d4d4d4d4d4d4db9ffffffffffb9ffffffffff
 ffffffffffffff4d4d4d4d4d4d4dffffffffffffffffb9ffffffffff
 ffffffffffff4d4d4d4d4db9ffffffffffffffffffffb9ffffffffff
 ffffffffb94d4d4db9b9ffffffffffffffffffffffffb9ffffffffff
 ffffffff4d4d4db9ffffffffffffffffffffffffffffb9ffffffffff
 ffffffb94d4dffffffffffffffffffffffffffffffb9ffffffffffff
 ffffff4d4dffffffffffffffffffffffffffffffb9b9ffffffffffff
 ffffff4dffffffffffffffffffffffffffffb9b9b9ffffffffffffff
 ffffff4dffffffffffffffffffffffffb9b9b9b9ffffffffffffffff
 ffffff4dffffffffffffffffffb9b9b9b9b9b9ffffffffffffffffff
 ffffff4dffffffffffffffb9b9b9b9b9b9ffffffffffffffffffffff
 ffffff4d4dffffffb9b9b9b9b9b9b9ffffffffffffffffffffffffff
 ffffffb94d4db9b9b9b9b9b9b9ffffffffffffffffffffffffffffff
 ffffffff4db9b9b9b9b9ffffffffffffffffffffffffffffffffffff
 ffffffffffb9b9b94d4db9ffffffffffffffffffffffffffffffffff
 ffffffffb9b9b94d4d4d4d4d4db9ffffffffffffffffffffffffffff
 ffffffb9b9ffffffb94d4d4d4d4d4d4db9ffffffffffffffffffffff
 ffffffb9ffffffffffffffb94d4d4d4d4d4db9ffffffffffffffffff
 ffffffb9ffffffffffffffffffffb94d4d4d4d4db9ffffffffffffff
 ffffffb9ffffffffffffffffffffffffb9b94d4d4d4dffffffffffff
 ffffffb9ffffffffffffffffffffffffffffffb94d4db9ffffffffff
 ffffffb9ffffffffffffffffffffffffffffffffff4d4dffffffffff
 ffffffb9b9ffffffffffffffffffffffffffffffffff4db9ffffffff
 ffffffffb9b9b9ffffffffffffffffffffffffffffffb9b9ffffffff
 ffffffffffb9b9b9ffffffffffffffffffffffffffffffb9ffffffff
 ffffffffffffb9b9b9b9b9b9ffffffffffffffffffffb9b9ffffffff
 ffffffffffffffb9b9b9b9b9b9b9ffffffffffffffff4dffffffffff
 ffffffffffffffffffffb9b9b9b9b9b9b9ffffffff4d4dffffffffff
 ffffffffffffffffffffffffffb9b9b9b9b9b9ff4d4db9ffffffffff
 ffffffffffffffffffffffffffffffffb9b94d4d4db9ffffffffffff
 ffffffffffffffffffffffffffffffffb94d4d4d4db9ffffffffffff
 ffffffffffffffffffffffffffffb94d4d4d4db9b9b9b9ffffffffff
 ffffffffffffffffffffffb94d4d4d4d4d4db9ffffb9b9ffffffffff
 ffffffffffffffffff4d4d4d4d4d4d4db9ffffffffffb9ffffffffff
 ffffffffffffff4d4d4d4d4d4d4db9fffffffffffffffb9fffffffff
 ffffffffffff4d4d4d4d4db9fffffffffffffffffffffb9fffffffff
 ffffffffb94d4d4db9b9fffffffffffffffffffffffffb9fffffffff
 ffffffff4d4d4db9ffffffffffffffffffffffffffffb9ffffffffff
 ffffffb94db9ffffffffffffffffffffffffffffffb9b9ffffffffff
 ffffffb94dffffffffffffffffffffffffffffffb9b9ffffffffffff
 ffffff4dffffffffffffffffffffffffffffb9b9b9ffffffffffffff
 ffffffb9ffffffffffffffffffffffffb9b9b9b9ffffffffffffffff
 ffffffffffffffffffffffffffffffffb9b9b9ffffffffffffffffff
 ffffffffffffffffffffffffffffffffffb9ffffffffffffffffffff
 ffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 ffffffffffffffffffffffffffffffffffffffffffffffffffffffff\n";
printf $fhdl "end\n";
printf $fhdl "origstate restore\n";
}

sub Setprinter
{
my ($pkg, $cmd, $ref) = @_;
my $y;
my $x = $ENV{'PRINTER'};
my $win = $pkg->{Mainwin}->Toplevel();



$win->minsize(300, 150); 
$win->maxsize(300, 150);
$win->title("DODO");
$win->geometry("+400+400");
$win->protocol('WM_DELETE_WINDOW', sub{$pkg->Killmessage($win);});

my $frame = $win->Frame(		-width 		=> -1, 
					-height 	=> -1
			)->grid(	-row 		=> 1,
					-padx		=> 30, 
					-pady		=> 30, 
					-column 	=> 1,
					-columnspan 	=> 3,	
					-sticky 	=> 'we');

my $lbl = $frame->Label(		-fg 		=> 'black',
					-bg 		=> 'lightblue',
					-width 		=> 30,
					-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-text 		=> $cmd,
					-relief 	=> 'flat'
				)->grid(-row 		=> 1,
					-column 	=> 1,
					-columnspan 	=> 3,	
					-sticky 	=> 'we');

$frame->Entry(				-fg 		=> 'black',
					-bg 		=> 'lemonchiffon1',
					-width 		=> 21,
					-font 		=>'-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-textvariable 	=> \$x,
					-state 		=> 'normal',
					-relief 	=> 'flat'
				)->grid(-row 		=> 2, 
					-column 	=> 1,
					-columnspan 	=>3,
					-sticky 	=> 'we');
					
$frame->Button(				-text 		=> "Print",
					-width 		=> 10,
					-height		=> 1,
					-fg 		=> 'lemonchiffon1', 
					-bg 		=> 'tomato1',
					-activeforeground => 'tomato1',
					-activebackground => 'lemonchiffon1', 
					-font 		=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-command 	=> sub {	$ENV{'PRINTER'} = $x;
										$y = `lpq -P $x`;
										
										if($y =~ /no spool directory/)
										{	
											$pkg->{Mainwin}->bell();
											$lbl->configure(-text => "Invalid  Printer, Select Another");
										}
										else
										{
											$pkg->{Mainwin}->bell();
											$win->grabRelease();
											$win->destroy();
											$$ref = 1;
										}
									}
									
				)->grid(	-row 		=> 3, 
						-column 	=> 1,
						-sticky 	=> 'e');
				
					
$frame->Button(				-text 			=> "Cancel Print",
					-width 			=> 10,
					-height 		=> 1, 
					-fg 			=> 'lemonchiffon1', 
					-bg 			=> 'blue',
					-activeforeground 	=> 'blue',
					-activebackground 	=> 'lemonchiffon1', 
					-font 			=> '-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1',
					-command 		=> sub {		$win->grabRelease();
											$win->destroy();
											$$ref = 0;
									}
					)->grid(-row 		=> 3, 
						-column 	=> 3, 
						-sticky 	=> 'w');




# $win->grab();
}




sub Printrequest
{
my $printer = $ENV{'PRINTER'};
my $cell;
my $priority;
my $range;
my $sql;
my $desc;

my $pkg = shift;

if (@_)
{
	$range = shift;
	my($startreq, $endreq) = split('-',$range,2);
	# To eliminate any spaces
	$startreq = $startreq * 1;
	$endreq = $endreq * 1;
	
$sql ="	SELECT	DNAPREP_REQUEST.ID_REQUEST, GLYSTOCK.CLONENAME, CLONEWELL.ID_CLONEPLATE,ROWCOL_MAP.MAPROW,ROWCOL_MAP.MAPCOL,
				PERSON.EMAIL, DNAPREP_REQUEST.IS_FASTTRACK, DNAPREPREQSTATUSDICT.DESCRIPTION, CLONEPLATE.DESCRIPTION
			
		FROM		DNAPREP_REQUEST, GLYSTOCK, CLONEWELL, TEAM_PERSON_ROLE, PERSON, DNAREQUEST_STATUS,
				DNAPREPREQSTATUSDICT, ROWCOL_MAP, CLONEPLATE
		WHERE		(TEAM_PERSON_ROLE.ID_ROLE = DNAPREP_REQUEST.REQUESTED_BY)	AND
				(PERSON.ID_PERSON = TEAM_PERSON_ROLE.ID_PERSON)			AND
				(CLONEWELL.ID_CLONEPLATE = CLONEPLATE.ID_CLONEPLATE)		AND
				(ROWCOL_MAP.ID_MAP = CLONEWELL.ID_MAP)				AND
				(CLONEWELL.ID_GLYSTOCK = GLYSTOCK.ID_GLYSTOCK)			AND
				(GLYSTOCK.ID_GLYSTOCK = DNAPREP_REQUEST.ID_GLYSTOCK)		AND
				(DNAREQUEST_STATUS.ID_REQUEST = DNAPREP_REQUEST.ID_REQUEST)	AND
				(DNAPREPREQSTATUSDICT.ID_DICT = DNAREQUEST_STATUS.STATUS)	AND
				(DNAPREP_REQUEST.ID_REQUEST >= '$startreq')			AND
				(DNAPREP_REQUEST.ID_REQUEST <= '$endreq')			
		ORDER BY	(DNAPREP_REQUEST.ID_REQUEST)";
}
else
{
my ($plateindex, $dump) = split(' ',$pkg->{Plate},2);
$sql ="	SELECT	DNAPREP_REQUEST.ID_REQUEST, GLYSTOCK.CLONENAME, CLONEWELL.ID_CLONEPLATE,ROWCOL_MAP.MAPROW,ROWCOL_MAP.MAPCOL,
		PERSON.EMAIL, DNAPREP_REQUEST.IS_FASTTRACK,DNAPREPREQSTATUSDICT.DESCRIPTION,  CLONEPLATE.DESCRIPTION
	FROM	DNAPREP_REQUEST, GLYSTOCK, CLONEWELL, TEAM_PERSON_ROLE, PERSON, DNAREQUEST_STATUS,
		DNAPREPREQSTATUSDICT, ROWCOL_MAP, CLONEPLATE
WHERE	(TEAM_PERSON_ROLE.ID_ROLE 	= DNAPREP_REQUEST.REQUESTED_BY)		AND
	(PERSON.ID_PERSON 		= TEAM_PERSON_ROLE.ID_PERSON)		AND
	(DNAPREPREQSTATUSDICT.ID_DICT = DNAREQUEST_STATUS.STATUS)		AND
	(DNAREQUEST_STATUS.ISCURRENT	= 1)					AND
	(DNAREQUEST_STATUS.ID_REQUEST	= DNAPREP_REQUEST.ID_REQUEST)		AND
	(DNAPREP_REQUEST.ID_GLYSTOCK	= GLYSTOCK.ID_GLYSTOCK)			AND
	(GLYSTOCK.IS_AVAILABLE		= 1)					AND
	(GLYSTOCK.ID_GLYSTOCK		= CLONEWELL.ID_GLYSTOCK)		AND
	(ROWCOL_MAP.ID_MAP 		= CLONEWELL.ID_MAP)			AND
	(CLONEWELL.ID_CLONEPLATE 	= CLONEPLATE.ID_CLONEPLATE)		AND
	(CLONEPLATE.ID_CLONEPLATE 	= '$plateindex')
ORDER BY	(DNAPREP_REQUEST.ID_REQUEST)";
}


my $ref = $pkg->Querydb($sql);

open (OUT, "| lpr -P$printer") || die "Preprequest::Cannot open pipe to printer\n";
#open(OUT,"| lp -d$printer");
#open(OUT,">requestjune.ps");
#my $fhdl = new FileHandle("| lpr -P$printer");
#my $fhdl = new FileHandle(">RequestBB.ps");

my $fhdl = *OUT;

if (!defined $fhdl)
{
	die "Could not open file\n";
}


printf $fhdl qq#%\!PS-Adobe-1.0
 %%Creator: DODO
 %%Title: printfRequests
 %%Orientation: Portrait
 %%Pages: 1
 %%DocumentFonts: Helvetica-Bold Helvetica
 %%EndComments
 %%EndProlog
 %%Page: 1 1


/gs { gsave } def
/rectstroke {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0 setlinewidth stroke
} def

/rectfill {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0.98 setgray
  fill
  grestore
} def
#;

$pkg->Sangerheader($fhdl,"Portrait");

printf $fhdl "/Helvetica-Bold findfont 18 scalefont setfont\n";
printf $fhdl  "%d %d moveto (%s) show\n",100,770,"STOAT Sample Tracking - DNAprep Request";
printf $fhdl "/Helvetica findfont 12 scalefont setfont\n";
# printf $fhdl  "%d %d moveto (%s) show\n",135,660,(localtime(time));
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,760,560,760;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,760,50,70;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",560,760,560,70;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,70,560,70;

my $row = 0;
my $col = 0;
	
	printf $fhdl "/Helvetica-Bold findfont 8 scalefont setfont\n";
	
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),753 - ($row * 45),"Request No.";
	$col = 1;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),753 - ($row * 45),"Clone";
	$col = 3.5;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),753 - ($row * 45),"Plate ID";
	$col = 6.2;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),753 - ($row * 45),"Well";
	$col = 6.5;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),753 - ($row * 45),"By";
	$col = 6.8;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),753 - ($row * 45),"Priority";
	$col = 7.3;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),753 - ($row * 45),"Status";

	printf $fhdl  "%d %d moveto %d %d rlineto stroke\n",50 ,746,510,0;
	printf $fhdl  ".1 setlinewidth\n";	
	printf $fhdl  "[1 4]0 setdash\n";
	printf $fhdl "/Helvetica findfont 8 scalefont setfont\n";
	
	
for($row = 0;$row < @$ref; $row++)
{

if ($ref->[$row][6] > 0)
	{$ref->[$row][6] = "High";}
else
	{$ref->[$row][6] = "Normal";}

$ref->[$row][2] = "$ref->[$row][2] ($ref->[$row][8])";
$ref->[$row][3] = uc($ref->[$row][3]);
$ref->[$row][3] = "$ref->[$row][3]$ref->[$row][4]";
	$col = 0;
	printf $fhdl  "%d %d moveto (%d) show %d %d lineto stroke\n",55 + ($col * 62),739 - ($row * 7),$ref->[$row][0],55 + ((1) *62),739 - ($row * 7);
	$col = 1;
	printf $fhdl  "%d %d moveto (%s) show %d %d lineto stroke\n",55 + ($col * 62),739 - ($row * 7),$ref->[$row][1],55 + ((3.5) *62),739 - ($row * 7);
	$col = 3.5;
	printf $fhdl  "%d %d moveto (%s) show %d %d lineto stroke\n",55 + ($col * 62),739 - ($row * 7),$ref->[$row][2],55 + ((6.2) * 62),739 - ($row * 7);
	$col = 6.2;
	printf $fhdl  "%d %d moveto (%s) show %d %d lineto stroke\n",55 + ($col * 62),739 - ($row * 7),$ref->[$row][3],55 + ((6.5) * 62),739 - ($row * 7);
	$col = 6.5;
	printf $fhdl  "%d %d moveto (%s) show %d %d lineto stroke\n",55 + ($col * 62),739 - ($row * 7),$ref->[$row][5],55 + ((6.8) * 62),739 - ($row * 7);
	$col = 6.8;
	printf $fhdl  "%d %d moveto (%s) show %d %d lineto stroke\n",55 + ($col * 62),739 - ($row * 7),$ref->[$row][6],55 + ((7.3) * 62),739 - ($row * 7);
	$col = 7.3;
	printf $fhdl  "%d %d moveto (%s) \nshow ",55 + ($col * 62),739 - ($row * 7),$ref->[$row][7];

}	
	
printf $fhdl  "%d %d moveto (%s) \nshow ",55,20,"Printed On The ".(localtime(time));
printf $fhdl "\nshowpage\n";
$fhdl->close()|| die "could not close file\n";
#close($fhdl);
}

sub Gellreport
{
my ($pkg, $ref, $worker, $plate) = @_;
my $fhdl; 
my $currentpage;
my $i;
my $printer = $ENV{'PRINTER'};
my $pages;
my $l = 'A';

$pages = int(@{$$ref}/24);
if (((@{$$ref}/24) - $pages) > 0)
{$pages++;}

$pages = 4;

for $currentpage (1..$pages)
{
open (OUT, "| lpr -P$printer") || die "Gellreport::Cannot open pipe to printer\n";
#open (OUT, ">gelljul.ps");
$fhdl = *OUT;
printf $fhdl qq#%\!PS-Adobe-1.0
 %%Creator: DODO
 %%Title: printfRequests
 %%Orientation: Portrait
 %%Pages: 1
 %%DocumentFonts: Helvetica-Bold Helvetica
 %%EndComments
 %%EndProlog
 %%Page: 1 1 


/gs { gsave } def
/rectstroke {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0 setlinewidth stroke
} def

/rectfill {
  gsave newpath
  4 2 roll moveto
  exch dup 0 rlineto
  exch 0 exch rlineto
  neg 0 rlineto
  closepath
  0.98 setgray
  fill
  grestore
} def
#;

$pkg->Sangerheader($fhdl,"Portrait");

printf $fhdl "/Helvetica-Bold findfont 18 scalefont setfont\n";
printf $fhdl  "%d %d moveto (%s) show\n",140,770,"DNAprep Gell Check Worksheet";
printf $fhdl "/Helvetica findfont 12 scalefont setfont\n";
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,640,335,640;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,640,50,142;

printf $fhdl  "%d %d moveto %d %d lineto stroke\n",271,640,271,142;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",300,640,300,142;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",335,640,335,142;



printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,142,335,142;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",241,640,241,142;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",82,640,82,142;

# this is top box
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,640,345,380;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,640,580,640;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,380,580,380;


printf $fhdl  "%d %d moveto %d %d lineto stroke\n",580,640,345,640;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",580,640,580,380;

printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,400,580,400;

if($currentpage == 1)
{
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,370,345,110;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,370,580,370;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,110,580,110;

printf $fhdl  "%d %d moveto %d %d lineto stroke\n",580,370,345,370;
printf $fhdl  "%d %d moveto %d %d lineto stroke\n",580,370,580,110;

printf $fhdl  "%d %d moveto %d %d lineto stroke\n",345,130,580,130;

printf $fhdl  "%d %d moveto (%s) show\n",347,384,'Full Gell';
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s)show\n",347,114,$currentpage,390,114,'Quarter';
}
else
{
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s)show\n",347,384,$currentpage,390,384,'Quarter';
}



my $t = scalar(localtime(time));
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,730,"Assigned To",135,730,$worker;
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,700,"Plate",135,700,$plate;
printf $fhdl  "%d %d moveto (%s) show %d %d moveto (%s) show\n",50,670,"Printed On",135,670,$t;

my $row = 0;
my $col = 0.05;
	
	printf$fhdl "/Helvetica-Bold findfont 10 scalefont setfont\n";
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Well";
	$col = 0.5;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Clonename";
	$col = 3.05;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"EP";
	
	$col = 3.51;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"DP";
	
	$col = 4.0;
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),624 - ($row * 20),"Failed";
	
	printf $fhdl  "%d %d moveto %d %d rlineto stroke\n",50 ,620,285,0;

for $row (1..24)
{	
	$i = $row + (24 * ($currentpage -1));
	my $well = $i - (12 * int(($i-1)/12));
	my $count;
	
	for($count = 0; $count < @{$$ref};$count++)
	{
		if($$ref->[$count][1] == $i)
		{
		$col = 0.5;
		printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),628 - ($row * 20),$$ref->[$count][0];
		
		$col = 3.05;
		printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),628 - ($row * 20),$$ref->[$count][6];
		
		$col = 3.51;
		printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),628 - ($row * 20),$$ref->[$count][7];
		
		#splice @{$$ref},$count;
		last;
		}
	}
	
	$col = 0.05;
	if($row == 13){$l++;}
	printf $fhdl  "%d %d moveto (%s) show\n",55 + ($col * 62),628 - ($row * 20),"$l $well";
	
	$col = 3.8;
	printf $fhdl  "%d %d moveto %d %d lineto stroke\n",50,622 - ($row * 20),100 + ($col * 62),622 - ($row * 20);
}	
	

$l++;

printf $fhdl  "%d %d moveto (%s) show\n",80, 80,"Please Remember to Update Oracle. (* Denotes additional clone preparations still in progress)";
printf $fhdl  "%d %d moveto (%s) show\n",50, 50,"Page $currentpage of $pages";
printf $fhdl "showpage";	
#close $fhdl;
#$fhdl->close()|| die "could not close file\n";
close($fhdl)|| die "could not close pipe to printer\n";

}
}


1;








