#!/usr/bin/perl

###################################################################
#
#Copyright (c) 2007, Harald Schioeberg
#
#All rights reserved
#
#Redistribution and use in source and binary forms, with or without 
#modification, are permitted provided that the following conditions 
#are met:
#
#    * Redistributions of source code must retain the above copyright 
#	notice, this list of conditions and the following disclaimer.
#    * Redistributions in binary form must reproduce the above copyright 
#	notice, this list of conditions and the following disclaimer
#	in the documentation and/or other materials provided with the 
#	distribution.
#
#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
#"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
#LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
#A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
#CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
#EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
#PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
#PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
#LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
#NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
#SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
####################################################################


use strict;
use File::Temp qw/tempfile/;


####
# Configuration
####

my $SCALE=472; 	# 1200 =  units are inch
		# 472 = units are centimeters

# Borders of the sheet
my $MARGIN_TOP = 0;
my $MARGIN_LEFT= 0.8;

# Offset between two labels
my $XOFFSET = 10;
my $YOFFSET = 4.1;

# Layout of the sheet
my $COLS = 2;
my $ROWS = 7;

# Binarys needed
my $FIG2DEV = "/usr/bin/fig2dev -L ps";





####
# End of configuration
####

sub usage {
print STDERR <<EOF;


This program generates lables for LT0 tapes. It takes a space sepreated 
list of tags of the form

[A-Z][A-Z][A-Z][0-9][0-9][0-9]L[1-9]

and returns a postscript file on stdout. (eg. ABC123L2)
Further configuration is done by editing the config section of the program
(spacing between the labels, row&column layout....)

This program was written by Harald Schioeberg, (c) 2007
This program is provided as it is under the terms of a BSD License, 
see the beginning of the file for details.

EOF
exit 1;
	
}


# my @tags = @ARGV;


usage() if (-1 == $#ARGV);
printsheet(@ARGV);


sub printsheet {
    my @tags = @_;
    my @psfiles;
    my $x;
    my $y;
    my $fighandle;

    open $fighandle, "|$FIG2DEV" or die "Could not open fig2dev\n";
#    open $fighandle, ">&STDOUT";

    printcode_header($fighandle);

    for (my $col = 0; $col < $COLS; $col++) {
    for (my $row = 0; $row < $ROWS; $row++) {
	my $tag = shift @tags;
	next unless $tag;

	my $epsfile = genps($tag);
	push @psfiles, $epsfile;
	$x = int(($MARGIN_LEFT + $col * $XOFFSET) * $SCALE);
	$y = int(($MARGIN_TOP + $row * $YOFFSET) * $SCALE);

	printcode($fighandle, $tag, $epsfile, $x, $y);


    }}
   close $fighandle;

    foreach my $file (@psfiles) { 
	system("rm $file");
    }    

    
}

sub genps {
    my $tag = shift;
    my ($fh, $filename) = tempfile(DIR => "/tmp", SUFFIX => ".eps");
   
    open SAVEDOUT, ">&STDOUT";
    open STDOUT, ">&=", $fh->fileno or die "cant redirect\n";
    system ("barcode -E -b $tag -e 39 -c -n");
    close STDOUT;
    open STDOUT, ">&SAVEDOUT";

    return $filename;
}


sub movecords {
    	my $cords = shift;
	my $x = shift;
	my $y = shift;

	chomp $cords;
	my @cords = split / /, $cords;
	for (my $i; $i<= $#cords-1; $i+=2) {
	    $cords[$i] += $x;
	    $cords[$i+1] += $y;

	}
	return join " ", @cords;
}

sub printcode_header {

my $file = shift;
print $file <<EOHEAD;
#FIG 3.2  Produced by xfig version 3.2.5-alpha5
Portrait
Flush left
Metric
A4      
100.00
Single
-2
1200 2
EOHEAD

}

sub printcode {
my $file = shift;
my $tag = shift;
my $ps = shift;
my $x = shift;
my $y = shift;

$tag =~ /([A-Z ]{3})([0-9]{3})(L[1-9])/ or die "Tag ($tag) should be in ABC123L3 format \n";
my @tag =($1,$2,$3);

print $file "2 2 0 1 0 -1 49 -1 -1 0.000 0 0 -1 0 0 5\n";
print $file "\t".movecords("450 450 4005 450 4005 1215 450 1215 450 450", $x, $y)."\n";
print $file "2 2 0 1 7 7 55 -1 20 0.000 0 0 -1 0 0 5\n";
print $file "\t".movecords("450 450 3915 450 3915 810 450 810 450 450", $x, $y)."\n";
print $file "2 5 0 1 0 -1 51 -1 20 0.000 0 0 -1 0 0 5\n";
print $file "\t 0 $ps\n";
print $file "\t".movecords("450 405 3910 405 3910 810 450 810 450 405",$x,$y)."\n";
print $file "2 5 0 1 0 -1 60 -1 -1 0.000 0 0 -1 0 0 5\n";
print $file "\t 0 $ps\n";
print $file "\t".movecords("500 720 2344 720 2344 1080 500 1080 500 720",$x,$y)."\n";
print $file "4 1 0 50 -1 16 6 0.0000 4 ".	
	movecords("105 1710 2160 1170",$x,$y).
	" This edge of label toward hub of tape\\001\n";
print $file "4 0 0 50 -1 18 14 0.0000 4 ".
	movecords("180 405 3015 1080",$x,$y)." ".$tag[1]."\\001\n";
print $file "4 0 0 50 -1 16 8 0.0000 4 ".
	movecords("90 150 3465 1035",$x,$y)." ".$tag[2]."\\001\n";
print $file "4 0 0 50 -1 16 8 0.0000 4 ".
	movecords("90 270 2655 1035",$x,$y)." ".$tag[0]."\\001\n";

}