#!/usr/athena/bin/perl -w

# To print labels for DLT tapes.
# Accepts a list of tape names on the command line, or prompts for a
# range of tape name.number style names, calls out to gnu barcode to
# generate postscript barcode labels, and adds guidelines for cutting
# and text.  Postscript is sent to stdout.
#
# Freely redistributable.
# $Id: tape-label.pl,v 1.2 2001/06/08 01:45:43 cfox Exp $

use IPC::Open2;

if ($#ARGV == -1)
{
  print STDERR "first tape label? ";
  $firstlabel = (<>);
  chomp $firstlabel;
  if (length($firstlabel) > 8)
  {
    die "ERROR: labels longer than 8 characters won't be recognized by drive\n";
  }
  if ($firstlabel =~ /^(\D*)(\d+)$/)
  {
    $prefix = $1;
    $number = $2;
    $nlen = length $2;
    $lastnum = $number+32;
    $lastlabel = sprintf "%s%0*d", $prefix, $nlen, $lastnum;
  } else
  {
    die "can't sequentially number labels not of the form <string><number>\n";
  }
  print STDERR "last tape label? [$lastlabel] ";
  $answer = (<>);
  chomp $answer;
  if ($answer ne '')
  {
    $answer =~ /^(\D*)(\d+)$/;
    $lastlabel = $answer;
    $lastnum = $2;
  }
  FOO: foreach (1..33)
  {
    my $thislabel;
    if ($number <= $lastnum)
    {
      $thislabel = sprintf "%s%0*d", $prefix, $nlen, $number;
      push @labellist, $thislabel;
      $number++;
    } else
    {
      last FOO;
    }
  }
} else
{
  foreach $label (@ARGV)
  {
    if (length($label) > 8)
    {
      die "ERROR: labels longer than 8 characters won't be recognized by drive\n";
    }
    push @labellist, $label;
  }
}

open2(\*BARCODEREAD, \*BARCODEWRITE, 'athrun gnu barcode -e code39 -t 3x13+60+10 -p 8.5x11in -n');

foreach (@labellist)
{
  print BARCODEWRITE $_, "\n";
}

close(BARCODEWRITE);

foreach(<BARCODEREAD>)
{
  unless ($_ =~ /showpage/ or $_ =~ /\%\%Trailer/)
  {
    print "$_";
  }
}

print "\% End of output from gnu barcode.\n\% Begining of guidelines for cutting\n\n";

print "0.2 setlinewidth newpath\n";

$numrows = int(($#labellist + 3)/3);
foreach (0..$numrows)
{
  $i = 767 - $_*59;
  print "0 $i moveto 612 0 rlineto stroke\n";
}

foreach (0,1,2,3)
{
  $i = 60+164*$_;
  print "$i 0 moveto 0 792 rlineto stroke\n";
}

print "/Courier-Bold findfont 19 scalefont setfont\n\n";

print <<CENTERFUNC;
/center {
  dup stringwidth pop % string stringwidth
  dup 2 div neg
  currentpoint % string stringwidth offset current-x current-y
  3 1 roll add exch % string stringwidth new-x old-y
  moveto % string stringwidth
    currentpoint
  newpath
    moveto
    -2 0 rmoveto
    4 add
    dup 0 rlineto
    0 15 rlineto
    neg 0 rlineto
  closepath
  gsave
    1 setgray
    fill
  grestore
    2 0 rmoveto
  show
} def

CENTERFUNC

$i = 0;
foreach (@labellist)
{
  $xcoord[$i] = 142 + ($i % 3)*164;
  $ycoord[$i] = 715 - (int(($i + 3)/3)-1)*59;
  print "$xcoord[$i] $ycoord[$i] moveto\n";
  print "($_) center\n";
  $i++;
}

print "showpage\n";