#!/usr/bin/perl
#
# Copyright 1998, 2004 Brandon Gillespie, All Rights Reserved
#
# Licensed for use by terms of the GPL Library
#

use strict;

if ($#ARGV == -1 || lc $ARGV[0] eq '-h' || lc $ARGV[0] eq '--help') {
    print <<END;
Syntax: $0 label1 label2 label3 ...

Creates a sheet 3 columns by 12 rows deep of labels, for a DLT sized
tape cartridge.  Labels must be no longer than six characters (it will
truncate).  Possibility exists to do longer labels, or different tape
sizes, just edit the script 8)
END
    exit(0);
}

my @ids = ();
for my $id (@ARGV) {
    push(@ids, substr($id, 0, 6));
}

my %bcm = (
    "0" => "0001101000",
    "1" => "1001000010",
    "2" => "0011000010",
    "3" => "1011000000",
    "4" => "0001100010",
    "5" => "1001100000",
    "6" => "0011100000",
    "7" => "0001001010",
    "8" => "1001001000",
    "9" => "0011001000",
    "A" => "1000010010",
    "B" => "0010010010",
    "C" => "1010010000",
    "D" => "0000110010",
    "E" => "1000110000",
    "F" => "0010110000",
    "G" => "0000011010",
    "H" => "1000011000",
    "I" => "0010011000",
    "J" => "0000111000",
    "K" => "1000000110",
    "L" => "0010000110",
    "M" => "1010000100",
    "N" => "0000100110",
    "O" => "1000100100",
    "P" => "0010100100",
    "Q" => "0000001110",
    "R" => "1000001100",
    "S" => "0010001100",
    "T" => "0000101100",
    "U" => "1100000010",
    "V" => "0110000010",
    "W" => "1110000000",
    "X" => "0100100010",
    "Y" => "1100100000",
    "Z" => "0110100000",
    "-" => "0100001010",
    "." => "1100001000",
    " " => "0110001000",
    "*" => "0100101000",
    "\$" => "0101010000",
    "/" => "0101000100",
    "+" => "0100010100",
    "%" => "0001010100",
);

print <<END;
%!PS-Adobe-3.0
%%Pages: 1
%%Orientation: Portrait
%%PageOrder: Ascend
%%DocumentNeededResources: font Helvetica
%%BeginDefaults
%%PageResources: font Helvetica
%%EndDefaults
%%EndComments
%%EndProlog
true setstrokeadjust
%%EndPageSetup
/bdf {bind def} bind def
/l {lineto}  bdf
/m {moveto}  bdf
/mshow {moveto show} bdf
/black {/DeviceCMYK setcolorspace 0 0 0 1} def
/white {/DeviceCMYK setcolorspace 0 0 0 0} def
/gray80 {/DeviceCMYK setcolorspace 0.8 0.8 0.8 0} def
/gray20 {/DeviceCMYK setcolorspace 0.2 0.2 0.2 0} def
/gray {/DeviceCMYK setcolorspace 0.4 0.4 0.4 0} def
/gray10 {/DeviceCMYK setcolorspace 0.1 0.1 0.1 0} def
/red {/DeviceCMYK setcolorspace 0 1 1 0} def
/yellow {/DeviceCMYK setcolorspace 0 0 1 0} def
/ltgreen {/DeviceCMYK setcolorspace 0.7 0 1 0} def
/dkgreen {/DeviceCMYK setcolorspace 0.7 0 1 0.4} def
/ltblue {/DeviceCMYK setcolorspace 1 0.3 0 0 } def
/dkblue {/DeviceCMYK setcolorspace 1 1 0 0 } def
/pink {/DeviceCMYK setcolorspace 0 0.7 0.4 0 } def
/ltorange   {/DeviceCMYK setcolorspace 0 0.3 1 0 } def
/orange {/DeviceCMYK setcolorspace 0 0.5 1 0.02 } def

/cyan {/DeviceCMYK setcolorspace 1 0 0 0} def
/purple {/DeviceCMYK setcolorspace 0.3 1 0 0 } def
/blue {/DeviceCMYK setcolorspace 1 1 0 0 } def
/magenta {/DeviceCMYK setcolorspace 0 1 0 0} def

black setcolor
/Helvetica-Bold findfont 14 scalefont setfont
/cpos { exch cstr stringwidth pop 2 div sub exch moveto } bind def
END
while ($#ids > -1) {
    print "%%Page: 1 1\n";

my $xorig = 14;
my $xstep = 0;

my $yorig = 27;
my $ystep = 0;

my $up = 62; # 72.2;
my $across = 168; #180;

my $x1 = $xorig;
my $x2 = $x1 + $across;
my $y1 = $yorig;
my $y2 = $y1;

  for (1 .. 3) {
        if ($#ids == -1) {
            last;
        }
    for (1 .. 12) { 
        if ($#ids == -1) {
            last;
        }

        my $sid = shift(@ids);

        my $xstart = $x1 + 5;
        my $ystart = $y1 + 5;
        $y1 += $up;
        $y2 = $y1;

        my $x_start = $xstart + 22;
        my $y_barcode = $ystart + 13;
        my $x_label = $x_start + 74;

        my $x_end = &bcm($sid, $xstart + 19, $ystart + 9, 28, 0, 1);

#        my $blen = $x_end - $x_start;
        my $blen = 168;
#print " % x_end = $x_end\n";
#        my $blen = $x_start;
        my $frx1 = $xstart + 5;
        my $fry1 = $ystart -2;
        my $frx2 = $frx1 + $blen;#  + 33 + 7;
        my $fry2 = $y_barcode + 40 + 5 + 2;

        my $xs = $xstart + 5;
        my $ys = $ystart + 38;
        my $boxwidth = 28;
        for my $c (split(//, $sid)) {
            &boxchar($c, $xs, $ys, $boxwidth);
            $xs += $boxwidth;
        }
        $xs = $xstart + 5;
        $ys = $ystart + 9;
        my $xs2 = $xstart + 168+5;
        print <<END;
2 setlinewidth
$xs $ys m $xs2 $ys l stroke
0.25 setlinewidth
$frx1 $fry1 m $frx1 $fry2 l
$frx1 $fry1 m $frx2 $fry1 l
$frx2 $fry1 m $frx2 $fry2 l
$frx1 $fry2 m $frx2 $fry2 l
stroke
END
    }
    $y1 = $yorig;
    $y2 = $y1;
    $x1 += $xstep + $across;
    $x2 = $x1 + $across;
}
print "showpage\n";
}

sub boxchar {
    my ($c, $x1, $y1, $boxwidth) = @_;

    my $colors = {
        "0" => "red",
        "1" => "yellow",
        "2" => "ltgreen",
        "3" => "ltblue",
        "4" => "gray",
        "5" => "orange",
        "6" => "pink",
        "7" => "dkgreen",
        "8" => "ltorange",
        "9" => "purple",
    };
    my $color = $colors->{$c} || "gray20";
    my $x2 = $x1 + $boxwidth;
    my $y2 = $y1 + 22;
    my $cx = $x1 + ($boxwidth / 2);
    my $cy = $y1 + 6;
    print <<END;
$color setcolor
$x1 $y1 m $x1 $y2 l $x2 $y2 l $x2 $y1 l $x1 $y1 l fill
black setcolor
0.5 setlinewidth
$x1 $y1 m $x1 $y2 l stroke
 % $x2 $y2 l $x2 $y1 l $x1 $y1 l stroke
2 setlinewidth
$x1 $y1 m $x2 $y1 l stroke
/cstr ($c) def $cx $cy cpos
cstr show
END
}

sub bcm {
    my ($phrase, $xpos, $ypos, $height, $vertical, $basewidth) = @_;
    my ($isSpace, $width, $linewidth, $spwidth);
  
    ($xpos <= 0) && ($xpos = 18);
    ($ypos <= 0) && ($ypos = 18);
    ($height <= 0) && ($height = 25);
#    ($basewidth <= 0) && ($basewidth = 0.75);
    ($basewidth <= 0) && ($basewidth = 0.75);
    $spwidth = 0.6;
  
    $phrase = "*${phrase}*";
    $linewidth = 0;
  
    &psprint("% barcode for $phrase\n");
  
    for my $character (split(//, $phrase)) {
        $character = uc $character;
        $isSpace = 0;
  
        ## print the barcode one bit at a time.
        for my $bit ( split( "", $bcm{$character} ) ) {
            ## Compute the width of the space or bar.
            if ( $bit eq "0" ) {
                $width = $basewidth;
            } else {
                $width = $basewidth * 3;
            }
  
            if ($isSpace) {
                if ($vertical) {
                    $ypos += $width;
                } else {
                    $xpos += $width;
                }
  
                $isSpace = 0;
            } else {
                if ($linewidth != $width) {
                    &psprint("$width setlinewidth\n");
                    $linewidth = $width;
                }
                if ($vertical) {
                    $ypos += ($width * $spwidth);
                    &psprint("$xpos $ypos m " . ($xpos + $height) .
                             " $ypos l stroke\n");
                    $ypos += ($width * $spwidth);
                } else {
                    $xpos += ($width * $spwidth);
                    &psprint("$xpos $ypos m $xpos " . ($ypos + $height) .
                             " l stroke\n");
                    $xpos += ($width * $spwidth);
                }
  
                $isSpace = 1;
            }
        }
    }
    return $xpos;
}

sub psprint {
    print $_[0];
}